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   528 use strict;
  4         4  
  4         124  
4 4     4   388 use POE::Filter;
  4         6  
  4         78  
5              
6 4     4   16 use vars qw($VERSION @ISA);
  4         4  
  4         879  
7             $VERSION = '1.366'; # NOTE - Should be #.### (three decimal places)
8             @ISA = qw(POE::Filter);
9              
10             #------------------------------------------------------------------------------
11              
12             sub new {
13 9     9 1 2360 my $type = shift;
14 9         12 my $buffer = '';
15 9         26 my $self = bless \$buffer, $type;
16 9         32 $self;
17             }
18              
19             sub clone {
20 1     1 1 421 my $self = shift;
21 1         1 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 654 my ($self, $stream) = @_;
36 20         55 $$self .= join '', @$stream;
37             }
38              
39             sub get_one {
40 40     40 1 972 my $self = shift;
41 40 100       104 return [ ] unless length $$self;
42 20         24 my $chunk = $$self;
43 20         23 $$self = '';
44 20         44 return [ $chunk ];
45             }
46              
47             #------------------------------------------------------------------------------
48              
49             sub put {
50 18     18 1 956 my ($self, $chunks) = @_;
51 18         53 [ @$chunks ];
52             }
53              
54             #------------------------------------------------------------------------------
55              
56             sub get_pending {
57 12     12 1 483 my $self = shift;
58 12 100       32 return [ $$self ] if length $$self;
59 10         20 return undef;
60             }
61              
62             1;
63              
64             __END__