use Carp qw(confess);
my $sel_char = '-\w_';
-my $sel_re = qr/([$sel_char]+)/;
+my $sel_meta_char = q-!"#$%&'()*+,./:;<=>?@[\]^`{|}~-;
+my $sel_re = qr/((?:(?:\\[\Q$sel_meta_char\E])|[$sel_char])+)/;
my $match_value_re = qr/"?$sel_re"?/;
/\G$sel_re/gc and
return do {
- my $name = $1;
+ my $name = $_[0]->_unescape($1);
sub { $_[0]->{name} && $_[0]->{name} eq $name }
};
/\G#$sel_re/gc and
return do {
- my $id = $1;
+ my $id = $_[0]->_unescape($1);
sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
};
/\G((?:\.$sel_re)+)/gc and
return do {
my $cls = $1; $cls =~ s/^\.//;
- my @cl = split(/\./, $cls);
+ my @cl = map $_[0]->_unescape($_), split(/(?<!\\)\./, $cls);
sub {
$_[0]->{attrs}{class}
- && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
+ && !grep $_[0]->{attrs}{class} !~ /(^|\s+)\Q$_\E($|\s+)/, @cl
}
};
# '[attr^=foo]' - match attribute with ^ anchored regex
/\G\[$sel_re\^=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} =~ qr/^\Q$value\E/;
# '[attr$=foo]' - match attribute with $ anchored regex
/\G\[$sel_re\$=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E$/;
# '[attr*=foo] - match attribute with regex:
/\G\[$sel_re\*=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} =~ qr/\Q$value\E/;
# '[attr~=bar]' - match attribute contains word
/\G\[$sel_re~=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} =~ qr/\b\Q$value\E\b/;
# '[attr!=bar]' - match attribute contains prefix (for language matches)
/\G\[$sel_re\|=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} =~ qr/^\Q$value\E(?:-|$)/;
# '[attr=bar]' - match attributes
/\G\[$sel_re=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
$_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} eq $value;
# '[attr!=bar]' - attributes doesn't match
/\G\[$sel_re!=$match_value_re\]/gc and
return do {
- my $attribute = $1;
- my $value = $2;
+ my $attribute = $_[0]->_unescape($1);
+ my $value = $_[0]->_unescape($2);
sub {
! ($_[0]->{attrs}{$attribute}
&& $_[0]->{attrs}{$attribute} eq $value);
# '[attr]' - match attribute being present:
/\G\[$sel_re\]/gc and
return do {
- my $attribute = $1;
+ my $attribute = $_[0]->_unescape($1);
sub {
exists $_[0]->{attrs}{$attribute};
}
};
-
+
# none of the above matched, try catching some obvious errors:
# indicate unmatched square bracket:
}
}
+sub _unescape {
+ my ($self, $escaped) = @_;
+ (my $unescaped = $escaped) =~ s/\\([\Q$sel_meta_char\E])/$1/g;
+ return $unescaped;
+}
sub _blam {
my ($self, $error) = @_;
'<div class="yo">grg</div>'.$stub,
'E.class works' );
+
+# el.class\.1
+is( HTML::Zoom->from_html('<div class="yo.yo"></div>'.$stub)
+ ->select('div.yo\.yo')
+ ->replace_content('grg')
+ ->to_html,
+ '<div class="yo.yo">grg</div>'.$stub,
+ 'E.class\.0 works' );
+
# el[attr]
is( HTML::Zoom->from_html('<div frew="yo"></div>'.$stub)
->select('div[frew]')
'<div frew="yo">grg</div>'.$stub,
'E[attr=val] works' );
+# el[attr=foo\.bar]
+is( HTML::Zoom->from_html('<div frew="yo.yo"></div>'.$stub)
+ ->select('div[frew=yo\.yo]')
+ ->replace_content('grg')
+ ->to_html,
+ '<div frew="yo.yo">grg</div>'.$stub,
+ 'E[attr=foo\.bar] works' );
+
# el[attr!="foo"]
is( HTML::Zoom->from_html('<div f="f"></div><div class="quux"></div>'.$stub)
->select('div[class!="waargh"]')