File Coverage

blib/lib/POE/Filter/LZF.pm
Criterion Covered Total %
statement 54 57 94.7
branch 6 10 60.0
condition n/a
subroutine 12 12 100.0
pod 6 6 100.0
total 78 85 91.7


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