1 package DOM::Tiny::CSS;
5 use Class::Tiny::Chained 'tree';
7 our $VERSION = '0.001';
9 my $ESCAPE_RE = qr/\\[^0-9a-fA-F]|\\[0-9a-fA-F]{1,6}/;
12 ((?:$ESCAPE_RE|[\w\-])+) # Key
15 (?:"((?:\\"|[^"])*)"|'((?:\\'|[^'])*)'|([^\]]+?)) # Value
16 (?:\s+(i))? # Case-sensitivity
22 my $tree = shift->tree;
23 return $tree->[0] ne 'tag' ? undef : _match(_compile(shift), $tree, $tree);
26 sub select { _select(0, shift->tree, _compile(@_)) }
27 sub select_one { _select(1, shift->tree, _compile(@_)) }
30 my ($selectors, $current, $tree, $one, $pos) = @_;
32 while ($current = $current->[3]) {
33 return undef if $current->[0] eq 'root' || $current eq $tree;
34 return 1 if _combinator($selectors, $current, $tree, $pos);
42 my ($name_re, $value_re, $current) = @_;
44 my $attrs = $current->[2];
45 for my $name (keys %$attrs) {
46 next unless $name =~ $name_re;
47 return 1 unless defined $attrs->{$name} && defined $value_re;
48 return 1 if $attrs->{$name} =~ $value_re;
55 my ($selectors, $current, $tree, $pos) = @_;
58 return undef unless my $c = $selectors->[$pos];
60 return undef unless _selector($c, $current);
61 return 1 unless $c = $selectors->[++$pos];
65 return _ancestor($selectors, $current, $tree, 1, ++$pos) if $c eq '>';
67 # "~" (preceding siblings)
68 return _sibling($selectors, $current, $tree, 0, ++$pos) if $c eq '~';
70 # "+" (immediately preceding siblings)
71 return _sibling($selectors, $current, $tree, 1, ++$pos) if $c eq '+';
74 return _ancestor($selectors, $current, $tree, 0, ++$pos);
83 while (my $selectors = $group->[-1]) {
84 push @$selectors, [] unless @$selectors && ref $selectors->[-1];
85 my $last = $selectors->[-1];
88 if ($css =~ /\G\s*,\s*/gc) { push @$group, [] }
91 elsif ($css =~ /\G\s*([ >+~])\s*/gc) { push @$selectors, $1 }
94 elsif ($css =~ /\G([.#])((?:$ESCAPE_RE\s|\\.|[^,.#:[ >~+])+)/gco) {
95 my ($name, $op) = $1 eq '.' ? ('class', '~') : ('id', '');
96 push @$last, ['attr', _name($name), _value($op, $2)];
100 elsif ($css =~ /\G$ATTR_RE/gco) {
101 my $op = defined $2 ? $2 : '';
102 my $value = defined $3 ? $3 : (defined $4 ? $4 : $5);
103 push @$last, ['attr', _name($1), _value($op, $value, $6)];
106 # Pseudo-class (":not" contains more selectors)
107 elsif ($css =~ /\G:([\w\-]+)(?:\(((?:\([^)]+\)|[^)])+)\))?/gcs) {
108 push @$last, ['pc', lc $1, $1 eq 'not' ? _compile($2) : _equation($2)];
112 elsif ($css =~ /\G((?:$ESCAPE_RE\s|\\.|[^,.#:[ >~+])+)/gco) {
113 push @$last, ['tag', _name($1)] unless $1 eq '*';
122 sub _empty { $_[0][0] eq 'comment' || $_[0][0] eq 'pi' }
125 return [] unless my $equation = shift;
128 return [2, 2] if $equation =~ /^\s*even\s*$/i;
131 return [2, 1] if $equation =~ /^\s*odd\s*$/i;
135 return $num if $equation !~ /(?:(-?(?:\d+)?)?(n))?\s*\+?\s*(-?\s*\d+)?\s*$/i;
136 $num->[0] = defined($1) && $1 ne '' ? $1 : $2 ? 1 : 0;
137 $num->[0] = -1 if $num->[0] eq '-';
139 $num->[1] =~ s/\s+//g;
144 my ($group, $current, $tree) = @_;
145 _combinator([reverse @$_], $current, $tree, 0) and return 1 for @$group;
149 sub _name {qr/(?:^|:)\Q@{[_unescape(shift)]}\E$/}
152 my ($class, $args, $current) = @_;
155 return !grep { !_empty($_) } @$current[4 .. $#$current] if $class eq 'empty';
158 return $current->[3] && $current->[3][0] eq 'root' if $class eq 'root';
161 return !_match($args, $current, $current) if $class eq 'not';
164 return exists $current->[2]{checked} || exists $current->[2]{selected}
165 if $class eq 'checked';
167 # ":first-*" or ":last-*" (rewrite with equation)
168 ($class, $args) = $1 ? ("nth-$class", [0, 1]) : ("nth-last-$class", [-1, 1])
169 if $class =~ s/^(?:(first)|last)-//;
172 if ($class =~ /^nth-/) {
173 my $type = $class =~ /of-type$/ ? $current->[1] : undef;
174 my @siblings = @{_siblings($current, $type)};
177 @siblings = reverse @siblings if $class =~ /^nth-last/;
179 for my $i (0 .. $#siblings) {
180 next if (my $result = $args->[0] * $i + $args->[1]) < 1;
181 last unless my $sibling = $siblings[$result - 1];
182 return 1 if $sibling eq $current;
187 elsif ($class =~ /^only-(?:child|(of-type))$/) {
188 $_ ne $current and return undef
189 for @{_siblings($current, $1 ? $current->[1] : undef)};
197 my ($one, $tree, $group) = @_;
200 my @queue = @$tree[($tree->[0] eq 'root' ? 1 : 4) .. $#$tree];
201 while (my $current = shift @queue) {
202 next unless $current->[0] eq 'tag';
204 unshift @queue, @$current[4 .. $#$current];
205 next unless _match($group, $current, $tree);
206 $one ? return $current : push @results, $current;
209 return $one ? undef : \@results;
213 my ($selector, $current) = @_;
215 for my $s (@$selector) {
219 if ($type eq 'tag') { return undef unless $current->[1] =~ $s->[1] }
222 elsif ($type eq 'attr') { return undef unless _attr(@$s[1, 2], $current) }
225 elsif ($type eq 'pc') { return undef unless _pc(@$s[1, 2], $current) }
232 my ($selectors, $current, $tree, $immediate, $pos) = @_;
235 for my $sibling (@{_siblings($current)}) {
236 return $found if $sibling eq $current;
238 # "+" (immediately preceding sibling)
239 if ($immediate) { $found = _combinator($selectors, $sibling, $tree, $pos) }
241 # "~" (preceding sibling)
242 else { return 1 if _combinator($selectors, $sibling, $tree, $pos) }
249 my ($current, $type) = @_;
251 my $parent = $current->[3];
252 my @siblings = grep { $_->[0] eq 'tag' }
253 @$parent[($parent->[0] eq 'root' ? 1 : 4) .. $#$parent];
254 @siblings = grep { $type eq $_->[1] } @siblings if defined $type;
262 # Remove escaped newlines
265 # Unescape Unicode characters
266 $value =~ s/\\([0-9a-fA-F]{1,6})\s?/pack 'U', hex $1/ge;
275 my ($op, $value, $insensitive) = @_;
276 return undef unless defined $value;
277 $value = ($insensitive ? '(?i)' : '') . quotemeta _unescape($value);
280 return qr/(?:^|\s+)$value(?:\s+|$)/ if $op eq '~';
283 return qr/$value/ if $op eq '*';
286 return qr/^$value/ if $op eq '^';
289 return qr/$value$/ if $op eq '$';
301 DOM::Tiny::CSS - CSS selector engine
307 # Select elements from DOM tree
308 my $css = DOM::Tiny::CSS->new(tree => $tree);
309 my $elements = $css->select('h1, h2, h3');
313 L<DOM::Tiny::CSS> is the CSS selector engine used by L<DOM::Tiny> based on
314 L<Mojo::DOM::CSS>, which is based on L<Selectors Level 3|http://www.w3.org/TR/css3-selectors/>.
318 All CSS selectors that make sense for a standalone parser are supported.
324 my $all = $css->select('*');
328 An element of type C<E>.
330 my $title = $css->select('title');
334 An C<E> element with a C<foo> attribute.
336 my $links = $css->select('a[href]');
340 An C<E> element whose C<foo> attribute value is exactly equal to C<bar>.
342 my $case_sensitive = $css->select('input[type="hidden"]');
343 my $case_sensitive = $css->select('input[type=hidden]');
345 =head2 E[foo="bar" i]
347 An C<E> element whose C<foo> attribute value is exactly equal to any
348 (ASCII-range) case-permutation of C<bar>. Note that this selector is
349 EXPERIMENTAL and might change without warning!
351 my $case_insensitive = $css->select('input[type="hidden" i]');
352 my $case_insensitive = $css->select('input[type=hidden i]');
353 my $case_insensitive = $css->select('input[class~="foo" i]');
355 This selector is part of
356 L<Selectors Level 4|http://dev.w3.org/csswg/selectors-4>, which is still a work
361 An C<E> element whose C<foo> attribute value is a list of whitespace-separated
362 values, one of which is exactly equal to C<bar>.
364 my $foo = $css->select('input[class~="foo"]');
365 my $foo = $css->select('input[class~=foo]');
369 An C<E> element whose C<foo> attribute value begins exactly with the string
372 my $begins_with = $css->select('input[name^="f"]');
373 my $begins_with = $css->select('input[name^=f]');
377 An C<E> element whose C<foo> attribute value ends exactly with the string
380 my $ends_with = $css->select('input[name$="o"]');
381 my $ends_with = $css->select('input[name$=o]');
385 An C<E> element whose C<foo> attribute value contains the substring C<bar>.
387 my $contains = $css->select('input[name*="fo"]');
388 my $contains = $css->select('input[name*=fo]');
392 An C<E> element, root of the document.
394 my $root = $css->select(':root');
396 =head2 E:nth-child(n)
398 An C<E> element, the C<n-th> child of its parent.
400 my $third = $css->select('div:nth-child(3)');
401 my $odd = $css->select('div:nth-child(odd)');
402 my $even = $css->select('div:nth-child(even)');
403 my $top3 = $css->select('div:nth-child(-n+3)');
405 =head2 E:nth-last-child(n)
407 An C<E> element, the C<n-th> child of its parent, counting from the last one.
409 my $third = $css->select('div:nth-last-child(3)');
410 my $odd = $css->select('div:nth-last-child(odd)');
411 my $even = $css->select('div:nth-last-child(even)');
412 my $bottom3 = $css->select('div:nth-last-child(-n+3)');
414 =head2 E:nth-of-type(n)
416 An C<E> element, the C<n-th> sibling of its type.
418 my $third = $css->select('div:nth-of-type(3)');
419 my $odd = $css->select('div:nth-of-type(odd)');
420 my $even = $css->select('div:nth-of-type(even)');
421 my $top3 = $css->select('div:nth-of-type(-n+3)');
423 =head2 E:nth-last-of-type(n)
425 An C<E> element, the C<n-th> sibling of its type, counting from the last one.
427 my $third = $css->select('div:nth-last-of-type(3)');
428 my $odd = $css->select('div:nth-last-of-type(odd)');
429 my $even = $css->select('div:nth-last-of-type(even)');
430 my $bottom3 = $css->select('div:nth-last-of-type(-n+3)');
434 An C<E> element, first child of its parent.
436 my $first = $css->select('div p:first-child');
440 An C<E> element, last child of its parent.
442 my $last = $css->select('div p:last-child');
444 =head2 E:first-of-type
446 An C<E> element, first sibling of its type.
448 my $first = $css->select('div p:first-of-type');
450 =head2 E:last-of-type
452 An C<E> element, last sibling of its type.
454 my $last = $css->select('div p:last-of-type');
458 An C<E> element, only child of its parent.
460 my $lonely = $css->select('div p:only-child');
462 =head2 E:only-of-type
464 An C<E> element, only sibling of its type.
466 my $lonely = $css->select('div p:only-of-type');
470 An C<E> element that has no children (including text nodes).
472 my $empty = $css->select(':empty');
476 A user interface element C<E> which is checked (for instance a radio-button or
479 my $input = $css->select(':checked');
483 An C<E> element whose class is "warning".
485 my $warning = $css->select('div.warning');
489 An C<E> element with C<ID> equal to "myid".
491 my $foo = $css->select('div#foo');
495 An C<E> element that does not match simple selector C<s>.
497 my $others = $css->select('div p:not(:first-child)');
501 An C<F> element descendant of an C<E> element.
503 my $headlines = $css->select('div h1');
507 An C<F> element child of an C<E> element.
509 my $headlines = $css->select('html > body > div > h1');
513 An C<F> element immediately preceded by an C<E> element.
515 my $second = $css->select('h1 + h2');
519 An C<F> element preceded by an C<E> element.
521 my $second = $css->select('h1 ~ h2');
525 Elements of type C<E>, C<F> and C<G>.
527 my $headlines = $css->select('h1, h2, h3');
529 =head2 E[foo=bar][bar=baz]
531 An C<E> element whose attributes match all following attribute selectors.
533 my $links = $css->select('a[foo^=b][foo$=ar]');
537 L<DOM::Tiny::CSS> implements the following attributes.
541 my $tree = $css->tree;
542 $css = $css->tree(['root']);
544 Document Object Model. Note that this structure should only be used very
545 carefully since it is very dynamic.
549 L<DOM::Tiny::CSS> implements the following methods.
553 my $bool = $css->matches('head > title');
555 Check if first node in L</"tree"> matches the CSS selector.
559 my $results = $css->select('head > title');
561 Run CSS selector against L</"tree">.
565 my $result = $css->select_one('head > title');
567 Run CSS selector against L</"tree"> and stop as soon as the first node matched.
571 Report any issues on the public bugtracker.
575 Dan Book <dbook@cpan.org>
577 =head1 COPYRIGHT AND LICENSE
579 This software is Copyright (c) 2015 by Dan Book.
581 This is free software, licensed under:
583 The Artistic License 2.0 (GPL Compatible)