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 my $match_attr_on_regex = sub {
14 my ($self, $name, $attr, $regex) = @_;
17 $_[0]->{name} && $_[0]->{name} eq $name and
18 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} =~ $regex
22 my $match_attr_on_eq = sub {
23 my ($self, $name, $attr, $val) = @_;
26 $_[0]->{name} && $_[0]->{name} eq $name and
27 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} eq $val
31 sub _raw_parse_simple_selector {
32 for ($_[1]) { # same pos() as outside
34 # '*' - match anything
41 /\G$sel_re\[$sel_re~="$sel_re"\]/gc and
48 $_[0]->{name} && $_[0]->{name} eq $name and
51 my %vals = map { $_ => 1 } split /\s+/, $_[0]->{attrs}{$attr};
60 /\G$sel_re\[$sel_re\^="$sel_re"\]/gc and
61 return do { $_[0]->$match_attr_on_regex($1, $2, qr/^\Q$3\E/) };
65 /\G$sel_re\[$sel_re\$="$sel_re"\]/gc and
66 return do { $_[0]->$match_attr_on_regex($1, $2, qr/\Q$3\E$/) };
70 /\G$sel_re\[$sel_re\*="$sel_re"\]/gc and
71 return do { $_[0]->$match_attr_on_regex($1, $2, qr/\Q$3\E/) };
75 /\G$sel_re\[$sel_re="$sel_re"\]/gc and
76 return do { $_[0]->$match_attr_on_eq( $1, $2, $3) };
80 /\G$sel_re\[$sel_re\]/gc and
85 $_[0]->{name} && $_[0]->{name} eq $name && $_[0]->{attrs}{$attr}
89 # 'el.class1' - element + class
91 /\G$sel_re\.$sel_re/gc and
92 return do { $_[0]->$match_attr_on_eq($1, 'class', $2) };
94 # 'el#id' - element + id
95 /\G$sel_re#$sel_re/gc and
96 return do { $_[0]->$match_attr_on_eq($1, 'id', $2) };
98 # 'element' - match on tag name
103 sub { $_[0]->{name} && $_[0]->{name} eq $name }
106 # '#id' - match on id attribute
111 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
114 # '.class1.class2' - match on intersection of classes
116 /\G((?:\.$sel_re)+)/gc and
118 my $cls = $1; $cls =~ s/^\.//;
119 my @cl = split(/\./, $cls);
121 $_[0]->{attrs}{class}
122 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
126 confess "Couldn't parse $_ as starting with simple selector";
132 my $sel = $_[1]; # my pos() only please
133 die "No selector provided" unless $sel;
138 push(@sub, $self->_raw_parse_simple_selector($_));
139 last PARSE if (pos == length);
140 #/\G\s*,\s*/gc or confess "Selectors not comma separated";
141 } until (pos == length) };
142 return $sub[0] if (@sub == 1);
144 foreach my $inner (@sub) {
145 if (my $r = $inner->(@_)) { return $r }