1package CSS::DOM::Style;
2
3$VERSION = '0.17';
4
5use warnings; no warnings qw' utf8';
6use strict;
7
8use CSS::DOM::Exception 'SYNTAX_ERR';
9use CSS::DOM::Util qw 'escape_ident unescape';
10use Scalar::Util 'weaken';
11
12# ~~~ use overload fallback => 1, '@{}' =>
13
14# Internal object structure
15#
16# Each style object is a hash ref:
17# {
18#    owner       => $owner_rule,
19#    parser      => $property_parser,
20#    mod_handler => sub { ... },  # undef initially
21#    names       => [...],
22#    props       => {...},
23#    pri         => {...},  # property priorities
24# }
25#
26# The value of an element in the props hash can be one of three things
27#  1) a CSSValue object
28#  2) an array ref that is a blueprint for a CSSValue object:
29#     [ $css_code, $class, @constructor_args]
30#  3) a string of css code
31# Item (3) is only used when there is no property parser.
32
33sub parse {
34	require CSS::DOM::Parser;
35	goto &CSS::DOM::Parser::parse_style_declaration;
36}
37
38sub new {
39	my($class) = shift;
40
41	my $self = bless {}, $class;
42	if(@_ == 1) {
43		$self->{owner} = shift;
44	}
45	else {
46		my %args = @_;
47		$self->{owner} = delete $args{owner};
48		$self->{parser}
49		 = delete $args{property_parser};
50	}
51	{
52		$self->{parser} ||= (
53		    ($self->{owner} || next)->parentStyleSheet || next
54		   )->property_parser;
55	}
56	weaken $self->{owner};
57	return $self
58}
59
60sub cssText {
61	my $self = shift;
62	my $out;
63	if (defined wantarray) {
64		$out = join "; ", map {
65			my $pri = $self->getPropertyPriority($_);
66			"$_: ".$self->getPropertyValue($_)." !"x!!$pri
67				. escape_ident($pri)
68		} @{$$self{names}};
69	}
70	if(@_) {
71		my $css = shift;
72		!defined $css || !length $css and
73			@$self{'props','names'} = (), return $out;
74
75		require CSS::DOM::Parser;
76		my $new =CSS::DOM::Parser::parse_style_declaration(
77		 $css, property_parser => $$self{parser}
78		);
79
80		@$self{'props','names'} = @$new{'props','names'};
81		_m($self);
82	}
83	return $out;
84}
85
86sub getPropertyValue { # ~~~ Later I plan to make this return lists of
87                       #     scalars in list context (for list properties).
88	my $self = shift;
89	my $props = $self->{props} || return '';
90	my $name = lc$_[0];
91
92	if(my $spec = $self->{parser}) { serialise: {
93		if(my $p = $spec->get_property($name)) {
94		 if(exists $p->{serialise} and my $s = $p->{serialise}) {
95		   my @p = $spec->subproperty_names($name);
96		   my %p;
97		   for(@p) {
98		    my $v = $self->getPropertyValue($_) ;
99		    length $v or last serialise;
100		    $p{$_}
101		     = $spec->get_property($_)->{default} eq $v ?'':$v;
102		   }
103		   return $s->(\%p);
104		 }
105		}
106	}}
107
108	exists $props->{$name}
109		or return return '';
110	my $val = $props->{$name};
111	return ref $val eq 'ARRAY' ? $$val[0]
112	     : !ref $val           ? $val
113	     :                       $val->cssText;
114}
115
116sub getPropertyCSSValue {
117	my $self = shift;
118	$self->{parser} or return;
119	exists +(my $props = $self->{props} || return)->{
120	  my $name = lc$_[0]
121	}	or return return;
122	my $valref = \$props->{$name};
123	return ref $$valref eq 'ARRAY'
124		? scalar (
125			$$$valref[1]->can('new')
126			 || do {
127			     (my $pack = $$$valref[1]) =~ s e::e/egg;
128			     require "$pack.pm";
129			    },
130			$$valref =
131			  $$$valref[1]->new(
132			   owner => $self, property => $name,
133			   @$$valref[2..$#$$valref],
134			  )
135		) : $$valref;
136}
137
138sub removeProperty {
139	my $self = shift;
140	my $name = lc shift;
141
142	# Get the value so we can return it
143	my $val;
144	$val = $self->getPropertyValue($name)
145	 if defined wantarray;
146
147	# Get names of subprops if we are dealing with a shorthand prop
148	my @to_delete;
149	if(my $spec = $self->{parser}) {
150		@to_delete = $spec->subproperty_names($name);
151	}
152	@to_delete or @to_delete = $name;
153
154	# Delete the properties
155	for my $name(@to_delete) {
156		delete +($self->{props} || return $val)->{$name};
157		@{$$self{names}} = grep $_ ne $name,
158			@{$$self{names} || return $val};
159	}
160
161	$val;
162}
163
164sub getPropertyPriority {
165	return ${shift->{pri}||return ''}{lc shift} || ''
166}
167
168sub setProperty {
169	my ($self, $name, $value, $priority) = @_;
170
171	# short-circuit for the common case
172	length $value or $self->removeProperty($name),return;
173
174	require CSS'DOM'Parser;
175	my @tokens = eval { CSS'DOM'Parser'tokenise_value($value); }
176		or die CSS::DOM'Exception->new( SYNTAX_ERR, $@);
177
178	# check for whitespace/comment assignment
179	$tokens[0] =~ /^s+\z/ and $self->removeProperty($name),return;
180
181	my $props = $$self{props} ||= {};
182	my $pri = $$self{pri} ||= {};
183
184	my $val;
185	if(my $spec = $self->{parser}) {
186		my(@args) = $spec->match($name, @tokens)
187			or return;
188		if(@args == 1) { # shorthand
189			while(my($k,$v) = each %{ $args[0] }) {
190				$self->removeProperty($k), next
191				 if $v eq "";
192				exists $$props{$k=lc$k}
193				 or push @{$$self{names}}, $k;
194				$$props{$k} = $v;
195				$$pri{$k} = $priority;
196			}
197			return;
198		}
199		else {
200			$val = \@args;
201		}
202	}
203
204	exists $$props{$name=lc$name} or push @{$$self{names}}, $name;
205	$$props{$name} = $val || join "", @{ $tokens[1] };
206	$$pri{$name} = $priority;
207
208	_m($self);
209	return
210}
211
212sub item {
213	my $ret = shift->{names}[shift];
214	return defined $ret ? $ret : ''
215}
216
217sub parentRule {
218	shift->{owner}
219}
220
221sub _set_property_tokens { # private
222	my ($self,$name,$types,$tokens) = @_;
223
224	# Parse out the priority first
225	my $priority;
226	if($types =~ /(s?(ds?))i\z/ and $tokens->[$-[2]] eq '!') {
227		$types =~ s///;
228		$priority = unescape pop @$tokens;
229		pop @$tokens for 1..length $1;
230	} else {
231		$priority = '';
232	}
233
234	# Get the prop & priority hashes
235	my $props = $$self{props} ||= {};
236	my $pri = $$self{pri} ||={};
237
238	# See if we need to parse the value
239	my $val;
240	if(my $spec = $self->{parser}) {
241		my(@args) = $spec->match($name,$types,$tokens)
242			or return;
243		if(@args == 1) {
244			while(my($k,$v) = each %{ $args[0] }) {
245				$self->removeProperty($k), next
246				 if $v eq "";
247				exists $$props{$k=lc$k}
248				 or push @{$$self{names}}, $k;
249				$$props{$k} = $v;
250				$$pri{$k} = $priority;
251			}
252			return;
253		}
254		else {
255			$val = \@args;
256		}
257	}
258	else { $val = join "", @$tokens }
259
260	# Assign the value & priority
261	exists $$props{$name=lc$name} or push @{$$self{names}}, $name;
262	$$props{$name} = $val;
263	$$pri{$name} = $priority;
264}
265
266
267{ my $prop_re = qr/[a-z]+(?:[A-Z][a-z]+)*/;
268sub can {
269	SUPER::can { shift } @_ or
270		$_[0] =~ /^$prop_re\z/o ? \&{+shift} : undef;
271}
272sub AUTOLOAD {
273	my $self = shift;
274	if(our $AUTOLOAD =~ /(?<=:)($prop_re)\z/o) {
275		(my $prop = $1) =~ s/([A-Z])/-\l$1/g;
276		my $val;
277		defined wantarray
278			and $val = $self->getPropertyValue($prop);
279		@_ and $self->setProperty($prop, shift);
280		return $val;
281	} else {
282		die "Undefined subroutine $AUTOLOAD called at ",
283			join(" line ", (caller)[1,2]), ".\n";
284	}
285}
286sub DESTROY{}
287}
288*cssFloat = \&float;
289
290sub modification_handler {
291	my $old = (my $self = shift)->{mod_handler};
292	$self->{mod_handler} = shift if @_;
293	$old;
294}
295
296sub _m#odified
297{
298	&{$_[0]->{mod_handler} or return}($_[0]);
299}
300
301sub property_parser { shift->{parser} }
302
303sub length { # We put this one last to avoid having to say CORE::length
304             # elsewhere.
305	scalar @{shift->{names}||return 0}
306}
307
308
309
310                              !()__END__()!
311
312=head1 NAME
313
314CSS::DOM::Style - CSS style declaration class for CSS::DOM
315
316=head1 VERSION
317
318Version 0.17
319
320=head1 SYNOPSIS
321
322  use CSS::DOM::Style;
323
324  $style = CSS::DOM::Style::parse(' text-decoration: none ');
325
326  $style->cssText; # returns 'text-decoration: none'
327  $style->cssText('color: blue'); # replace contents
328
329  $style->getPropertyValue('color'); # 'blue'
330  $style->color;                     # same
331  $style->setProperty(color=>'green'); # change it
332  $style->color('green');              # same
333
334=head1 DESCRIPTION
335
336This module provides the CSS style declaration class for L<CSS::DOM>. (A
337style declaration is what comes between the braces in C<p { margin: 0 }>.)
338It
339implements
340the CSSStyleDeclaration DOM interface.
341
342=head1 CONSTRUCTORS
343
344=over 4
345
346=item CSS::DOM::Style::parse( $string )
347
348=item CSS::DOM::Style::parse( $string, property_parser => $parser )
349
350This parses the C<$string> and returns a new style declaration
351object. This is useful if you have text from an HTML C<style> attribute,
352for instance.
353
354For details on C<$property_parser>, see L<CSS::DOM::PropertyParser>.
355
356=item new CSS::DOM::Style $owner_rule
357
358=item new CSS::DOM::Style owner => $owner_rule, property_parser => $p
359
360You don't normally need to call this, but, in case you do, here it is.
361C<$owner_rule>, which is optional, is expected to be a L<CSS::DOM::Rule>
362object, or a subclass like L<CSS::DOM::Rule::Style>.
363
364=back
365
366=head1 METHODS
367
368=over 4
369
370=item cssText ( $new_value )
371
372Returns the body of this style declaration (without the braces). If you
373pass an argument, it will parsed and replace the existing CSS data.
374
375=item getPropertyValue ( $name )
376
377Returns the value of the named CSS property as a string.
378
379=item getPropertyCSSValue ( $name )
380
381Returns an object representing the property's value.
382(See L<CSS::DOM::Value>.)
383
384=item removeProperty ( $name )
385
386Removes the named property, returning its value.
387
388=item getPropertyPriority
389
390Returns the property's priority. This is usually the empty string or the
391word 'important'.
392
393=item setProperty ( $name, $value, $priority )
394
395Sets the CSS property named C<$name>, giving it a value of C<$value> and
396setting the priority to C<$priority>.
397
398=item length
399
400Returns the number of properties
401
402=item item ( $index )
403
404Returns the name of the property at the given index.
405
406=item parentRule
407
408Returns the rule to which this declaration belongs.
409
410=item modification_handler ( $coderef )
411
412This method, not part of the DOM, allows you to attach a call-back routine
413that is run whenever a change occurs to the style object (with the style
414object as its only argument). If you call it
415without an argument it returns the current handler. With an argument, it
416returns the old value after setting it.
417
418=item property_parser
419
420This returns the parser that was passed to the constructor.
421
422=back
423
424This module also has methods for accessing each CSS property directly.
425Simply capitalise each letter in a CSS property name that follows a hyphen,
426then remove the hyphens, and you'll have the method name. E.g., call the
427C<borderBottomWidth> method to get/set the border-bottom-width property.
428One exception to this is that C<cssFloat> is the method used to access the
429'float' property. (But you can also use the C<float> method, though it's
430not part of the DOM standard.)
431
432=head1 SEE ALSO
433
434L<CSS::DOM>
435
436L<CSS::DOM::Rule::Style>
437
438L<CSS::DOM::PropertyParser>
439
440L<HTML::DOM::Element>
441