1 package HTML::Zoom::SelectorParser;
4 use warnings FATAL => 'all';
5 use base qw(HTML::Zoom::SubObject);
9 my $sel_re = qr/([$sel_char]+)/;
11 sub new { bless({}, shift) }
13 sub _raw_parse_simple_selector {
14 for ($_[1]) { # same pos() as outside
16 # '*' - match anything
23 /\G$sel_re\[$sel_re~="$sel_re"\]/gc and
30 $_[0]->{name} && $_[0]->{name} eq $name and
33 my %vals = map { $_ => 1 } split /\s+/, $_[0]->{attrs}{$attr};
42 /\G$sel_re\[$sel_re\^="$sel_re"\]/gc and
48 $_[0]->{name} && $_[0]->{name} eq $name and
49 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} =~ /^\Q$val\E/
55 /\G$sel_re\[$sel_re="$sel_re"\]/gc and
61 $_[0]->{name} && $_[0]->{name} eq $name and
62 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} eq $val
68 /\G$sel_re\[$sel_re\]/gc and
73 $_[0]->{name} && $_[0]->{name} eq $name && $_[0]->{attrs}{$attr}
77 # 'element' - match on tag name
82 sub { $_[0]->{name} && $_[0]->{name} eq $name }
85 # '#id' - match on id attribute
90 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
93 # '.class1.class2' - match on intersection of classes
95 /\G((?:\.$sel_re)+)/gc and
97 my $cls = $1; $cls =~ s/^\.//;
98 my @cl = split(/\./, $cls);
100 $_[0]->{attrs}{class}
101 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
105 # 'el.class1' - element + class
107 /\G$sel_re\.$sel_re/gc and
112 $_[0]->{name} && $_[0]->{name} eq $name and
113 $_[0]->{attrs}{class} && $_[0]->{attrs}{class} eq $cls
117 # 'el#id' - element + id
119 /\G$sel_re#$sel_re/gc and
124 $_[0]->{name} && $_[0]->{name} eq $name and
125 $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id
129 confess "Couldn't parse $_ as starting with simple selector";
135 my $sel = $_[1]; # my pos() only please
136 die "No selector provided" unless $sel;
141 push(@sub, $self->_raw_parse_simple_selector($_));
142 last PARSE if (pos == length);
143 /\G\s*,\s*/gc or confess "Selectors not comma separated";
144 } until (pos == length) };
145 return $sub[0] if (@sub == 1);
147 foreach my $inner (@sub) {
148 if (my $r = $inner->(@_)) { return $r }