File Coverage

blib/lib/POE/Filter/LZW.pm
Criterion Covered Total %
statement 18 61 29.5
branch 0 12 0.0
condition n/a
subroutine 6 13 46.1
pod 7 7 100.0
total 31 93 33.3


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