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