Commit | Line | Data |
9d159224 |
1 | package HTML::Zoom::SelectorParser; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | use Carp qw(confess); |
6 | |
7 | my $sel_char = '-\w_'; |
8 | my $sel_re = qr/([$sel_char]+)/; |
9 | |
10 | sub _raw_parse_simple_selector { |
11 | for ($_[1]) { # same pos() as outside |
12 | |
13 | # '*' - match anything |
14 | |
15 | /\G\*/gc and |
16 | return sub { 1 }; |
17 | |
18 | # 'element' - match on tag name |
19 | |
20 | /\G$sel_re/gc and |
21 | return do { |
22 | my $name = $1; |
23 | sub { $_[0]->{name} && $_[0]->{name} eq $name } |
24 | }; |
25 | |
26 | # '#id' - match on id attribute |
27 | |
28 | /\G#$sel_re/gc and |
29 | return do { |
30 | my $id = $1; |
31 | sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id } |
32 | }; |
33 | |
34 | # '.class1.class2' - match on intersection of classes |
35 | |
36 | /\G((?:\.$sel_re)+)/gc and |
37 | return do { |
38 | my $cls = $1; $cls =~ s/^\.//; |
39 | my @cl = split(/\./, $cls); |
40 | sub { |
41 | $_[0]->{attrs}{class} |
42 | && !grep $_[0]->{attrs}{class} !~ /\b$_\b/, @cl |
43 | } |
44 | }; |
45 | |
46 | confess "Couldn't parse $_ as starting with simple selector"; |
47 | } |
48 | } |
49 | |
50 | sub parse_selector { |
51 | my $self = $_[0]; |
52 | my $sel = $_[1]; # my pos() only please |
53 | local *_; |
54 | for ($sel) { |
55 | my @sub; |
56 | PARSE: { do { |
57 | push(@sub, $self->_raw_parse_simple_selector($_)); |
58 | last PARSE if (pos == length); |
59 | /\G\s*,\s*/gc or confess "Selectors not comma separated"; |
60 | } until (pos == length) }; |
61 | return $sub[0] if (@sub == 1); |
62 | return sub { |
63 | foreach my $inner (@sub) { |
64 | if (my $r = $inner->(@_)) { return $r } |
65 | } |
66 | }; |
67 | } |
68 | } |
69 | |
70 | |
71 | 1; |