lib/HTML/Zoom/SelectorParser.pm

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