add strictures commit (out of order)
[catagits/HTML-Zoom.git] / lib / HTML / Zoom / FilterStream.pm
1 package HTML::Zoom::FilterStream;
2
3 use strictures 1;
4 use base qw(HTML::Zoom::StreamBase);
5
6 sub new {
7   my ($class, $args) = @_;
8   if ($args->{filters}) {
9     die "Single filter please (XXX FIXME)"
10       unless @{$args->{filters}} == 1;
11     $args->{filter} = $args->{filters}[0];
12   }
13   bless(
14     {
15       _stream => $args->{stream},
16       _match => $args->{match},
17       _filter => $args->{filter},
18       _zconfig => $args->{zconfig},
19     },
20     $class
21   );
22 }
23
24 sub _next {
25   my ($self, $am_peek) = @_;
26
27   # if our main stream is already gone then we can short-circuit
28   # straight out - there's no way for an alternate stream to be there
29
30   return unless $self->{_stream};
31
32   # if we have an alternate stream (provided by a filter call resulting
33   # from a match on the main stream) then we want to read from that until
34   # it's gone - we're still effectively "in the match" but this is the
35   # point at which that fact is abstracted away from downstream consumers
36
37   my $_next = $am_peek ? 'peek' : 'next';
38
39   if (my $alt = $self->{_alt_stream}) {
40
41     if (my ($evt) = $alt->$_next) {
42       $self->{_peeked_from} = $alt if $am_peek;
43       return $evt;
44     }
45
46     # once the alternate stream is exhausted we can throw it away so future
47     # requests fall straight through to the main stream
48
49     delete $self->{_alt_stream};
50   }
51
52   # if there's no alternate stream currently, process the main stream
53
54   while (my ($evt) = $self->{_stream}->$_next) {
55
56     $self->{_peeked_from} = $self->{_stream} if $am_peek;
57
58     # don't match this event? return it immediately
59
60     return $evt unless $evt->{type} eq 'OPEN' and $self->{_match}->($evt);
61
62     # run our filter routine against the current event
63
64     my ($res) = $self->{_filter}->($evt, $self->{_stream});
65
66     # if the result is just an event, we can return that now
67
68     return $res if ref($res) eq 'HASH';
69
70     # if no result at all, jump back to the top of the loop to get the
71     # next event and try again - the filter has eaten this one
72
73     next unless defined $res;
74
75     # ARRAY means a pair of [ $evt, $new_stream ]
76
77     if (ref($res) eq 'ARRAY') {
78       $self->{_alt_stream} = $res->[1];
79       return $res->[0];
80     }
81
82     # the filter returned a stream - if it contains something return the
83     # first entry and stash it as the new alternate stream
84
85     if (my ($new_evt) = $res->$_next) {
86       $self->{_alt_stream} = $res;
87       $self->{_peeked_from} = $res if $am_peek;
88       return $new_evt;
89     }
90
91     # we got a new alternate stream but it turned out to be empty
92     # - this will happens for e.g. with an in place close (<foo />) that's
93     # being removed. In that case, we fall off to loop back round and try
94     # the next event from our main stream
95   } continue {
96
97     # if we fell off the bottom (empty new alternate stream or filter ate
98     # the event) then we need to advance our internal stream one so that the
99     # top of the while loop gets the right thing; also, we need to clear the
100     # _peeked_from in case our source stream is exhausted (it'll be
101     # re-assigned if the while condition gets a new event)
102
103     if ($am_peek) {
104       $self->{_stream}->next;
105       delete $self->{_peeked_from};
106     }
107   }
108
109   # main stream exhausted so throw it away so we hit the short circuit
110   # at the top and return nothing to indicate to our caller we're done
111
112   delete $self->{_stream};
113   return;
114 }
115
116 1;