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 $self->{name} && $self->{name} eq $name and
18 $self->{attrs}{$attr} && $self->{attrs}{$attr} =~ $regex
22 my $match_attr_on_eq = sub {
23 my ($self, $name, $attr, $val) = @_;
26 $self->{name} && $self->{name} eq $name and
27 $self->{attrs}{$attr} && $self->{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 # 'element' - match on tag name
94 sub { $_[0]->{name} && $_[0]->{name} eq $name }
97 # '#id' - match on id attribute
102 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
105 # '.class1.class2' - match on intersection of classes
107 /\G((?:\.$sel_re)+)/gc and
109 my $cls = $1; $cls =~ s/^\.//;
110 my @cl = split(/\./, $cls);
112 $_[0]->{attrs}{class}
113 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
117 # 'el.class1' - element + class
119 /\G$sel_re\.$sel_re/gc and
120 return do { $_[0]->$match_attr_on_eq($1, 'class', $3) };
122 # 'el#id' - element + id
124 /\G$sel_re#$sel_re/gc and
125 return do { $_[0]->$match_attr_on_eq($1, 'id', $3) };
127 confess "Couldn't parse $_ as starting with simple selector";
133 my $sel = $_[1]; # my pos() only please
134 die "No selector provided" unless $sel;
139 push(@sub, $self->_raw_parse_simple_selector($_));
140 last PARSE if (pos == length);
141 /\G\s*,\s*/gc or confess "Selectors not comma separated";
142 } until (pos == length) };
143 return $sub[0] if (@sub == 1);
145 foreach my $inner (@sub) {
146 if (my $r = $inner->(@_)) { return $r }