1package IO::Compress::Adapter::Lzf ;
2
3use strict;
4use warnings;
5use bytes;
6
7use IO::Compress::Base::Common  2.101 qw(:Status);
8use Compress::LZF ;
9
10our ($VERSION);
11$VERSION = '2.101';
12
13use constant SIGNATURE => 'ZV';
14
15sub mkCompObject
16{
17    my $blocksize = shift ;
18
19    return bless {
20                  'Buffer'     => '',
21                  'BlockSize'  => $blocksize,
22                  #'CRC'        => ! $minimal,
23                  'Error'      => '',
24                  'ErrorNo'    => 0,
25                  'CompBytes'  => 0,
26                  'UnCompBytes'=> 0,
27                 } ;
28}
29
30sub compr
31{
32    my $self = shift ;
33
34    $self->{Buffer} .= ${ $_[0] } ;
35    return $self->writeBlock(\$_[1], 0)
36        if length $self->{Buffer} >= $self->{BlockSize} ;
37
38
39    return STATUS_OK;
40}
41
42sub flush
43{
44    my $self = shift ;
45
46    return STATUS_OK
47        unless length $self->{Buffer};
48
49    return $self->writeBlock(\$_[0], 1);
50}
51
52sub close
53{
54    my $self = shift ;
55
56    return STATUS_OK
57        unless length $self->{Buffer};
58
59    return $self->writeBlock(\$_[0], 1);
60}
61
62sub writeBlock
63{
64    my $self = shift;
65    my $flush = $_[1] ;
66    my $blockSize = $self->{BlockSize} ;
67
68    while (length $self->{Buffer} >= $blockSize) {
69        my $buff = substr($self->{Buffer}, 0, $blockSize);
70        substr($self->{Buffer}, 0, $blockSize) = '';
71        $self->writeOneBlock(\$buff, $_[0]);
72    }
73
74    if ($flush && length $self->{Buffer} ) {
75        $self->writeOneBlock(\$self->{Buffer}, $_[0]);
76        $self->{Buffer} = '';
77    }
78
79    return STATUS_OK;
80}
81
82sub writeOneBlock
83{
84    my $self   = shift;
85    my $buff = shift;
86
87    my $cmp ;
88
89    eval { $cmp = Compress::LZF::compress($$buff) };
90
91    return STATUS_ERROR
92        if $@ || ! defined $cmp;
93
94    ${ $_[0] } .= SIGNATURE ;
95
96    #$self->{UnCompBytes} += length $self->{Buffer} ;
97    $self->{UnCompBytes} += length $$buff ;
98
99    # Remove the Compress::LZF header
100    substr($cmp, 0, c_lzf_header_length($cmp)) = '';
101
102    #if (length($cmp) >= length($self->{Buffer}))
103    if (length($cmp) >= length $$buff)
104    {
105        ${ $_[0] } .= pack("Cn", 0, length($$buff));
106        ${ $_[0] } .= $$buff;
107        $self->{CompBytes} += length $$buff;
108    }
109    else {
110
111        ${ $_[0] } .= pack("Cnn", 1, length($cmp), length($$buff));
112        ${ $_[0] } .= $cmp;
113        $self->{CompBytes} += length $cmp;
114    }
115    #$self->{Buffer} = '';
116
117    return STATUS_OK;
118}
119
120sub c_lzf_header_length
121{
122    my $firstByte = unpack ("C", substr($_[0], 0, 1));
123
124    return 1 if     $firstByte == 0 ;
125    return 1 unless $firstByte & 0x80 ;
126    return 2 unless $firstByte & 0x20 ;
127    return 3 unless $firstByte & 0x10 ;
128    return 4 unless $firstByte & 0x08 ;
129    return 5 unless $firstByte & 0x04 ;
130    return 6 unless $firstByte & 0x02 ;
131
132    return undef;
133}
134
135sub reset
136{
137    return STATUS_OK;
138}
139
140sub compressedBytes
141{
142    my $self = shift ;
143    $self->{CompBytes};
144}
145
146sub uncompressedBytes
147{
148    my $self = shift ;
149    $self->{UnCompBytes};
150}
151
1521;
153
154__END__
155