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   639 use strict;
  4         7  
  4         133  
4 4     4   346 use POE::Filter;
  4         6  
  4         83  
5              
6 4     4   13 use vars qw($VERSION @ISA);
  4         4  
  4         829  
7             $VERSION = '1.365'; # NOTE - Should be #.### (three decimal places)
8             @ISA = qw(POE::Filter);
9              
10             #------------------------------------------------------------------------------
11              
12             sub new {
13 9     9 1 4014 my $type = shift;
14 9         14 my $buffer = '';
15 9         55 my $self = bless \$buffer, $type;
16 9         38 $self;
17             }
18              
19             sub clone {
20 1     1 1 610 my $self = shift;
21 1         2 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 1025 my ($self, $stream) = @_;
36 20         75 $$self .= join '', @$stream;
37             }
38              
39             sub get_one {
40 40     40 1 1403 my $self = shift;
41 40 100       125 return [ ] unless length $$self;
42 20         31 my $chunk = $$self;
43 20         29 $$self = '';
44 20         56 return [ $chunk ];
45             }
46              
47             #------------------------------------------------------------------------------
48              
49             sub put {
50 18     18 1 1351 my ($self, $chunks) = @_;
51 18         76 [ @$chunks ];
52             }
53              
54             #------------------------------------------------------------------------------
55              
56             sub get_pending {
57 12     12 1 812 my $self = shift;
58 12 100       49 return [ $$self ] if length $$self;
59 10         21 return undef;
60             }
61              
62             1;
63              
64             __END__