1 package HTML::Zoom::SelectorParser;
4 use warnings FATAL => 'all';
5 use base qw(HTML::Zoom::SubObject);
9 my $sel_re = qr/([$sel_char]+)/;
10 my $match_value_re = qr/"?$sel_re"?/;
13 sub new { bless({}, shift) }
15 sub _raw_parse_simple_selector {
16 for ($_[1]) { # same pos() as outside
18 # '*' - match anything
23 # 'element' - match on tag name
28 sub { $_[0]->{name} && $_[0]->{name} eq $name }
31 # '#id' - match on id attribute
36 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
39 # '.class1.class2' - match on intersection of classes
41 /\G((?:\.$sel_re)+)/gc and
43 my $cls = $1; $cls =~ s/^\.//;
44 my @cl = split(/\./, $cls);
47 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
51 # '[attr^=foo]' - match attribute with ^ anchored regex
52 /\G\[$sel_re\^=$match_value_re\]/gc and
57 $_[0]->{attrs}{$attribute}
58 && $_[0]->{attrs}{$attribute} =~ qr/^\Q$value\E/;
62 # '[attr$=foo]' - match attribute with $ anchored regex
63 /\G\[$sel_re\$=$match_value_re\]/gc and
68 $_[0]->{attrs}{$attribute}
69 && $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E$/;
73 # '[attr*=foo] - match attribute with regex:
74 /\G\[$sel_re\*=$match_value_re\]/gc and
79 $_[0]->{attrs}{$attribute}
80 && $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E/;
84 # '[attr~=bar]' - match attribute contains word
85 /\G\[$sel_re~=$match_value_re\]/gc and
90 $_[0]->{attrs}{$attribute}
91 && grep { $_ eq $value } split(' ', $_[0]->{attrs}{$attribute});
95 # '[attr=bar]' - match attributes
96 /\G\[$sel_re=$match_value_re\]/gc and
101 $_[0]->{attrs}{$attribute}
102 && $_[0]->{attrs}{$attribute} eq $value;
106 # '[attr]' - match attribute being present:
107 /\G\[$sel_re\]/gc and
111 exists $_[0]->{attrs}{$attribute};
115 # none of the above matched, try catching some obvious errors:
117 # indicate unmatched square bracket:
118 /\G\[[^\]]*/gc and $_[0]->_blam('Unmatched [');
124 my $sel = $_[1]; # my pos() only please
125 die "No selector provided" unless $sel;
133 # slurp selectors until we find something else:
134 while( my $sel = $self->_raw_parse_simple_selector($_) ){
135 push @this_chain, $sel;
138 if( @this_chain == 1 )
140 push @sub, @this_chain;
143 # make a compound match closure of everything
144 # in this chain of selectors:
147 for my $inner ( @this_chain ){
148 if( ! ($r = $inner->( @_ )) ){
156 # now we're at the end or a delimiter:
157 last PARSE if( pos == length );
158 /\G\s*,\s*/gc or do {
160 $self->_blam( "Selectors not comma separated." );
163 } until (pos == length) };
164 return $sub[0] if (@sub == 1);
166 foreach my $inner (@sub) {
167 if (my $r = $inner->(@_)) { return $r }
175 my ($self, $error) = @_;
176 my $hat = (' ' x (pos||0)).'^';
177 die "Error parsing dispatch specification: ${error}\n