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} =~ /\Q$val\E$/
68 /\G$sel_re\[$sel_re="$sel_re"\]/gc and
74 $_[0]->{name} && $_[0]->{name} eq $name and
75 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} eq $val
81 /\G$sel_re\[$sel_re\]/gc and
86 $_[0]->{name} && $_[0]->{name} eq $name && $_[0]->{attrs}{$attr}
90 # 'element' - match on tag name
95 sub { $_[0]->{name} && $_[0]->{name} eq $name }
98 # '#id' - match on id attribute
103 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
106 # '.class1.class2' - match on intersection of classes
108 /\G((?:\.$sel_re)+)/gc and
110 my $cls = $1; $cls =~ s/^\.//;
111 my @cl = split(/\./, $cls);
113 $_[0]->{attrs}{class}
114 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
118 # 'el.class1' - element + class
120 /\G$sel_re\.$sel_re/gc and
125 $_[0]->{name} && $_[0]->{name} eq $name and
126 $_[0]->{attrs}{class} && $_[0]->{attrs}{class} eq $cls
130 # 'el#id' - element + id
132 /\G$sel_re#$sel_re/gc and
137 $_[0]->{name} && $_[0]->{name} eq $name and
138 $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id
142 confess "Couldn't parse $_ as starting with simple selector";
148 my $sel = $_[1]; # my pos() only please
149 die "No selector provided" unless $sel;
154 push(@sub, $self->_raw_parse_simple_selector($_));
155 last PARSE if (pos == length);
156 /\G\s*,\s*/gc or confess "Selectors not comma separated";
157 } until (pos == length) };
158 return $sub[0] if (@sub == 1);
160 foreach my $inner (@sub) {
161 if (my $r = $inner->(@_)) { return $r }