code/HTML/Zoom/EventFilter.pm

   1 package HTML::Zoom::EventFilter;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use Carp qw(confess);
   6
   7 sub from_code {
   8   my ($class, $code) = @_;
   9   confess "from_code is a class method" if ref $class;
  10   bless({ code => $code }, $class);
  11 }
  12
  13 sub next {
  14   my $n = shift->{next} or return;
  15   $n->${\$n->{code}}(@_);
  16 }
  17
  18 sub call {
  19   $_[0]->{code}->(@_);
  20 }
  21
  22 sub set_next {
  23   $_[0]->{next} = $_[1];
  24   $_[0];
  25 }
  26
  27 sub get_next { $_[0]->{next} }
  28
  29 sub push_next {
  30   my ($self, $code) = @_;
  31   $self->{next} = bless(
  32     { code => $code, next => $self->{next} }
  33   );
  34 }
  35
  36 sub push_last {
  37   my ($self, $code) = @_;
  38   my $target = $self;
  39   while ($target->{next} && $target->{next}{next}) {
  40     $target = $target->{next}
  41   }
  42   $target->push_next($code);
  43 }
  44
  45 sub pop {
  46   my ($self, $to) = @_;
  47   die "$self doesn't have a next (->pop($to))"
  48     unless $self->{next};
  49   my $target = $self;
  50   until ($target->{next} eq $to) {
  51     $target = $target->{next} || die "Didn't find $to as next of $self";
  52   }
  53   $target->{next} = $to->{next};
  54   $_[0];
  55 }
  56
  57 sub until_close_do_next { shift->until_close_do(next => @_) }
  58 sub until_close_do_last { shift->until_close_do(last => @_) }
  59
  60 sub until_close_do {
  61   my ($self, $direction, $do, $before_close, $after_close) = @_;
  62   my %depth = (OPEN => 1, CLOSE => -1, TEXT => 0);
  63   my $count = 1;
  64   my $outer = $self;
  65   $self->${\"push_${direction}"}(
  66     sub {
  67       my ($self, $evt) = @_;
  68       $count += $depth{$evt->{type}};
  69       if ($count) {
  70         $do->(@_, $count) if $do;
  71         return;
  72       }
  73       $before_close->($self, $evt) if $before_close;
  74       $outer->pop($self)->next($evt);
  75       $after_close->($outer, $evt) if $after_close;
  76     }
  77   )
  78 }
  79
  80 sub standard_emitter {
  81   my ($class, $out) = @_;
  82   confess "standard_emitter is a class method" if ref $class;
  83   $class->from_code(sub {
  84     my ($self, $evt) = @_;
  85     return $out->print($evt->{raw}) if defined $evt->{raw};
  86     if ($evt->{type} eq 'OPEN') {
  87       $out->print(
  88         '<'
  89         .$evt->{name}
  90         .(defined $evt->{raw_attrs}
  91             ? $evt->{raw_attrs}
  92             : do {
  93                 my @names = @{$evt->{attr_names}};
  94                 @names
  95                   ? join(' ', '', map qq{${_}="${\$evt->{attrs}{$_}}"}, @names)
  96                   : ''
  97               }
  98          )
  99         .($evt->{is_in_place_close} ? ' /' : '')
 100         .'>'
 101       );
 102     } elsif ($evt->{type} eq 'CLOSE') {
 103       $out->print('</'.$evt->{name}.'>');
 104     } else {
 105       confess "No raw value in event and no special handling for type ".$evt->{type};
 106     }
 107   });
 108 }
 109
 110 sub selector_handler {
 111   my ($class, $pairs) = @_;
 112   confess "selector_handler is a class method" if ref $class;
 113   $class->from_code(sub {
 114     my ($self, $evt) = @_;
 115     my $next = $self->get_next;
 116     if ($evt->{type} eq 'OPEN') {
 117       foreach my $p (@$pairs) {
 118         $p->[1]->($self, $evt) if $p->[0]->($evt);
 119       }
 120     }
 121     $next->call($evt);
 122   });
 123 }
 124
 125 sub build_selector_pair {
 126   my ($class, $sel_spec, $action_spec) = @_;
 127   my $selector = HTML::Zoom::SelectorParser->parse_selector($sel_spec);
 128   my $action;
 129   if (ref($action_spec) eq 'HASH') {
 130     confess "hash spec must be single key"
 131       unless keys(%$action_spec) == 1;
 132     my ($key) = keys (%$action_spec);
 133     $key =~ s/^-//;
 134     $action = HTML::Zoom::ActionBuilder->build($key, values %$action_spec);
 135   }
 136   [ $selector, $action ];
 137 }
 138
 139 1;