File Coverage

blib/lib/CSS/DOM/Rule/Style.pm
Criterion Covered Total %
statement 50 161 31.0
branch 10 90 11.1
condition 4 39 10.2
subroutine 15 18 83.3
pod 4 4 100.0
total 83 312 26.6


line stmt bran cond sub pod time code
1             package CSS::DOM::Rule::Style;
2              
3             $VERSION = '0.16';
4              
5 22     22   1565 use warnings;
  22         43  
  22         695  
6 22     22   118 use strict;
  22         44  
  22         575  
7              
8 22     22   696 use CSS::DOM::Exception qw/ SYNTAX_ERR /;
  22         42  
  22         1031  
9 22     22   8934 use CSS::DOM::Rule;
  22         54  
  22         1646  
10              
11             our @ISA = 'CSS::DOM::Rule';
12              
13 22         1381 use constant 1.03 our $_const = {
14             # Don't let this conflict with the superclass.
15             styl => 2,
16             selc => 3,
17 22     22   121 };
  22         344  
18 22     22   139 { no strict; delete @{__PACKAGE__.'::'}{_const => keys %{our $_const}} }
  22         44  
  22         20644  
19              
20             # overrides:
21 6     6 1 28 sub type { CSS::DOM::Rule::STYLE_RULE }
22             sub cssText {
23 56     56 1 109 my $self = shift;
24 56         126 my $old;
25 56 100       165 if(defined wantarray) {
26 54         141 my $sel = $self->selectorText;
27 54 100       166 length $sel and $sel .= ' ';
28 54         242 $old = "$sel\{ "
29             . $self->[styl]->cssText ." }\n";
30             }
31 56 100       183 if (@_) {
32 3         23 my $new_rule = $self->_parse(shift);
33 2         20 @$self[styl,selc] = @$new_rule[styl,selc];
34             }
35 55         345 $old;
36             };
37              
38              
39             # CSSStyleRule interface:
40              
41             # The selector ($self->[selc]) can be stored several ways, depending on how
42             # deeply we’ve parsed it:
43             #
44             # - a string
45             # - an array of two elements: [ token types, \@tokens ]
46             # - an array of three elements: [ token types, \@tokens, \@tree ]
47             #
48             # Tree format:
49             # * E > F:link + G[foo], E[foo="warning"] DIV.ette E#myid h1[lang|='en']
50             # becomes
51             # [
52             # [ '*' ],
53             # '',
54             # [ 'E' ],
55             # '>',
56             # [ 'F', ':', 'link', undef ],
57             # '+',
58             # [ 'G', 'a', 'foo', undef ], # ‘a’ stands for attr
59             # ],
60             # [
61             # [ 'E', '=', 'foo', 'warning' ],
62             # ''
63             # [ 'DIV', '~', 'class', 'ette' ],
64             # ''
65             # [ 'E', '#', 'myid', undef ],
66             # ''
67             # [ 'h1', '|', 'lang', 'en' ],
68             # ],
69             #
70             # We pad the items above with undef because :foo.bar#baz becomes
71             # [[ undef,
72             # ':', 'foo', undef, # (sets of three)
73             # '~', 'class', 'bar',
74             # '#', 'baz', undef,
75             # ]]
76             sub selectorText { # ~~~ syntax_err
77 85     85 1 209 my $old = (my $self = shift)->[selc];
78             # warn "@{$$old[1]}";# if ref $old eq 'ARRAY' and wantarray;
79 85 100 66     602 $old = join '', @{$$old[1]}
  84         241  
80             if ref $old eq 'ARRAY' and defined wantarray;
81 85 100       247 $self->[selc] = "".shift if @_;
82 85         379 $old;
83             }
84              
85             sub _set_selector_tokens {
86 105     105   428 shift->[selc] = \@_;
87             }
88              
89             sub _selector_matches { # ~~~ Does this work with initial space in the selector?
90 0     0   0 my $self = shift;
91 0         0 my $elem = shift; # This is assumed to be an HTML::DOM::Element.
92 0         0 my $pseudo = shift; # pseudo-element
93              
94             # tokenise if necessary
95 0 0       0 unless(ref $self->[selc]) {
96 0         0 require CSS'DOM'Parser;
97 0         0 $self->[selc] = [ CSS'DOM'tokenise($self->[selc]) ];
98             }
99              
100             # parse selector tokens if necessary
101 0         0 my $tree;
102 0 0       0 unless($tree = $self->[selc][2]) {
103 0         0 require CSS::DOM::Util;
104 0         0 my ($types,@tokens) = ($self->[selc][0], @{ $self->[selc][1] });
  0         0  
105              
106             # ~~~ remove initial whitespace here?
107              
108 0         0 $self->[selc][2] = $tree = [];
109              
110             # for each sub-selector within the selector (comma-delimited)
111 0         0 comma: while($types) {
112 0         0 my @pieces;
113              
114 0         0 while($types) {
115 0         0 push @pieces, \my @subsel;
116              
117             # element:
118 0 0       0 if($types =~ s/^i//) {
    0          
119 0         0 @subsel = lc shift @tokens;
120             }
121             elsif($tokens[0] eq '*') {
122 0         0 shift @tokens;
123 0         0 $types =~ s/^.//;
124 0         0 @subsel = '*';
125             }
126 0         0 else { @subsel = undef }
127              
128             # suffixes:
129 0         0 while($types) {
130              
131             # ids:
132 0 0 0     0 if($types =~ s/^#//) {
    0 0        
    0          
    0          
    0          
    0          
    0          
133 0         0 push @subsel, '#', CSS'DOM'Util'unescape( substr shift @tokens, 1 ),
134             undef;
135             }
136              
137             # classes
138             elsif($types =~ /^di/ && $tokens[0] eq '.') {
139 0         0 $types =~ s/^..//; shift @tokens;
  0         0  
140 0         0 push @subsel, '~', 'class',
141             CSS'DOM'Util'unescape( shift @tokens );
142             }
143              
144             # pseudo-elems and classes
145             elsif($types =~ s/^(::?)i//) {
146 0         0 push @subsel, $1,lc CSS'DOM'Util'unescape($tokens[length $1]), undef;
147 0         0 splice @tokens, 0, $+[0];
148             }
149              
150             # :lang() and similar functions
151             elsif($types =~ s/^:fi\)//) {
152 0         0 push @subsel,
153             ':',
154             lc CSS'DOM'Util'unescape(substr $tokens[1], 0, -1),
155             lc CSS'DOM'Util'unescape($tokens[2]);
156 0         0 splice @tokens, 0, 4;
157             }
158              
159             # [attr]
160             elsif($types =~ s/^\[i]//) {
161 0         0 push @subsel, '=', lc CSS'DOM'Util'unescape($tokens[1]), undef;
162 0         0 splice @tokens, 0, 3;
163             }
164              
165             # [attr='value']
166             elsif($types =~ /^\[id']/ && $tokens[2] eq '=') {
167 0         0 $types =~ s/^.{5}//;
168 0         0 push @subsel, '=',
169             lc CSS'DOM'Util'unescape($tokens[1]),
170             CSS'DOM'Util'unescape_str($tokens[3]);
171 0         0 splice @tokens, 0, 5;
172             }
173              
174             # [attr~='value'], [attr|='value']
175             elsif($types =~ s/^\[i[~|]']//) {
176 0         0 push @subsel, $tokens[2],
177             lc CSS'DOM'Util'unescape($tokens[1]),
178             CSS'DOM'Util'unescape_str($tokens[3]);
179 0         0 splice @tokens, 0, 5;
180             }
181              
182 0         0 else { last } # last suffix
183             }
184              
185             # If we reach this point and \@subsel is [ undef ], skip this selector
186             # and move to the next comma
187 0 0 0     0 if (@subsel == 1 and !defined $subsel[0]) {
188 22     22   132 no warnings 'regexp';
  22         78  
  22         6658  
189 0         0 $types =~ s/^$CSS::DOM::Parser::any_re*,?//o;
190 0         0 splice @tokens, 0, $+[0];
191 0         0 next comma;
192             }
193            
194             # check for hierarchy indicator (space > +)
195 0 0 0     0 if($types =~ /^(s?)d/ and $tokens[$+[1]] =~ /([>+])/) {
196 0         0 push @pieces, $1;
197 0         0 $types =~ s/^s?d//;
198 0         0 splice @tokens, $+[0];
199             }
200 0         0 else { push @pieces, '' }
201              
202             # trailing space
203 0 0       0 $types =~ s/^s// and shift @tokens;
204              
205             # check for comma or end
206 0 0       0 if($types =~ s/^(?:,s?|\z)//) {
207 0         0 splice @tokens, 0, $+[0];
208 0         0 push @$tree, \@pieces;
209 0         0 pop @pieces; # remove redundant ''
210 0         0 next comma;
211             }
212             }
213             }
214             }
215              
216             #use DDS; Dump $tree if local our $warn = join "", @{$self->[selc][1]}, eq 'ul li span.a';
217              
218 0         0 my $specificity = '';
219            
220 0         0 comma: for(@$tree) {
221 0 0       0 my $spec = _elem_matches_sel( $elem, $pseudo, $_ ) or next comma;
222              
223 22     22   125 no warnings 'uninitialized';
  22         56  
  22         6376  
224 0         0 $spec = join '', map chr, @$spec;
225 0 0       0 $spec gt $specificity and $specificity = $spec;
226             }
227              
228             #warn join("", @{$self->[selc][1]}), " ", join ',', map ord, split//,$specificity;
229 0   0     0 return $specificity || ();
230             }
231              
232             sub _elem_matches_sel {
233 0     0   0 my ($elem, $pseudo, $subsels) = @_;
234              
235             #warn $elem if our $warn;
236 0 0       0 my $spec = _elem_matches_subsel( $elem, $pseudo, $$subsels[-1] )or return;
237            
238 0         0 subsel: for(my $i = $#$subsels-1; $i>=0; $i-=2) {
239 0         0 my $combinator = $$subsels[$i];
240 0         0 my $next_sel = $$subsels[$i-1];
241              
242             # space between subselectors (ancestor)
243 0 0       0 if(!$combinator) {
244 0         0 my $e = $elem;
245 0         0 while($e = $e->parentNode) {
246 0 0       0 last if !$e->can('tagName'); # document
247             # ~~~ this might be more efficient if we use parentElement, but
248             # but HTML::DOM doesn’t have that yet.
249              
250             # We have to call _match recursively here with a copy of the selector
251             # to account for cases like A > B C, where B might first match an
252             # ancestor that is not a child of A.
253 0         0 my $s = _elem_matches_sel( $e, undef, [ @$subsels[0..$i-1] ] );
254 0 0       0 if($s) {
255 0         0 for(0..2) {
256 22     22   126 no warnings 'uninitialized';
  22         44  
  22         10178  
257 0         0 $$spec[$_] += $$s[$_];
258             }
259 0         0 last subsel; # recursion makes the rest of this loop unnecessary
260             }
261             }
262             # If we get here, we’ve run out of ancestors.
263             return
264 0         0 }
265              
266             # parent/sibling
267             else {
268 0         0 my $meth = ('previousSibling','parentNode')[$combinator eq '>'];
269 0         0 $elem = $elem->$meth;
270 0 0       0 last unless $elem->can('tagName'); # ~~~ The note above about effici-
271             # ency applies here, too.
272 0 0       0 my $s = _elem_matches_subsel( $elem, undef, $next_sel ) or return;
273 0         0 for(0..2) {
274 0         0 $$spec[$_] += $$s[$_];
275             }
276             }
277             }
278              
279 0         0 return $spec;
280             }
281              
282             sub _elem_matches_subsel {
283 0     0   0 my ($elem, $pseudo, $subsel) = @_;
284 0         0 my @subsel = @$subsel;
285              
286 0         0 my($ids,$attrs,$tags);
287              
288             # tag
289 0         0 my $tag = shift @subsel;
290 0 0 0     0 if(defined $tag and $tag ne '*') {
291 0 0       0 $tag eq lc $elem->tagName or return;
292 0         0 ++$tags
293             }
294              
295             # suffixes
296 0         0 while(@subsel) {
297 0         0 my($type,$id,$arg) = splice @subsel, 0, 3;
298              
299 0 0 0     0 if($type eq '#') {
    0          
    0          
    0          
    0          
    0          
300 0 0       0 $id eq $elem->id or return;
301 0         0 ++$ids;
302             }
303             elsif($type eq '~') {
304 0         0 my $attr = $elem->getAttribute($id);
305 0 0 0     0 !defined $attr || !length $attr and return;
306 0 0       0 $attr =~ /(?:^|[ \t\r\n\f])\Q$arg\E(?:\z|[ \t\r\n\f])/ or return;
307 0         0 ++$attrs;
308             }
309             # A single colon is either a CSS 2.1 pseudo-element or a pseudo-class.
310             # Since CSS 3 ps-elems have two colons, we can simply filter out those
311             # pseudo-elems listed in CSS 2.1. The rest are classes.
312             elsif($type eq ':'
313             and $id !~ /^(?:first-l(?:ine|etter)|before|after)\z/) { # class
314             # ~~~
315             return
316 0         0 }
317             elsif($type =~ /:/) { # pseudo-element
318 0 0 0     0 return unless $pseudo and lc $id eq lc $pseudo;
319             }
320             elsif($type eq '=') {
321 0         0 my $attr = $elem->getAttribute($id);
322 0 0       0 if(defined $arg) {
323 22     22   158 no warnings;
  22         44  
  22         5078  
324 0 0       0 $attr eq $arg or return;
325             }
326 0 0 0     0 else { defined $attr || length $attr or return }
327 0         0 ++$attrs;
328             }
329             elsif($type eq '|') {
330 0         0 my $attr = $elem->getAttribute($id);
331 0 0 0     0 !defined $attr || !length $attr and return;
332 0 0       0 $attr =~ /^\Q$arg\E(?:-|\z)/ or return;
333 0         0 ++$attrs;
334             }
335             }
336             #warn Dump [$tag,$ids,$attrs,$tags] if our $warn;
337 0         0 return[$ids,$attrs,$tags];
338             }
339              
340             sub style {
341 114   66 114 1 1024 $_[0]->[styl] ||= do {
342 105         545 require CSS::DOM::Style;
343 105         473 new CSS::DOM::Style shift
344             };
345             }
346              
347             !()__END__()!
348              
349             =head1 NAME
350              
351             CSS::DOM::Rule::Style - CSS style rule class for CSS::DOM
352              
353             =head1 VERSION
354              
355             Version 0.16
356              
357             =head1 SYNOPSIS
358              
359             use CSS::DOM;
360             my $ruleset = CSS::DOM->parse(
361             'p:firstline, h3 { font-weight: bold }'
362             )->cssRules->[0];
363              
364             $ruleset->selectorText; # 'p:firstline, h3'
365             $ruleset->style; # a CSS::DOM::Style object
366             $ruleset->style->fontWeight; # 'bold'
367              
368             =head1 DESCRIPTION
369              
370             This module implements CSS style rules for L. It inherits
371             from
372             L and implements
373             the CSSStyleRule DOM interface.
374              
375             =head1 METHODS
376              
377             =over 4
378              
379             =item selectorText
380              
381             Returns a string representing the selector(s). Pass an argument to set it.
382              
383             =item style
384              
385             Returns the CSS::DOM::Style object representing the declaration block
386             of this rule.
387              
388             =back
389              
390             =head1 SEE ALSO
391              
392             L
393              
394             L
395              
396             L