File Coverage

blib/lib/POE/Filter/Bzip2.pm
Criterion Covered Total %
statement 52 59 88.1
branch 7 14 50.0
condition n/a
subroutine 11 12 91.6
pod 7 7 100.0
total 77 92 83.7


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