lib/HTML/Zoom/SelectorParser.pm

   1 package HTML::Zoom::SelectorParser;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use base qw(HTML::Zoom::SubObject);
   6 use Carp qw(confess);
   7
   8 my $sel_char = '-\w_';
   9 my $sel_re = qr/([$sel_char]+)/;
  10
  11 sub new { bless({}, shift) }
  12
  13 sub _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
  21     # 'element' - match on tag name
  22
  23     /\G$sel_re/gc and
  24       return do {
  25         my $name = $1;
  26         sub { $_[0]->{name} && $_[0]->{name} eq $name }
  27       };
  28
  29     # '#id' - match on id attribute
  30
  31     /\G#$sel_re/gc and
  32       return do {
  33         my $id = $1;
  34         sub { $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id }
  35       };
  36
  37     # '.class1.class2' - match on intersection of classes
  38
  39     /\G((?:\.$sel_re)+)/gc and
  40       return do {
  41         my $cls = $1; $cls =~ s/^\.//;
  42         my @cl = split(/\./, $cls);
  43         sub {
  44           $_[0]->{attrs}{class}
  45           && !grep $_[0]->{attrs}{class} !~ /(^|\s+)$_($|\s+)/, @cl
  46         }
  47       };
  48
  49     # 'el.class1' - element + class
  50
  51     /\G$sel_re\.$sel_re/gc and
  52       return do {
  53         my $cls = $1;
  54         my $name = $2;
  55         sub {
  56            $_[0]->{name} && $_[0]->{name} eq $name and
  57            $_[0]->{attrs}{class} && $_[0]->{attrs}{class} eq $cls
  58         }
  59       };
  60
  61     # 'el#id' - element + id
  62
  63     /\G$sel_re#$sel_re/gc and
  64       return do {
  65         my $id = $1;
  66         my $name = $2;
  67         sub {
  68            $_[0]->{name} && $_[0]->{name} eq $name and
  69            $_[0]->{attrs}{id} && $_[0]->{attrs}{id} eq $id
  70         }
  71       };
  72
  73     confess "Couldn't parse $_ as starting with simple selector";
  74   }
  75 }
  76
  77 sub parse_selector {
  78   my $self = $_[0];
  79   my $sel = $_[1]; # my pos() only please
  80   die "No selector provided" unless $sel;
  81   local *_;
  82   for ($sel) {
  83     my @sub;
  84     PARSE: { do {
  85       push(@sub, $self->_raw_parse_simple_selector($_));
  86       last PARSE if (pos == length);
  87       /\G\s*,\s*/gc or confess "Selectors not comma separated";
  88     } until (pos == length) };
  89     return $sub[0] if (@sub == 1);
  90     return sub {
  91       foreach my $inner (@sub) {
  92         if (my $r = $inner->(@_)) { return $r }
  93       }
  94     };
  95   }
  96 }
  97
  98
  99 1;