File Coverage

lib/HTTP/Promise/Stream/LZW.pm
Criterion Covered Total %
statement 27 85 31.7
branch 0 28 0.0
condition 0 6 0.0
subroutine 9 15 60.0
pod 6 6 100.0
total 42 140 30.0


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Stream/LZW.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/05/04
7             ## Modified 2023/09/08
8             ## All rights reserved.
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTTP::Promise::Stream::LZW;
15             BEGIN
16             {
17 2     2   2035 use strict;
  2         4  
  2         71  
18 2     2   10 use warnings;
  2         3  
  2         65  
19 2     2   11 use HTTP::Promise::Stream;
  2         5  
  2         13  
20 2     2   604 use parent -norequire, qw( HTTP::Promise::Stream::Generic );
  2         4  
  2         13  
21 2     2   112 use vars qw( @EXPORT_OK $VERSION $EXCEPTION_CLASS $LZWError );
  2         43  
  2         165  
22             # use Nice::Try;
23             use constant {
24 2         211 ENCODE_BUFFER_SIZE => ( 32 * 1024 ),
25             DECODE_BUFFER_SIZE => ( 32 * 1024 ),
26 2     2   17 };
  2         9  
27 2     2   10 our @EXPORT_OK = qw( decode_lzw encode_lzw );
28 2         12 our $EXCEPTION_CLASS = 'HTTP::Promise::Exception';
29 2         44 our $VERSION = 'v0.2.0';
30             };
31              
32 2     2   16 use strict;
  2         3  
  2         40  
33 2     2   12 use warnings;
  2         5  
  2         1334  
