File Coverage

blib/lib/POE/Filter/Stackable.pm
Criterion Covered Total %
statement 84 87 96.5
branch 15 24 62.5
condition 4 9 44.4
subroutine 17 17 100.0
pod 12 12 100.0
total 132 149 88.5


line stmt bran cond sub pod time code
1             # 2001/01/25 shizukesa@pobox.com
2              
3             # This implements a filter stack, which turns ReadWrite into something
4             # very, very interesting.
5              
6             # 2001-07-26 RCC: I have no idea how to make this support get_one, so
7             # I'm not going to right now.
8              
9             package POE::Filter::Stackable;
10              
11 1     1   743 use strict;
  1         2  
  1         38  
12 1     1   436 use POE::Filter;
  1         2  
  1         34  
13              
14 1     1   5 use vars qw($VERSION @ISA);
  1         1  
  1         52  
15             $VERSION = '1.366'; # NOTE - Should be #.### (three decimal places)
16             @ISA = qw(POE::Filter);
17              
18 1     1   3 use Carp qw(croak);
  1         1  
  1         61  
19              
20             sub FILTERS () { 0 }
21              
22             sub FIRST_UNUSED () { 1 } # First unused $self offset.
23              
24 1     1   4 use base 'Exporter';
  1         1  
  1         669  
25             our @EXPORT_OK = qw( FIRST_UNUSED );
26              
27             #------------------------------------------------------------------------------
28              
29             sub new {
30 1     1 1 1 my $type = shift;
31 1 50       3 croak "$type must be given an even number of parameters" if @_ & 1;
32 1         2 my %params = @_;
33              
34 1 50       2 $params{Filters} = [ ] unless defined $params{Filters};
35             # Sanity check the filters
36 1 50       3 if ( ref $params{Filters} eq 'ARRAY') {
37              
38 1         2 my $self = bless [
39             $params{Filters}, # FILTERS
40             ], $type;
41              
42 1         2 return $self;
43             } else {
44 0         0 croak "Filters is not an ARRAY reference!";
45             }
46             }
47              
48             sub clone {
49 1     1 1 5 my $self = shift;
50 1         4 my $clone = bless [
51             [ ], # FILTERS
52             ], ref $self;
53 1         2 foreach my $filter (@{$self->[FILTERS]}) {
  1         3  
54 4         3 push (@{$clone->[FILTERS]}, $filter->clone());
  4         28  
55             }
56 1         3 $clone;
57             }
58              
59             #------------------------------------------------------------------------------
60              
61             sub get_one_start {
62 2     2 1 3 my ($self, $data) = @_;
63 2         11 $self->[FILTERS]->[0]->get_one_start($data);
64             }
65              
66             # RCC 2005-06-28: get_one() needs to strobe through all the filters
67             # regardless whether there's data to input to each. This is because a
68             # later filter in the chain may produce multiple things from one piece
69             # of input. If we stop even though there's no subsequent input, we
70             # may lose something.
71             #
72             # Keep looping through the filters we manage until get_one() returns a
73             # record, or until none of the filters exchange data.
74              
75             sub get_one {
76 3     3 1 4 my ($self) = @_;
77              
78 3         4 my $return = [ ];
79              
80 3         7 while (!@$return) {
81 6         6 my $exchanged = 0;
82              
83 6         6 foreach my $filter (@{$self->[FILTERS]}) {
  6         7  
84              
85             # If we have something to input to the next filter, do that.
86 24 100       56 if (@$return) {
87 10         19 $filter->get_one_start($return);
88 10         12 $exchanged++;
89             }
90              
91             # Get what we can from the current filter.
92 24         41 $return = $filter->get_one();
93             }
94              
95 6 100       17 last unless $exchanged;
96             }
97              
98 3         9 return $return;
99             }
100              
101             # get() is inherited from POE::Filter.
102              
103             #------------------------------------------------------------------------------
104              
105             sub put {
106 1     1 1 656 my ($self, $data) = @_;
107 1         2 foreach my $filter (reverse @{$self->[FILTERS]}) {
  1         3  
108 4         16 $data = $filter->put($data);
109 4 50       12 last unless @$data;
110             }
111 1         2 $data;
112             }
113              
114             #------------------------------------------------------------------------------
115              
116             sub get_pending {
117 1     1 1 327 my ($self) = @_;
118 1         1 my $data;
119 1         1 for (@{$self->[FILTERS]}) {
  1         3  
120 4 50 33     16 $_->put($data) if $data && @{$data};
  0         0  
121 4         10 $data = $_->get_pending;
122             }
123 1 50       4 $data || [];
124             }
125              
126             #------------------------------------------------------------------------------
127              
128             sub filter_types {
129 3     3 1 324 map { ref($_) } @{$_[0]->[FILTERS]};
  12         44  
  3         7  
130             }
131              
132             #------------------------------------------------------------------------------
133              
134             sub filters {
135 6     6 1 2403 @{$_[0]->[FILTERS]};
  6         23  
136             }
137              
138             #------------------------------------------------------------------------------
139              
140             sub shift {
141 1     1 1 315 my ($self) = @_;
142 1         2 my $filter = shift @{$self->[FILTERS]};
  1         2  
143 1         3 my $pending = $filter->get_pending;
144 1 50       3 $self->[FILTERS]->[0]->put( $pending ) if $pending;
145 1         2 $filter;
146             }
147              
148             #------------------------------------------------------------------------------
149              
150             sub unshift {
151 1     1 1 4 my ($self, @filters) = @_;
152              
153             # Sanity check
154 1         2 foreach my $elem ( @filters ) {
155 1 50 33     6 if ( ! defined $elem or ! UNIVERSAL::isa( $elem, 'POE::Filter' ) ) {
156 0         0 croak "Filter element is not a POE::Filter instance!";
157             }
158             }
159              
160 1         7 unshift(@{$self->[FILTERS]}, @filters);
  1         3  
161             }
162              
163             #------------------------------------------------------------------------------
164              
165             sub push {
166 5     5 1 1470 my ($self, @filters) = @_;
167              
168             # Sanity check
169 5         9 foreach my $elem ( @filters ) {
170 5 100 66     25 if ( ! defined $elem or ! UNIVERSAL::isa( $elem, 'POE::Filter' ) ) {
171 4         421 croak "Filter element is not a POE::Filter instance!";
172             }
173             }
174              
175 1         2 push(@{$self->[FILTERS]}, @filters);
  1         3  
176             }
177              
178             #------------------------------------------------------------------------------
179              
180             sub pop {
181 1     1 1 10 my ($self) = @_;
182 1         1 my $filter = pop @{$self->[FILTERS]};
  1         8  
183 1         6 my $pending = $filter->get_pending;
184 1 50       3 $self->[FILTERS]->[-1]->put( $pending ) if $pending;
185 1         3 $filter;
186             }
187              
188             1;
189              
190             __END__