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__ |