34              
35             sub decode
36             {
37 0     0 1   my $self = shift( @_ );
38 0           my $from = shift( @_ );
39 0           my $to = shift( @_ );
40 0           my $opts = $self->_get_args_as_hash( @_ );
41 0           my( $from_fh, $reader ) = $self->_get_glob_from_arg( $from );
42 0           my( $to_fh, $writer ) = $self->_get_glob_from_arg( $to, write => 1 );
43 0 0 0       return( $self->pass_error ) if( !defined( $from_fh ) || !defined( $to_fh ) );
44 0           my( $n, $buff );
45 0 0         $self->_load_class( 'Compress::LZW::Decompressor', { no_import => 1 } ) || return( $self->pass_error );
46 0           my $c = Compress::LZW::Decompressor->new;
47            
48 0           while( $n = $reader->( $buff, DECODE_BUFFER_SIZE ) )
49             {
50 0           my $decoded = $c->decompress( $buff );
51             # try-catch
52 0           local $@;
53             my $rv = eval
54 0           {
55 0           $writer->( $decoded );
56             };
57 0 0         if( $@ )
58             {
59 0           return( $self->error( "Error decompressing with LZW: $@" ) );
60             }
61 0 0         return( $self->pass_error ) if( !defined( $rv ) );
62             }
63 0 0         return( $self->pass_error ) if( !defined( $n ) );
64 0           return( $self );
65             }
66              
67             sub decode_lzw
68             {
69 0     0 1   my $s = __PACKAGE__->new;
70 0           my $rv = $s->decode( @_ );
71 0 0         if( !defined( $rv ) )
72             {
73 0           $LZWError = $s->error;
74 0           return;
75             }
76             else
77             {
78 0           undef( $LZWError );
79 0           return( $rv );
80             }
81             }
82              
83             sub encode
84             {
85 0     0 1   my $self = shift( @_ );
86 0           my $from = shift( @_ );
87 0           my $to = shift( @_ );
88 0           my $opts = $self->_get_args_as_hash( @_ );
89 0           my( $from_fh, $reader ) = $self->_get_glob_from_arg( $from );
90 0           my( $to_fh, $writer ) = $self->_get_glob_from_arg( $to, write => 1 );
91 0 0 0       return( $self->pass_error ) if( !defined( $from_fh ) || !defined( $to_fh ) );
92 0           my( $n, $buff );
93 0 0         $self->_load_class( 'Compress::LZW::Compressor', { no_import => 1 } ) || return( $self->pass_error );
94 0           my $c = Compress::LZW::Compressor->new;
95            
96 0           while( $n = $reader->( $buff, ENCODE_BUFFER_SIZE ) )
97             {
98 0           my $encoded = $c->compress( $buff );
99             # try-catch
100 0           local $@;
101             my $rv = eval
102 0           {
103 0           $writer->( $encoded );
104             };
105 0 0         if( $@ )
106             {
107 0           return( $self->error( "Error compressing with LZW: $@" ) );
108             }
109 0 0         return( $self->pass_error ) if( !defined( $rv ) );
110             }
111              
112 0 0         return( $self->pass_error ) if( !defined( $n ) );
113 0           return( $self );
114             }
115              
116             sub encode_lzw
117             {
118 0     0 1   my $s = __PACKAGE__->new;
119 0           my $rv = $s->encode( @_ );
120 0 0         if( !defined( $rv ) )
121             {
122 0           $LZWError = $s->error;
123 0           return;
124             }
125             else
126             {
127 0           undef( $LZWError );
128 0           return( $rv );
129             }
130             }
131              
132             sub is_decoder_installed
133             {
134 0     0 1   eval( 'use Compress::LZW::Decompressor ();' );
135 0 0         return( $@ ? 0 : 1 );
136             }
137              
138             sub is_encoder_installed
139             {
140 0     0 1   eval( 'use Compress::LZW::Compressor ();' );
141 0 0         return( $@ ? 0 : 1 );
142             }
143              
144             # NOTE: sub FREEZE is inherited
145              
146             # NOTE: sub STORABLE_freeze is inherited
147              
148             # NOTE: sub STORABLE_thaw is inherited
149              
150             # NOTE: sub THAW is inherited
151              
152             1;
153             # NOTE: POD
154             __END__
155              
156             =encoding utf-8
157              
158             =head1 NAME
159              
160             HTTP::Promise::Stream::LZW - Stream Encoder for LZW Compression
161              
162             =head1 SYNOPSIS
163              
164             use HTTP::Promise::Stream::LZW;
165             my $s = HTTP::Promise::Stream::LZW->new ||
166             die( HTTP::Promise::Stream::LZW->error, "\n" );
167             $s->encode( $input => $output ) ||
168             die( $s->error );
169             $s->decode( $input => $output ) || die( $s->error );
170             HTTP::Promise::Stream::LZW::encode_lzw( $input => $output ) ||
171             die( $HTTP::Promise::Stream::LZW::LZWError );
172             HTTP::Promise::Stream::LZW::decode_lzw( $input => $output ) ||
173             die( $HTTP::Promise::Stream::LZW::LZWError );
174              
175             =head1 VERSION
176              
177             v0.2.0
178              
179             =head1 DESCRIPTION
180              
181             This implements an encoding and decoding mechanism for LZW compression using either of the following on input and output:
182              
183             =over 4
184              
185             =item C<filepath>
186              
187             If the parameter is neither a scalar reference nor a file handle, it will be assumed to be a file path.
188              
189             =item C<file handle>
190              
191             This can be a native file handle, or an object oriented one as long as it implements the C<print> or C<write>, and C<read> methods. The C<read> method is expected to return the number of bytes read or C<undef> upon error. The C<print> and C<write> methods are expected to simply return true upon success and C<undef> upon error.
192              
193             Alternatively, those methods can die and those exceptions wil be caught.
194              
195             =item C<scalar reference>
196              
197             This can be a simple scalar reference, or an object scalar reference.
198              
199             =back
200              
201             This module requires L<Compress::LZW> to be installed or it will return an error.
202              
203             =head1 CONSTRUCTOR
204              
205             =head2 new
206              
207             Creates a new L<HTTP::Promise::Stream::LZW> object and returns it.
208              
209             =head1 METHODS
210              
211             =head2 decode
212              
213             This takes 2 arguments: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
214              
215             It will decode the LZW encoded data and write the result into the output.
216              
217             It returns true upon success and sets an L<error|Module::Generic/error> and return C<undef> upon error.
218              
219             =head2 encode
220              
221             This takes 2 arguments: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
222              
223             It will encode the data into LZW encoded data and write the result into the output.
224              
225             It returns true upon success and sets an L<error|Module::Generic/error> and return C<undef> upon error.
226              
227             =head1 CLASS FUNCTIONS
228              
229             The following class functions are available and can also be exported, such as:
230              
231             use HTTP::Promise::Stream::Brotli qw( decode_lzw encode_lzw );
232              
233             =head2 decode_lzw
234              
235             This takes the same 2 arguments used in L</decode>: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
236              
237             It will decode the LZW encoded data and write the result into the output.
238              
239             It returns true upon success, and upon error, it will set the error in the global variable C<$UUError> and return C<undef>
240              
241             my $decoded = HTTP::Promise::Stream::LZW::decode_lzw( $encoded );
242             die( "Something went wrong: $HTTP::Promise::Stream::LZW::LZWError\n" if( !defined( $decoded ) );
243             print( "Decoded data is: $decoded\n" );
244              
245             =head2 encode_lzw
246              
247             This takes the same 2 arguments used in L</encode>: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
248              
249             It will encode the data into LZW encoded data and write the result into the output.
250              
251             It returns true upon success, and upon error, it will set the error in the global variable C<$LZWError> and return C<undef>
252              
253             my $encoded = HTTP::Promise::Stream::LZW::encode_lzw( $data );
254             die( "Something went wrong: $HTTP::Promise::Stream::LZW::LZWError\n" if( !defined( $encoded ) );
255             print( "Encoded data is: $encoded\n" );
256              
257             =head2 is_decoder_installed
258              
259             Returns true if the module L<Compress::LZW::Decompressor> is installed, false otherwise.
260              
261             =head2 is_encoder_installed
262              
263             Returns true if the module L<Compress::LZW::Compressor> is installed, false otherwise.
264              
265             =head1 AUTHOR
266              
267             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
268              
269             =head1 SEE ALSO
270              
271             L<Compress::LZW>
272              
273             L<Discussion on Stackoverflow|http://web.archive.org/web/20170310213520/https://stackoverflow.com/questions/3855204/looking-for-library-which-implements-lzw-compression-decompression>, L<Wikipedia page|https://fr.wikipedia.org/wiki/Lempel-Ziv-Welch>
274              
275             L<HTTP::Promise>, L<HTTP::Promise::Request>, L<HTTP::Promise::Response>, L<HTTP::Promise::Message>, L<HTTP::Promise::Entity>, L<HTTP::Promise::Headers>, L<HTTP::Promise::Body>, L<HTTP::Promise::Body::Form>, L<HTTP::Promise::Body::Form::Data>, L<HTTP::Promise::Body::Form::Field>, L<HTTP::Promise::Status>, L<HTTP::Promise::MIME>, L<HTTP::Promise::Parser>, L<HTTP::Promise::IO>, L<HTTP::Promise::Stream>, L<HTTP::Promise::Exception>
276              
277             =head1 COPYRIGHT & LICENSE
278              
279             Copyright(c) 2022 DEGUEST Pte. Ltd.
280              
281             All rights reserved.
282              
283             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
284              
285             =cut