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