File Coverage

blib/lib/POE/Filter/Stream.pm
Criterion Covered Total %
statement 28 28 100.0
branch 4 4 100.0
condition n/a
subroutine 9 9 100.0
pod 6 6 100.0
total 47 47 100.0


line stmt bran cond sub pod time code
1             package POE::Filter::Stream;
2              
3 4     4   784 use strict;
  4         6  
  4         181  
4 4     4   578 use POE::Filter;
  4         7  
  4         112  
5              
6 4     4   23 use vars qw($VERSION @ISA);
  4         3  
  4         1278  
7             $VERSION = '1.367'; # NOTE - Should be #.### (three decimal places)
8             @ISA = qw(POE::Filter);
9              
10             #------------------------------------------------------------------------------
11              
12             sub new {
13 9     9 1 4275 my $type = shift;
14 9         19 my $buffer = '';
15 9         39 my $self = bless \$buffer, $type;
16 9         45 $self;
17             }
18              
19             sub clone {
20 1     1 1 565 my $self = shift;
21 1         3 my $buffer = '';
22 1         4 my $clone = bless \$buffer, ref $self;
23             }
24              
25             #------------------------------------------------------------------------------
26             # get() is inherited from POE::Filter.
27              
28             #------------------------------------------------------------------------------
29             # 2001-07-27 RCC: The get_one() variant of get() allows Wheel::Xyz to
30             # retrieve one filtered block at a time. This is necessary for filter
31             # changing and proper input flow control. Although it's kind of
32             # pointless for Stream, but it has to follow the proper interface.
33              
34             sub get_one_start {
35 20     20 1 1066 my ($self, $stream) = @_;
36 20         96 $$self .= join '', @$stream;
37             }
38              
39             sub get_one {
40 40     40 1 1392 my $self = shift;
41 40 100       145 return [ ] unless length $$self;
42 20         38 my $chunk = $$self;
43 20         37 $$self = '';
44 20         68 return [ $chunk ];
45             }
46              
47             #------------------------------------------------------------------------------
48              
49             sub put {
50 18     18 1 1667 my ($self, $chunks) = @_;
51 18         208 [ @$chunks ];
52             }
53              
54             #------------------------------------------------------------------------------
55              
56             sub get_pending {
57 12     12 1 805 my $self = shift;
58 12 100       45 return [ $$self ] if length $$self;
59 10         26 return undef;
60             }
61              
62             1;
63              
64             __END__