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
56 $_[0]->{attrs}{$attribute}
57 && $_[0]->{attrs}{$attribute} =~ qr/^\Q$value\E/;
60 # '[attr$=foo]' - match attribute with $ anchored regex
61 /\G\[$sel_re\$=$match_value_re\]/gc and
65 $_[0]->{attrs}{$attribute}
66 && $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E$/;
69 # '[attr*=foo] - match attribute with regex:
70 /\G\[$sel_re\*=$match_value_re\]/gc and
74 $_[0]->{attrs}{$attribute}
75 && $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E$/;
78 # '[attr=bar]' - match attributes
79 /\G\[$sel_re=$match_value_re\]/gc and
84 $_[0]->{attrs}{$attribute}
85 && $_[0]->{attrs}{$attribute} eq $value;
89 # '[attr] - match attribute being present:
93 $_[0]->{attrs}{$attribute};
100 my $sel = $_[1]; # my pos() only please
101 die "No selector provided" unless $sel;
109 # slurp selectors until we find something else:
110 while( my $sel = $self->_raw_parse_simple_selector($_) ){
111 push @this_chain, $sel;
114 if( @this_chain == 1 )
116 push @sub, @this_chain;
119 # make a compound match closure of everything
120 # in this chain of selectors:
123 for my $inner ( @this_chain ){
124 if( ! ($r = $inner->( @_ )) ){
132 # now we're at the end or a delimiter:
133 last PARSE if( pos == length );
134 /\G\s*,\s*/gc or do {
136 $self->_blam( "Selectors not comma separated." );
139 } until (pos == length) };
140 return $sub[0] if (@sub == 1);
142 foreach my $inner (@sub) {
143 if (my $r = $inner->(@_)) { return $r }
151 my ($self, $error) = @_;
152 my $hat = (' ' x (pos||0)).'^';
153 die "Error parsing dispatch specification: ${error}\n