File Coverage

blib/lib/POE/Filter/LZF.pm
Criterion Covered Total %
statement 51 54 94.4
branch 6 10 60.0
condition n/a
subroutine 11 11 100.0
pod 6 6 100.0
total 74 81 91.3


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