E[attr~="foo"]
[catagits/HTML-Zoom.git] / lib / HTML / Zoom / SelectorParser.pm
CommitLineData
456a815d 1package HTML::Zoom::SelectorParser;
2
3use strict;
4use warnings FATAL => 'all';
6d0f20a6 5use base qw(HTML::Zoom::SubObject);
456a815d 6use Carp qw(confess);
7
8my $sel_char = '-\w_';
9my $sel_re = qr/([$sel_char]+)/;
10
11sub new { bless({}, shift) }
12
13sub _raw_parse_simple_selector {
14 for ($_[1]) { # same pos() as outside
15
16 # '*' - match anything
17
18 /\G\*/gc and
19 return sub { 1 };
20
04d71924 21 # 'el[attr~="foo"]
22
23 /\G$sel_re\[$sel_re~="$sel_re"\]/gc and
24 return do {
25 my $name = $1;
26 my $attr = $2;
27 my $val = $3;
28 sub {
29 if (
30 $_[0]->{name} && $_[0]->{name} eq $name and
31 $_[0]->{attrs}{$attr}
32 ) {
33 my %vals = map { $_ => 1 } split /\s+/, $_[0]->{attrs}{$attr};
34 return $vals{$val}
35 }
36 return undef
37 }
38 };
39
3b8c9d7d 40 # 'el[attr="foo"]
41
42 /\G$sel_re\[$sel_re="$sel_re"\]/gc and
43 return do {
44 my $name = $1;
45 my $attr = $2;
46 my $val = $3;
47 sub {
48 $_[0]->{name} && $_[0]->{name} eq $name and
49 $_[0]->{attrs}{$attr} && $_[0]->{attrs}{$attr} eq $val
50 }
51 };
52
456a815d 53 # 'element' - match on tag name
54
55 /\G$sel_re/gc and
56 return do {
57 my $name = $1;
58 sub { $_[0]->{name} && $_[0]->{name} eq $name }
59 };
60
61 # '#id' - match on id attribute
62
63 /\G#$sel_re/gc and
64 return do {
65 my $id = $1;
66 sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
67 };
68
69 # '.class1.class2' - match on intersection of classes
70
71 /\G((?:\.$sel_re)+)/gc and
72 return do {
73 my $cls = $1; $cls =~ s/^\.//;
74 my @cl = split(/\./, $cls);
75 sub {
76 $_[0]->{attrs}{class}
6d0f20a6 77 && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
456a815d 78 }
79 };
80
7871f2ff 81 # 'el.class1' - element + class
82
83 /\G$sel_re\.$sel_re/gc and
84 return do {
85 my $cls = $1;
86 my $name = $2;
87 sub {
88 $_[0]->{name} && $_[0]->{name} eq $name and
89 $_[0]->{attrs}{class} && $_[0]->{attrs}{class} eq $cls
90 }
91 };
92
32ea0d1e 93 # 'el#id' - element + id
94
95 /\G$sel_re#$sel_re/gc and
96 return do {
97 my $id = $1;
98 my $name = $2;
99 sub {
100 $_[0]->{name} && $_[0]->{name} eq $name and
101 $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id
102 }
103 };
104
456a815d 105 confess "Couldn't parse $_ as starting with simple selector";
106 }
107}
108
109sub parse_selector {
110 my $self = $_[0];
111 my $sel = $_[1]; # my pos() only please
112 die "No selector provided" unless $sel;
113 local *_;
114 for ($sel) {
115 my @sub;
116 PARSE: { do {
117 push(@sub, $self->_raw_parse_simple_selector($_));
118 last PARSE if (pos == length);
119 /\G\s*,\s*/gc or confess "Selectors not comma separated";
120 } until (pos == length) };
121 return $sub[0] if (@sub == 1);
122 return sub {
123 foreach my $inner (@sub) {
124 if (my $r = $inner->(@_)) { return $r }
125 }
126 };
127 }
7871f2ff 128}
129
456a815d 130
1311;