File Coverage

blib/lib/IO/Compress/Adapter/LZO.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package IO::Compress::Adapter::LZO ;
2              
3 10     10   33 use strict;
  10         10  
  10         235  
4 10     10   28 use warnings;
  10         13  
  10         191  
5 10     10   28 use bytes;
  10         9  
  10         34  
6              
7 10     10   215 use IO::Compress::Base::Common 2.072 qw(:Status);
  10         144  
  10         1265  
8 10     10   8347 use Compress::LZO qw(crc32 adler32);
  0            
  0            
9              
10             our ($VERSION);
11             $VERSION = '2.072';
12              
13             sub mkCompObject
14             {
15             my $blocksize = shift ;
16             my $optimize = shift ;
17             my $minimal = shift ;
18              
19              
20             return bless {
21             'Buffer' => '',
22             'BlockSize' => $blocksize,
23             'Optimize' => $optimize,
24             'CRC' => ! $minimal,
25             'Error' => '',
26             'ErrorNo' => 0,
27             'CompBytes' => 0,
28             'UnCompBytes'=> 0,
29             } ;
30             }
31              
32             sub compr
33             {
34             my $self = shift ;
35              
36             $self->{Buffer} .= ${ $_[0] } ;
37             return $self->writeBlock(\$_[1], 0)
38             if length $self->{Buffer} >= $self->{BlockSize} ;
39            
40              
41             return STATUS_OK;
42             }
43              
44             sub flush
45             {
46             my $self = shift ;
47              
48             return STATUS_OK
49             unless length $self->{Buffer};
50              
51             return $self->writeBlock(\$_[0], 1);
52             }
53              
54             sub close
55             {
56             my $self = shift ;
57              
58             return STATUS_OK
59             unless length $self->{Buffer};
60              
61             return $self->writeBlock(\$_[0], 1);
62             }
63              
64             sub writeBlock
65             {
66             my $self = shift;
67             my $flush = $_[1] ;
68             my $blockSize = $self->{BlockSize} ;
69              
70             while (length $self->{Buffer} >= $blockSize) {
71             my $buff = substr($self->{Buffer}, 0, $blockSize);
72             substr($self->{Buffer}, 0, $blockSize) = '';
73             $self->writeOneBlock(\$buff, $_[0]);
74             }
75              
76             if ($flush && length $self->{Buffer} ) {
77             $self->writeOneBlock(\$self->{Buffer}, $_[0]);
78             $self->{Buffer} = '';
79             }
80              
81             return STATUS_OK;
82             }
83              
84             sub writeOneBlock
85             {
86             my $self = shift;
87             my $buff = shift;
88              
89             #my $cmp = Compress::LZO::my_compress($self->{Buffer});
90             my $cmp = Compress::LZO::compress($$buff);
91              
92             return STATUS_ERROR
93             unless defined $cmp;
94              
95              
96             if ($self->{Optimize}) {
97             my $oldLen = length $cmp;
98             $cmp = Compress::LZO::optimize($cmp);
99              
100             return STATUS_ERROR
101             if ! defined $cmp || length($cmp) != $oldLen ;
102             }
103              
104             $cmp = substr($cmp, 5);
105              
106             #$self->{UnCompBytes} += length $self->{Buffer} ;
107             $self->{UnCompBytes} += length $$buff ;
108              
109             #if (length($cmp) >= length($self->{Buffer}))
110             if (length($cmp) >= length $$buff)
111             {
112             ${ $_[0] } .= pack("NN", length($$buff), length($$buff) );
113             if ($self->{CRC}) {
114             ${ $_[0] } .= pack("N", adler32($$buff));
115             }
116             ${ $_[0] } .= $$buff;
117             $self->{CompBytes} += length $$buff;
118             }
119             else {
120              
121             ${ $_[0] } .= pack("NN", length($$buff), length($cmp));
122             if ($self->{CRC}) {
123             ${ $_[0] } .= pack("NN", adler32($$buff), adler32($cmp));
124             }
125             ${ $_[0] } .= $cmp;
126             $self->{CompBytes} += length $cmp;
127             }
128             #$self->{Buffer} = '';
129              
130             return STATUS_OK;
131             }
132              
133             sub reset
134             {
135             return STATUS_OK;
136             }
137              
138             sub compressedBytes
139             {
140             my $self = shift ;
141             $self->{CompBytes};
142             }
143              
144             sub uncompressedBytes
145             {
146             my $self = shift ;
147             $self->{UnCompBytes};
148             }
149              
150              
151              
152             #sub total_out
153             #{
154             # my $self = shift ;
155             # 0;
156             #}
157              
158             #sub total_in
159             #{
160             # my $self = shift ;
161             # $self->{Def}->total_in();
162             #}
163             #
164             #sub crc32
165             #{
166             # my $self = shift ;
167             # $self->{Def}->crc32();
168             #}
169             #
170             #sub adler32
171             #{
172             # my $self = shift ;
173             # $self->{Def}->adler32();
174             #}
175              
176              
177             1;
178              
179             __END__