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