File Coverage

blib/lib/POE/Filter/Bzip2.pm
Criterion Covered Total %
statement 55 62 88.7
branch 7 14 50.0
condition n/a
subroutine 12 13 92.3
pod 7 7 100.0
total 81 96 84.3


line stmt bran cond sub pod time code
1             package POE::Filter::Bzip2;
2              
3 2     2   53783 use strict;
  2         5  
  2         137  
4 2     2   12 use warnings;
  2         4  
  2         65  
5 2     2   11 use Carp;
  2         9  
  2         981  
6 2     2   2178 use Compress::Bzip2 qw(compress decompress);
  2         41728  
  2         424  
7 2     2   20 use vars qw($VERSION);
  2         5  
  2         108  
8 2     2   12 use base qw(POE::Filter);
  2         2  
  2         2362  
9              
10             $VERSION = '1.58';
11              
12             sub new {
13 2     2 1 439 my $type = shift;
14 2 50       11 croak "$type requires an even number of parameters" if @_ % 2;
15 2         5 my $buffer = { @_ };
16 2         4 $buffer->{ lc $_ } = delete $buffer->{ $_ } for keys %{ $buffer };
  2         11  
17 2 50       10 $buffer->{level} = 1 unless $buffer->{level};
18 2         7 $buffer->{BUFFER} = [];
19 2         19 return bless $buffer, $type;
20             }
21              
22             sub level {
23 0     0 1 0 my $self = shift;
24 0         0 my $level = shift;
25 0 0       0 $self->{level} = $level if defined $level;
26 0         0 return $self->{level};
27             }
28              
29             sub get {
30 2     2 1 17 my ($self, $raw_lines) = @_;
31 2         4 my $events = [];
32              
33 2         6 foreach my $raw_line (@$raw_lines) {
34 2 50       123 if ( my $line = decompress( $raw_line ) ) {
35 2         10 push @$events, $line;
36             }
37             else {
38 0         0 warn "Couldn\'t decompress input\n";
39             }
40             }
41 2         7 return $events;
42             }
43              
44             sub get_one_start {
45 1     1 1 24 my ($self, $raw_lines) = @_;
46 1         2 push @{ $self->{BUFFER} }, $_ for @{ $raw_lines };
  1         3  
  3         8  
47             }
48              
49             sub get_one {
50 4     4 1 191 my $self = shift;
51 4         7 my $events = [];
52              
53 4 100       5 if ( my $raw_line = shift @{ $self->{BUFFER} } ) {
  4         17  
54 3 50       71 if ( my $line = decompress( $raw_line ) ) {
55 3         8 push @$events, $line;
56             }
57             else {
58 0         0 warn "Couldn\'t decompress input\n";
59             }
60             }
61 4         11 return $events;
62             }
63              
64             sub put {
65 3     3 1 3193 my ($self, $events) = @_;
66 3         6 my $raw_lines = [];
67              
68 3         6 foreach my $event (@$events) {
69 5 50       858 if ( my $line = compress( $event, $self->{level} ) ) {
70 5         22 push @$raw_lines, $line;
71             }
72             else {
73 0         0 warn "Couldn\'t compress output\n";
74             }
75             }
76 3         10 return $raw_lines;
77             }
78              
79             sub clone {
80 1     1 1 7 my $self = shift;
81 1         2 my $nself = { };
82 1         2 $nself->{$_} = $self->{$_} for keys %{ $self };
  1         14  
83 1         4 $nself->{BUFFER} = [ ];
84 1         5 return bless $nself, ref $self;
85             }
86              
87             1;
88              
89             __END__