File Coverage

lib/HTTP/Promise/Stream.pm
Criterion Covered Total %
statement 370 581 63.6
branch 170 408 41.6
condition 77 198 38.8
subroutine 48 52 92.3
pod 16 18 88.8
total 681 1257 54.1


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Stream.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/03/28
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;
15             BEGIN
16             {
17 14     14   818782 use strict;
  14         75  
  14         535  
18 14     14   98 use warnings;
  14         38  
  14         465  
19 14     14   80 use warnings::register;
  14         28  
  14         2592  
20 14     14   110 use parent qw( Module::Generic );
  14         27  
  14         204  
21 14     14   398738 use vars qw( $FILTER_MAP $CLASSES $ENCODING_SUFFIX $SUFFIX_ENCODING );
  14         41  
  14         1055  
22             # use Nice::Try;
23 14     14   105 use Scalar::Util;
  14         59  
  14         762  
24 14     14   105 use constant HAS_BROWSER_SUPPORT => 1;
  14         27  
  14         1230  
25 14     14   335 our $VERSION = 'v0.2.0';
26             };
27              
28 14     14   102 use strict;
  14         63  
  14         321  
29 14     14   80 use warnings;
  14         44  
  14         473  
30 14     14   87 no warnings 'uninitialized';
  14         67  
  14         665  
31              
32             {
33 14     14   80 no warnings 'once';
  14         52  
  14         140573  
34             $CLASSES =
35             {
36             base64 => [qw( HTTP::Promise::Stream::Base64 HTTP::Promise::Stream::Base64 )],
37             brotli => [qw( HTTP::Promise::Stream::Brotli HTTP::Promise::Stream::Brotli ), HAS_BROWSER_SUPPORT],
38             bzip2 => [qw( IO::Compress::Bzip2 IO::Uncompress::Bunzip2 ), HAS_BROWSER_SUPPORT],
39             deflate => [qw( IO::Compress::Deflate IO::Uncompress::Inflate ), HAS_BROWSER_SUPPORT],
40             gzip => [qw( IO::Compress::Gzip IO::Uncompress::Gunzip ), HAS_BROWSER_SUPPORT],
41             lzf => [qw( IO::Compress::Lzf IO::Uncompress::UnLzf )],
42             lzip => [qw( IO::Compress::Lzip IO::Uncompress::UnLzip )],
43             lzma => [qw( IO::Compress::Lzma IO::Uncompress::UnLzma )],
44             lzop => [qw( IO::Compress::Lzop IO::Uncompress::UnLzop )],
45             lzw => [qw( HTTP::Promise::Stream::LZW HTTP::Promise::Stream::LZW )],
46             qp => [qw( HTTP::Promise::Stream::QuotedPrint HTTP::Promise::Stream::QuotedPrint )],
47             rawdeflate => [qw( IO::Compress::RawDeflate IO::Uncompress::RawInflate ), HAS_BROWSER_SUPPORT],
48             uu => [qw( HTTP::Promise::Stream::UU HTTP::Promise::Stream::UU )],
49             xz => [qw( IO::Compress::Xz IO::Uncompress::UnXz )],
50             zip => [qw( IO::Compress::Zip IO::Uncompress::Unzip )],
51             zstd => [qw( IO::Compress::Zstd IO::Uncompress::UnZstd )],
52             };
53             $CLASSES->{inflate} = $CLASSES->{deflate};
54             $CLASSES->{rawinflate} = $CLASSES->{inflate};
55             $CLASSES->{compress} = $CLASSES->{lzw};
56             $CLASSES->{'quoted-printable'} = $CLASSES->{qp};
57             # Permit non-standard call with prefix x-
58             for( qw( bzip2 gzip zip ) )
59             {
60             $CLASSES->{'x-' . $_} = $CLASSES->{ $_ };
61             }
62            
63             $FILTER_MAP =
64             {
65             encode =>
66             {
67             base64 => sub
68             {
69             # try-catch
70             local $@;
71             my $rv = eval
72             {
73             require HTTP::Promise::Stream::Base64;
74             HTTP::Promise::Stream::Base64::encode_b64( $_[0] => $_[1], @_[2..$#_] );
75             };
76             if( $@ )
77             {
78             return( undef, $@ );
79             }
80             $rv or return( undef, $HTTP::Promise::Stream::Base64::Base64Error );
81             return( $rv );
82             },
83             brotli => sub
84             {
85             # try-catch
86             local $@;
87             my $rv = eval
88             {
89             require HTTP::Promise::Stream::Brotli;
90             HTTP::Promise::Stream::Brotli::encode_bro( $_[0] => $_[1], @_[2..$#_] );
91             };
92             if( $@ )
93             {
94             return( undef, $@ );
95             }
96             $rv or return( undef, $HTTP::Promise::Stream::Brotli::BrotliError );
97             return( $rv );
98             },
99             bzip2 => sub
100             {
101             # try-catch
102             local $@;
103             my $rv = eval
104             {
105             require IO::Compress::Bzip2;
106             IO::Compress::Bzip2::bzip2( $_[0] => $_[1], @_[2..$#_] );
107             };
108             if( $@ )
109             {
110             return( undef, $@ );
111             }
112             $rv or return( undef, $IO::Compress::Bzip2::Bzip2Error );
113             return( $rv );
114             },
115             deflate => sub
116             {
117             # try-catch
118             local $@;
119             my $rv = eval
120             {
121             require IO::Compress::Deflate;
122             IO::Compress::Deflate::deflate( $_[0] => $_[1], @_[2..$#_] );
123             };
124             if( $@ )
125             {
126             return( undef, $@ );
127             }
128             $rv or return( undef, $IO::Compress::Deflate::DeflateError );
129             return( $rv );
130             },
131             gzip => sub
132             {
133             # try-catch
134             local $@;
135             my $rv = eval
136             {
137             require IO::Compress::Gzip;
138             IO::Compress::Gzip::gzip( $_[0] => $_[1], @_[2..$#_] );
139             };
140             if( $@ )
141             {
142             return( undef, $@ );
143             }
144             $rv or return( undef, $IO::Compress::Gzip::GzipError );
145             return( $rv );
146             },
147             lzf => sub
148             {
149             # try-catch
150             local $@;
151             my $rv = eval
152             {
153             require IO::Compress::Lzf;
154             IO::Compress::Lzf::lzip( $_[0] => $_[1], @_[2..$#_] );
155             };
156             if( $@ )
157             {
158             return( undef, $@ );
159             }
160             $rv or return( undef, $IO::Compress::Lzf::LzfError );
161             return( $rv );
162             },
163             lzip => sub
164             {
165             # try-catch
166             local $@;
167             my $rv = eval
168             {
169             require IO::Compress::Lzip;
170             IO::Compress::Lzip::lzip( $_[0] => $_[1], @_[2..$#_] );
171             };
172             if( $@ )
173             {
174             return( undef, $@ );
175             }
176             $rv or return( undef, $IO::Compress::Lzip::LzipError );
177             return( $rv );
178             },
179             lzma => sub
180             {
181             # try-catch
182             local $@;
183             my $rv = eval
184             {
185             require IO::Compress::Lzma;
186             IO::Compress::Lzma::lzma( $_[0] => $_[1], @_[2..$#_] );
187             };
188             if( $@ )
189             {
190             return( undef, $@ );
191             }
192             $rv or return( undef, $IO::Compress::Lzma::LzmaError );
193             return( $rv );
194             },
195             lzop => sub
196             {
197             # try-catch
198             local $@;
199             my $rv = eval
200             {
201             require IO::Compress::Lzop;
202             IO::Compress::Lzip::lzop( $_[0] => $_[1], @_[2..$#_] );
203             };
204             if( $@ )
205             {
206             return( undef, $@ );
207             }
208             $rv or return( undef, $IO::Compress::Lzop::LzopError );
209             return( $rv );
210             },
211             lzw => sub
212             {
213             # try-catch
214             local $@;
215             my $rv = eval
216             {
217             require HTTP::Promise::Streem::LZW;
218             HTTP::Promise::Streem::LZW::encode_lzw( $_[0] => $_[1], @_[2..$#_] );
219             };
220             if( $@ )
221             {
222             return( undef, $@ );
223             }
224             $rv or return( undef, $HTTP::Promise::Streem::LZW::LZWError );
225             return( $rv );
226             },
227             qp => sub
228             {
229             # try-catch
230             local $@;
231             my $rv = eval
232             {
233             require HTTP::Promise::Stream::QuotedPrint;
234             HTTP::Promise::Stream::QuotedPrint::encode_qp( $_[0] => $_[1], @_[2..$#_] );
235             };
236             if( $@ )
237             {
238             return( undef, $@ );
239             }
240             $rv or return( undef, $HTTP::Promise::Stream::QuotedPrint::QuotedPrintError );
241             return( $rv );
242             },
243             rawdeflate => sub
244             {
245             # try-catch
246             local $@;
247             my $rv = eval
248             {
249             require IO::Compress::RawDeflate;
250             IO::Compress::RawDeflate::rawdeflate( $_[0] => $_[1], @_[2..$#_] );
251             };
252             if( $@ )
253             {
254             return( undef, $@ );
255             }
256             $rv or return( undef, $IO::Compress::RawDeflate::RawDeflateError );
257             return( $rv );
258             },
259             uu => sub
260             {
261             # try-catch
262             local $@;
263             my $rv = eval
264             {
265             require HTTP::Promise::Stream::UU;
266             HTTP::Promise::Stream::UU::encode_uu( $_[0] => $_[1], @_[2..$#_] );
267             };
268             if( $@ )
269             {
270             return( undef, $@ );
271             }
272             $rv or return( undef, $HTTP::Promise::Stream::UU::UUError );
273             return( $rv );
274             },
275             xz => sub
276             {
277             # try-catch
278             local $@;
279             my $rv = eval
280             {
281             require IO::Compress::Xz;
282             IO::Compress::Xz::xz( $_[0] => $_[1], @_[2..$#_] );
283             };
284             if( $@ )
285             {
286             return( undef, $@ );
287             }
288             $rv or return( undef, $IO::Compress::Xz::XzError );
289             return( $rv );
290             },
291             zip => sub
292             {
293             # try-catch
294             local $@;
295             my $rv = eval
296             {
297             require IO::Compress::Zip;
298             IO::Compress::Zip::zip( $_[0] => $_[1], @_[2..$#_] );
299             };
300             if( $@ )
301             {
302             return( undef, $@ );
303             }
304             $rv or return( undef, $IO::Compress::Zip::ZipError );
305             return( $rv );
306             },
307             zstd => sub
308             {
309             # try-catch
310             local $@;
311             my $rv = eval
312             {
313             require IO::Compress::Zstd;
314             IO::Compress::Zstd::zstd( $_[0] => $_[1], @_[2..$#_] );
315             };
316             if( $@ )
317             {
318             return( undef, $@ );
319             }
320             $rv or return( undef, $IO::Compress::Zstd::ZstdError );
321             return( $rv );
322             },
323             },
324             decode =>
325             {
326             base64 => sub
327             {
328             # try-catch
329             local $@;
330             my $rv = eval
331             {
332             require HTTP::Promise::Stream::Base64;
333             HTTP::Promise::Stream::Base64::decode_b64( $_[0] => $_[1], @_[2..$#_] );
334             };
335             if( $@ )
336             {
337             return( undef, $@ );
338             }
339             $rv or return( undef, $HTTP::Promise::Stream::Base64::Base64Error );
340             return( $rv );
341             },
342             brotli => sub
343             {
344             # try-catch
345             local $@;
346             my $rv = eval
347             {
348             require HTTP::Promise::Stream::Brotli;
349             HTTP::Promise::Stream::Brotli::decode_bro( $_[0] => $_[1], @_[2..$#_] );
350             };
351             if( $@ )
352             {
353             return( undef, $@ );
354             }
355             $rv or return( undef, $HTTP::Promise::Stream::Brotli::BrotliError );
356             return( $rv );
357             },
358             bzip2 => sub
359             {
360             # try-catch
361             local $@;
362             my $rv = eval
363             {
364             require IO::Uncompress::Bunzip2;
365             IO::Uncompress::Bunzip2::bunzip2( $_[0] => $_[1], @_[2..$#_] );
366             };
367             if( $@ )
368             {
369             return( undef, $@ );
370             }
371             $rv or return( undef, $IO::Uncompress::Bunzip2::Bunzip2Error );
372             return( $rv );
373             },
374             gzip => sub
375             {
376             # try-catch
377             local $@;
378             my $rv = eval
379             {
380             require IO::Uncompress::Gunzip;
381             IO::Uncompress::Gunzip::gunzip( $_[0] => $_[1], @_[2..$#_] );
382             };
383             if( $@ )
384             {
385             return( undef, $@ );
386             }
387             $rv or return( undef, $IO::Uncompress::Gunzip::GunzipError );
388             return( $rv );
389             },
390             inflate => sub
391             {
392             # try-catch
393             local $@;
394             my $rv = eval
395             {
396             require IO::Uncompress::Inflate;
397             IO::Uncompress::Inflate::inflate( $_[0] => $_[1], @_[2..$#_] );
398             };
399             if( $@ )
400             {
401             return( undef, $@ );
402             }
403             $rv or return( undef, $IO::Uncompress::Inflate::InflateError );
404             return( $rv );
405             },
406             lzf => sub
407             {
408             # try-catch
409             local $@;
410             my $rv = eval
411             {
412             require IO::Uncompress::UnLzf;
413             IO::Uncompress::UnLzf::unlzf( $_[0] => $_[1], @_[2..$#_] );
414             };
415             if( $@ )
416             {
417             return( undef, $@ );
418             }
419             $rv or return( undef, $IO::Uncompress::UnLzf::UnLzfError );
420             return( $rv );
421             },
422             lzip => sub
423             {
424             # try-catch
425             local $@;
426             my $rv = eval
427             {
428             require IO::Uncompress::UnLzip;
429             IO::Uncompress::UnLzip::unlzip( $_[0] => $_[1], @_[2..$#_] );
430             };
431             if( $@ )
432             {
433             return( undef, $@ );
434             }
435             $rv or return( undef, $IO::Uncompress::UnLzip::UnLzipError );
436             return( $rv );
437             },
438             lzma => sub
439             {
440             # try-catch
441             local $@;
442             my $rv = eval
443             {
444             require IO::Uncompress::UnLzma;
445             IO::Uncompress::UnLzma::unlzma( $_[0] => $_[1], @_[2..$#_] );
446             };
447             if( $@ )
448             {
449             return( undef, $@ );
450             }
451             $rv or return( undef, $IO::Uncompress::UnLzma::UnLzmaError );
452             return( $rv );
453             },
454             lzop => sub
455             {
456             # try-catch
457             local $@;
458             my $rv = eval
459             {
460             require IO::Uncompress::UnLzop;
461             IO::Uncompress::UnLzop::unlzop( $_[0] => $_[1], @_[2..$#_] );
462             };
463             if( $@ )
464             {
465             return( undef, $@ );
466             }
467             $rv or return( undef, $IO::Uncompress::UnLzop::UnLzopError );
468             return( $rv );
469             },
470             lzw => sub
471             {
472             # try-catch
473             local $@;
474             my $rv = eval
475             {
476             require HTTP::Promise::Streem::LZW;
477             HTTP::Promise::Streem::LZW::decode_lzw( $_[0] => $_[1], @_[2..$#_] );
478             };
479             if( $@ )
480             {
481             return( undef, $@ );
482             }
483             $rv or return( undef, $HTTP::Promise::Streem::LZW::LZWError );
484             return( $rv );
485             },
486             qp => sub
487             {
488             # try-catch
489             local $@;
490             my $rv = eval
491             {
492             require HTTP::Promise::Stream::QuotedPrint;
493             HTTP::Promise::Stream::QuotedPrint::decode_qp( $_[0] => $_[1], @_[2..$#_] );
494             };
495             if( $@ )
496             {
497             return( undef, $@ );
498             }
499             $rv or return( undef, $HTTP::Promise::Stream::QuotedPrint::QuotedPrintError );
500             return( $rv );
501             },
502             rawinflate => sub
503             {
504             # try-catch
505             local $@;
506             my $rv = eval
507             {
508             require IO::Uncompress::RawInflate;
509             IO::Uncompress::RawInflate::rawinflate( $_[0] => $_[1], @_[2..$#_] );
510             };
511             if( $@ )
512             {
513             return( undef, $@ );
514             }
515             $rv or return( undef, $IO::Uncompress::RawInflate::RawInflateError );
516             return( $rv );
517             },
518             uu => sub
519             {
520             # try-catch
521             local $@;
522             my $rv = eval
523             {
524             require HTTP::Promise::Stream::UU;
525             HTTP::Promise::Stream::UU::decode_uu( $_[0] => $_[1], @_[2..$#_] );
526             };
527             if( $@ )
528             {
529             return( undef, $@ );
530             }
531             $rv or return( undef, $HTTP::Promise::Stream::UU::UUError );
532             return( $rv );
533             },
534             xz => sub
535             {
536             # try-catch
537             local $@;
538             my $rv = eval
539             {
540             require IO::Uncompress::UnXz;
541             IO::Uncompress::UnXz::unxz( $_[0] => $_[1], @_[2..$#_] );
542             };
543             if( $@ )
544             {
545             return( undef, $@ );
546             }
547             $rv or return( undef, $IO::Uncompress::UnXz::UnXzError );
548             return( $rv );
549             },
550             zip => sub
551             {
552             # try-catch
553             local $@;
554             my $rv = eval
555             {
556             require IO::Uncompress::Unzip;
557             IO::Uncompress::Unzip::unzip( $_[0] => $_[1], @_[2..$#_] );
558             };
559             if( $@ )
560             {
561             return( undef, $@ );
562             }
563             $rv or return( undef, $IO::Uncompress::Unzip::UnzipError );
564             return( $rv );
565             },
566             zstd => sub
567             {
568             # try-catch
569             local $@;
570             my $rv = eval
571             {
572             require IO::Uncompress::UnZstd;
573             IO::Uncompress::UnZstd::unzstd( $_[0] => $_[1], @_[2..$#_] );
574             };
575             if( $@ )
576             {
577             return( undef, $@ );
578             }
579             $rv or return( undef, $IO::Uncompress::UnZstd::UnZstdError );
580             return( $rv );
581             },
582             }
583             };
584             # rfc1945, section 3.5
585             # Ref: <https://tools.ietf.org/html/rfc1945#section-3.5>
586             $FILTER_MAP->{encode}->{ 'x-gzip' } = $FILTER_MAP->{encode}->{gzip};
587             $FILTER_MAP->{decode}->{ 'x-gzip' } = $FILTER_MAP->{decode}->{gzip};
588             $FILTER_MAP->{encode}->{ 'x-bzip2' } = $FILTER_MAP->{encode}->{bzip2};
589             $FILTER_MAP->{decode}->{ 'x-bzip2' } = $FILTER_MAP->{decode}->{bzip2};
590             # deflate <-> inflate, make the choice of word irrelevant
591             $FILTER_MAP->{decode}->{deflate} = $FILTER_MAP->{decode}->{inflate};
592             $FILTER_MAP->{encode}->{inflate} = $FILTER_MAP->{encode}->{deflate};
593             $FILTER_MAP->{decode}->{rawdeflate} = $FILTER_MAP->{decode}->{rawinflate};
594             $FILTER_MAP->{encode}->{rawinflate} = $FILTER_MAP->{encode}->{rawdeflate};
595             $FILTER_MAP->{encode}->{ 'x-zip' } = $FILTER_MAP->{encode}->{zip};
596             $FILTER_MAP->{decode}->{ 'x-zip' } = $FILTER_MAP->{decode}->{zip};
597             # x-compress was used for LZW compression (the algorithm used in GIF),
598             # but is not actually used. There is a module Compress::LZW, but what is the point?
599             $FILTER_MAP->{encode}->{ 'quoted-printable' } = $FILTER_MAP->{encode}->{qp};
600             $FILTER_MAP->{decode}->{ 'quoted-printable' } = $FILTER_MAP->{decode}->{qp};
601              
602             $ENCODING_SUFFIX =
603             {
604             base64 => 'b64',
605             brotli => 'br',
606             bzip2 => 'bz2',
607             # See rfc1950
608             # <https://fileinfo.com/extension/zz#pigz_zlib_compressed_file>
609             deflate => 'zz',
610             gzip => 'gz',
611             lzf => 'lzf',
612             # <https://fileinfo.com/extension/lz>
613             lzip => 'lz',
614             # <https://fileinfo.com/extension/lzma>
615             lzma => 'lzma',
616             lzop => 'lzop',
617             lzw => 'lzw',
618             qp => 'qp',
619             rawdeflate => 'rzz',
620             uu => 'uu',
621             xz => 'xz',
622             zip => 'zip',
623             zstd => 'zstd',
624             };
625             }
626              
627             sub init
628             {
629 122     122 1 3431915 my $self = shift( @_ );
630 122         385 my $src = shift( @_ );
631 122 0 33     780 return( $self->error( "No stream was provided." ) ) if( !defined( $src ) && !length( $src ) );
632 122 100       902 my $type = ref( $src ) ? lc( Scalar::Util::reftype( $src ) ) : '';
633 122 100       496 if( ref( $src ) )
634             {
635 121 100 66     692 if( $self->_is_a( $src => 'Module::Generic::File' ) )
    50 33        
636             {
637 47         2987 $src = "$src";
638             }
639             elsif( $type ne 'scalar' && $type ne 'glob' && $type ne 'code' )
640             {
641 0         0 return( $self->error( "You can only provide a scalar reference, array reference, code reference or a glob as a reference element for the filter." ) );
642             }
643             }
644             else
645             {
646 1 50       18 if( $src =~ /\n/ )
647             {
648 0         0 return( $self->error( "You cannot provide a text to set the filter. It can only be a scalar reference, array reference, a glob or a file path." ) );
649             }
650             }
651 122         4912 $self->{compress_params} = {};
652 122         652 $self->{encoding} = undef;
653 122         543 $self->{decoding} = undef;
654 122         384 $self->{_init_strict_use_sub} = 1;
655 122         445 $self->{_exception_class} = 'HTTP::Promise::Exception';
656 122 50       684 $self->SUPER::init( @_ ) || return( $self->pass_error );
657 122         121221 $self->source( $src );
658 122         99105 $self->{read_tmp_file} = undef;
659 122         530 $self->{src_file_handle} = undef;
660 122 100 66     2139 if( defined( $self->{encoding} ) && length( $self->{encoding} ) )
    100 66        
661             {
662 33 100       490 return( $self->error( "Encoding provided \"$self->{encoding}\" is unsupported." ) ) if( !exists( $FILTER_MAP->{encode}->{ $self->{encoding} } ) );
663             }
664             elsif( defined( $self->{decoding} ) && length( $self->{decoding} ) )
665             {
666 72 100       1115 return( $self->error( "Decoding provided \"$self->{decoding}\" is unsupported." ) ) if( !exists( $FILTER_MAP->{decode}->{ $self->{decoding} } ) );
667             }
668 118         1071 return( $self );
669             }
670              
671             sub as_string
672             {
673 0     0 1 0 my $self = shift( @_ );
674 0         0 my $src = $self->source;
675 0 0       0 if( ref( $src ) )
676             {
677 0         0 my $type = lc( Scalar::Util::reftype( $src ) );
678 0 0       0 if( $type eq 'scalar' )
    0          
    0          
679             {
680 0         0 return( length( ${$src} ) );
  0         0  
681             }
682             elsif( $type eq 'glob' )
683             {
684 0 0 0     0 if( $self->_is_a( $src => 'Module::Generic::Scalar::IO' ) )
    0 0        
    0          
685             {
686 0         0 return( join( '', $src->getlines ) );
687             }
688             elsif( $self->_is_object( $src ) && $self->_can( $src => 'seek' ) && $self->_can( $src => 'read' ) )
689             {
690 0         0 my $data = '';
691 0 0       0 $src->seek(0,0) || return( $self->error( "Unable to seek source stream glob: $!" ) );
692 0         0 while( $src->read( my $buff, 10240 ) )
693             {
694 0         0 $data .= $buff;
695             }
696 0         0 return( $data );
697             }
698             elsif( fileno( $src ) )
699             {
700 0         0 my $data = '';
701 0 0       0 CORE::seek( $src, 0, 0 ) || return( $self->error( "Unable to seek source stream glob: $!" ) );
702 0         0 while( CORE::read( $src, my $buff, 10240 ) )
703             {
704 0         0 $data .= $buff;
705             }
706 0         0 return( $data );
707             }
708             }
709             elsif( $self->_is_a( $src => 'Module::Generic::File' ) )
710             {
711 0         0 return( $src->content );
712             }
713 0         0 return;
714             }
715             else
716             {
717 0   0     0 my $f = $self->new_file( $src ) || return( $self->pass_error );
718 0         0 return( $f->content );
719             }
720             }
721              
722 125     125 1 975 sub compress_params { return( shift->_set_get_hash_as_mix_object( 'compress_params', @_ ) ); }
723              
724 2     2 1 18 sub decodable { return( shift->_decodable_encodable( 0, @_ ) ); }
725              
726             # Decoding $data and writing to stream:
727             # $stream->decode( $data );
728             # Decoding stream and returning decoded data:
729             # my $decoded = $stream->decode;
730             sub decode
731             {
732 13     13 1 6011 my( $self ) = @_;
733 13         26 my $opts = {};
734 13 100       54 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
735 13   100     49 $opts->{encoding} //= '';
736 13   50     88 $opts->{decoding} //= '';
737 13   66     80 my $dec = $opts->{decoding} || $opts->{encoding} || $self->decoding->lower;
738 13         635 my $src = $self->source;
739             # Scalar reference or glob
740 13 50       9458 my $this = @_ >= 2 ? $_[1] : $src;
741 13         47 my $size = $self->_get_size( $this );
742            
743             # No need to bother going further
744 13 50 33     120 if( !defined( $dec ) || !length( $dec ) || !$size )
      33        
745             {
746             # $stream->decode( $data );
747 0 0       0 return( $self ) if( @_ >= 2 );
748             # my $decoded = $stream->decode;
749 0         0 return( '' );
750             }
751 13         53 my $filters = $FILTER_MAP->{decode};
752 13 50       42 return( $self->error( "Unknown decoding \"$dec\"." ) ) if( !exists( $filters->{ $dec } ) );
753 13         63 my $params = $self->_io_compress_params( $opts );
754 13         20 my $rv;
755             # Decode some data provided and into the stream
756 13 50       35 if( @_ >= 2 )
757             {
758 0         0 ( $rv, my $err ) = $filters->{ $dec }->( $_[0] => $src, %$params );
759 0 0       0 return( $self->error( "Unable to decode $size bytes of data into the stream with $dec: $err" ) ) if( !defined( $rv ) );
760 0         0 return( $rv );
761             }
762             # Decode the stream and return the decoded data
763             else
764             {
765 13         17 my $buf;
766 13         62 ( $rv, my $err ) = $filters->{ $dec }->( $src => \$buf, %$params );
767 13 50       34 return( $self->error( "Unable to decode $size bytes of data from the stream with $dec: $err" ) ) if( !defined( $rv ) );
768 13 50       69 return( $buf ) if( defined( $rv ) );
769 0         0 return( $rv );
770             }
771             }
772              
773 173     173 1 13175 sub decoding { return( shift->_set_get_scalar_as_object( 'decoding', @_ ) ); }
774              
775 0     0 1 0 sub encodable { return( shift->_decodable_encodable( 1, @_ ) ); }
776              
777             # Encoding $data and writing to stream:
778             # $stream->encode( $data );
779             # Encoding stream and returning decoded data:
780             # my $encoded = $stream->encode;
781             sub encode
782             {
783 12     12 1 26968 my( $self ) = @_;
784 12         29 my $opts = {};
785 12 50       55 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
786 12   50     33 $opts->{encoding} //= '';
787 12   33     29 my $enc = $opts->{encoding} || $self->encoding->lower;
788 12         26 my $src = $self->source;
789             # Scalar reference or glob
790 12 50       9147 my $this = @_ >= 2 ? $_[1] : $src;
791 12         39 my $size = $self->_get_size( $this );
792            
793             # No need to bother going further
794 12 50 33     179 if( !defined( $enc ) || !length( $enc ) || !$size )
      33        
795             {
796             # $stream->encode( $data );
797 0 0       0 return( $self ) if( @_ >= 2 );
798             # my $encoded = $stream->encode;
799 0         0 return( '' );
800             }
801 12         31 my $filters = $FILTER_MAP->{encode};
802 12 50       33 return( $self->error( "Unknown encoding \"$enc\". Supported encodings are: ", join( ', ', sort( keys( %$filters ) ) ) ) ) if( !exists( $filters->{ $enc } ) );
803 12         31 my $params = $self->_io_compress_params( $opts );
804 12         17 my $rv;
805             # Encode some data provided and into the stream
806 12 50       28 if( @_ >= 2 )
807             {
808 0         0 ( $rv, my $err ) = $filters->{ $enc }->( $_[0] => $src, %$params );
809 0 0       0 return( $self->error( "Unable to encode $size bytes of data into the stream with $enc: $err" ) ) if( !defined( $rv ) );
810 0         0 return( $rv );
811             }
812             # Encode the stream and return the decoded data
813             else
814             {
815 12         16 my $buf;
816 12         20 my $ref = \$buf;
817 12         117 ( $rv, my $err ) = $filters->{ $enc }->( $src => \$buf, %$params );
818 12 50       29 return( $self->error( "Unable to encode $size bytes of data from the stream with $enc: $err" ) ) if( !defined( $rv ) );
819 12 50       67 return( $buf ) if( defined( $rv ) );
820 0         0 return( $rv );
821             }
822             }
823              
824 133     133 1 5509 sub encoding { return( shift->_set_get_scalar_as_object( 'encoding', @_ ) ); }
825              
826             sub encoding2suffix
827             {
828 16     16 1 6801 my $self = shift( @_ );
829 16         23 my $this = shift( @_ );
830 16 0 0     70 return( $self->error( "Bad argument provided. encoding2suffix() takes either an array of encodings or a string or something that stringifies." ) ) if( !defined( $this ) || ( !$self->_is_array( $this ) && ( ref( $this ) && !overload::Method( $this => '""' ) ) ) );
      33        
      33        
831 16 50       205 my $encodings = $self->new_array( $self->_is_array( $this ) ? $this : [split( /[[:blank:]\h]*,[[:blank:]\h]*/, lc( "${this}" ) )] );
832 16         428 my $ext = $self->new_array;
833 16         211 foreach( @$encodings )
834             {
835 17 100       53 return( $self->error( "Unknown encoding provided \"$_\"." ) ) if( !exists( $ENCODING_SUFFIX->{ $_ } ) );
836 16         35 $ext->push( $ENCODING_SUFFIX->{ $_ } );
837             }
838 15         98 return( $ext );
839             }
840              
841             sub load
842             {
843 1     1 1 14 my $self = shift( @_ );
844 1   50     15 my $enc = shift( @_ ) || return( $self->error( "No encoding was provided." ) );
845 1         7 $enc = lc( $enc );
846 1 50       27 return(0) if( !exists( $CLASSES->{ $enc } ) );
847 1         39 my $opts = $self->_get_args_as_hash( @_ );
848 1         17 my $p = {};
849 1 50 33     17 $p->{version} = $opts->{version} if( exists( $opts->{version} ) && length( $opts->{version} ) );
850 1         10 my( $encoder, $decoder ) = @{$CLASSES->{ $enc }};
  1         17  
851 1         6 my $ok = 0;
852 1         9 for( $encoder, $decoder )
853             {
854 2 50 66     45 $ok++, next if( $_ eq $decoder && $decoder eq $encoder );
855 2 50       35 $self->_load_class( $_, $p ) || next;
856 2         10724 $ok++;
857             }
858 1 50       28 return(1) if( $ok == 2 );
859 0         0 return(0);
860             }
861              
862             # $stream->read( $buffer, $len, $offset );
863             # $stream->read( $buffer, $len );
864             # $stream->read( $buffer );
865             # $stream->read( *buffer );
866             # $stream->read( sub{} );
867             # $stream->read( \$buffer );
868             # $stream->read( '/some/where/file.txt' );
869             sub read
870             {
871 80     80 1 1020304 my( $self ) = @_;
872 80         261 my $opts = {};
873 80 100       586 $opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' );
874 80 50 33     872 $opts->{binmode} = 'raw' if( !exists( $opts->{binmode} ) || !length( $opts->{binmode} ) );
875 80         365 my $src = $self->source;
876 80   66     59870 my $enc = $self->encoding->lower || lc( $opts->{encoding} );
877 80   66     50305 my $dec = $self->decoding->lower || lc( $opts->{decoding} );
878 80         46929 my $io = $self->{src_file_handle};
879 80         527 my $tempfile = $self->{read_tmp_file};
880 80 50       322 unless( $io )
881             {
882 80   50     488 $tempfile = $self->{read_tmp_file} = $self->new_tempfile ||
883             return( $self->error( "Unable to get a new tempfile: ", $self->error ) );
884 80 100       4099234 if( $enc )
    50          
885             {
886 12         490 my $params = $self->_io_compress_params( $opts );
887 12         112 my $filters = $FILTER_MAP->{encode};
888 12 50       100 return( $self->error( "Unknown encoding \"$enc\"." ) ) if( !exists( $filters->{ $enc } ) );
889 12         323 my( $rv, $err ) = $filters->{ $enc }->( $self->_normalise( $src ) => "$tempfile", %$params );
890 12         257 my $size = $self->_get_size( $src );
891 12 50       196 return( $self->error( "Unable to encode $size bytes of data into the stream with $enc: $err" ) ) if( !defined( $rv ) );
892 12   50     237 $io = $self->{src_file_handle} = $tempfile->open( '<', { binmode => $opts->{binmode} }) ||
893             return( $self->pass_error( $tempfile ) );
894             }
895             elsif( $dec )
896             {
897 68         2257 my $params = $self->_io_compress_params( $opts );
898 68         566 my $filters = $FILTER_MAP->{decode};
899 68 50       532 return( $self->error( "Unknown decoding \"$dec\"." ) ) if( !exists( $filters->{ $dec } ) );
900 68         1383 my( $rv, $err ) = $filters->{ $dec }->( $self->_normalise( $src ) => "$tempfile", %$params );
901 68         798 my $size = $self->_get_size( $src );
902 68 100       479 return( $self->error( "Unable to decode $size bytes of data into the stream with $dec and input '", $self->_normalise( $src ), "' and output '", $tempfile, "': $err" ) ) if( !defined( $rv ) );
903 67   50     1623 $io = $self->{src_file_handle} = $tempfile->open( '<', { binmode => $opts->{binmode} }) ||
904             return( $self->pass_error( $tempfile ) );
905             }
906             else
907             {
908 0         0 my $type = lc( Scalar::Util::reftype( $src ) );
909 0 0       0 if( $type eq 'scalar' )
    0          
    0          
910             {
911 0         0 my $s = $self->new_scalar( $src );
912 0   0     0 $io = $self->{src_file_handle} = $s->open( '<' ) ||
913             return( $self->pass_error( $s->error ) );
914             }
915             elsif( $type eq 'glob' )
916             {
917 0         0 $io = $self->{src_file_handle} = $src;
918             }
919             elsif( !ref( $src ) )
920             {
921 0         0 my $f = $self->new_file( $src );
922 0   0     0 $io = $self->{src_file_handle} = $f->open( '<', { $opts->{binmode} ? ( binmode => $opts->{binmode} ) : () }) ||
923             return( $self->pass_error( $f->error ) );
924             }
925             else
926             {
927 0         0 return( $self->error( "I do not know how to handle source '$src'." ) );
928             }
929             }
930             }
931            
932 79         375351 my $len;
933 79 100 33     1522 if( ref( $_[1] ) eq 'CODE' )
    100 33        
    100 66        
    100          
934             {
935 4         18 my $buf;
936             # Because there is no buffer provided and we send the data chunk to a callback, the
937             # offset option of the read() function is useless
938 4 50       44 if( @_ >= 3 )
    50          
939             {
940 0         0 $len = $io->read( $buf, $_[2] );
941 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes from source: $!" ) ) if( !defined( $len ) );
942             }
943             elsif( @_ >= 2 )
944             {
945 4         56 $len = $io->read( $buf, $tempfile->length );
946 4 50       146414 return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) );
947             }
948            
949             # try-catch
950 4         509 local $@;
951             eval
952 4         18 {
953 4         27 $_[1]->( $buf );
954             };
955 4 50       4497 if( $@ )
956             {
957 0         0 return( $self->error( "Callback raised an exception when sending it the ", length( $buf ), " bytes of data read from source: $@" ) );
958             }
959             }
960             elsif( Scalar::Util::reftype( $_[1] ) eq 'SCALAR' )
961             {
962 61 50       728 if( @_ >= 4 )
    50          
    50          
963             {
964 0         0 $len = $io->read( ${$_[1]}, $_[2], $_[3] );
  0         0  
965 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes at offset ", $_[3], " from source: $!" ) ) if( !defined( $len ) );
966             }
967             elsif( @_ >= 3 )
968             {
969 0         0 $len = $io->read( ${$_[1]}, $_[2] );
  0         0  
970 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes from source: $!" ) ) if( !defined( $len ) );
971             }
972             elsif( @_ >= 2 )
973             {
974 61         176 $len = $io->read( ${$_[1]}, $tempfile->length );
  61         912  
975 61 50       2291119 return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) );
976             }
977             }
978             elsif( Scalar::Util::reftype( $_[1] ) eq 'GLOB' )
979             {
980 4         22 my $buf;
981             # Because there is no buffer provided and we send the data chunk to a glob, the
982             # offset option of the read() function is useless
983 4 50       68 if( @_ >= 3 )
    50          
984             {
985 0         0 $len = $io->read( $buf, $_[2] );
986 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes from source: $!" ) ) if( !defined( $len ) );
987 0         0 my $rv = CORE::print( $_[1], $buf );
988 0 0       0 return( $self->error( "Unable to print ", CORE::length( $buf ), " bytes of data to provided file handle '", $_[1], "': $!" ) ) if( !$rv );
989             }
990             elsif( @_ >= 2 )
991             {
992 4         14 my $chunklen;
993 4         35 while( $chunklen = $io->read( $buf, 10240 ) )
994             {
995 4         553 $len += $chunklen;
996             #my $rv = CORE::print( $_[1], $buf );
997 4         31 my $rv = $_[1]->print( $buf );
998 4 50       681 return( $self->error( "Unable to print ", CORE::length( $buf ), " bytes of data to provided file handle '", $_[1], "': $!" ) ) if( !$rv );
999             }
1000 4 50       376 return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $chunklen ) );
1001             }
1002             }
1003             # A file
1004             elsif( $self->_is_a( $_[1] => 'Module::Generic::File' ) ||
1005             ( !ref( $_[1] ) &&
1006             CORE::length( $_[1] ) &&
1007             CORE::index( $_[1], "\n" ) == -1
1008             ) )
1009             {
1010 6   50     547 my $f = $self->new_file( $_[1] ) || return( $self->pass_error );
1011 6         762068 my $buf;
1012             # Because there is no buffer provided and we send the data chunk to a file, the
1013             # offset option of the read() function is useless
1014 6 50       102 if( @_ >= 3 )
    50          
1015             {
1016 0         0 $len = $io->read( $buf, $_[2] );
1017 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes from source: $!" ) ) if( !defined( $len ) );
1018             }
1019             elsif( @_ >= 2 )
1020             {
1021 6         125 $len = $io->read( $buf, $tempfile->length );
1022 6 50       219095 return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) );
1023             }
1024 6 50       883 my $mode = $opts->{mode} ? $opts->{mode} : '>';
1025 6         43 my $params = {};
1026 6 50       108 $params->{binmode} = $opts->{binmode} if( $opts->{binmode} );
1027 6 50       59 $params->{autoflush} = $opts->{autoflush} if( $opts->{autoflush} );
1028 6 50       84 $f->open( $mode, $params ) ||
1029             return( $self->pass_error( $f->error ) );
1030 6 50       258180 $f->print( $buf ) || return( $self->pass_error( $f->error ) );
1031 6         7258 $f->close;
1032             }
1033             # A regular string
1034             else
1035             {
1036 4 50       213 if( @_ >= 4 )
    50          
    50          
1037             {
1038 0         0 $len = $io->read( $_[1], $_[2], $_[3] );
1039 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes at offset ", $_[3], " from source: $!" ) ) if( !defined( $len ) );
1040             }
1041             elsif( @_ >= 3 )
1042             {
1043 0         0 $len = $io->read( $_[1], $_[2] );
1044 0 0       0 return( $self->error( "Unable to read ", $_[2], " bytes from source: $!" ) ) if( !defined( $len ) );
1045             }
1046             elsif( @_ >= 2 )
1047             {
1048 4         64 $len = $io->read( $_[1], $tempfile->length );
1049 4 50       146845 return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) );
1050             }
1051             }
1052 79         40615 return( $len );
1053             }
1054              
1055 247     247 1 1181 sub source { return( shift->_set_get_scalar( 'source', @_ ) ); }
1056              
1057             sub suffix2encoding
1058             {
1059 16     16 1 7055 my $self = shift( @_ );
1060 16   50     34 my $file = shift( @_ ) || return( $self->pass_error( "No file was provided to guess encoding." ) );
1061 16         44 my @parts = reverse( split( /\./, $file ) );
1062 16 100 66     65 unless( defined( $SUFFIX_ENCODING ) && %$SUFFIX_ENCODING )
1063             {
1064 1         7 my @keys = keys( %$ENCODING_SUFFIX );
1065 1         7 my @vals = @$ENCODING_SUFFIX{ @keys };
1066 1         2 $SUFFIX_ENCODING = {};
1067 1         12 @$SUFFIX_ENCODING{ @vals } = @keys;
1068             }
1069 16         48 my $encs = $self->new_array;
1070 16         11782 foreach( @parts )
1071             {
1072 32 100       163 if( exists( $SUFFIX_ENCODING->{ $_ } ) )
1073             {
1074 16         40 $encs->push( $SUFFIX_ENCODING->{ $_ } );
1075             }
1076             else
1077             {
1078 16         22 last;
1079             }
1080             }
1081 16         32 return( $encs->reverse );
1082             }
1083              
1084             sub supported
1085             {
1086 2     2 1 14 my $self = shift( @_ );
1087 2 50 33     56 return( $self->error( "No encoding was provided to check if it exists." ) ) if( !@_ || !defined( $_[0] ) || !length( $_[0] ) );
      33        
1088 2         15 my $this = lc( shift( @_ ) );
1089 2 50 33     66 return(1) if( exists( $FILTER_MAP->{encode}->{ $this } ) || exists( $FILTER_MAP->{decode}->{ $this } ) );
1090 0         0 return(0);
1091             }
1092              
1093             # $stream->write( $data );
1094             # $stream->write( \$data );
1095             # $stream->write( *$data );
1096             # $stream->write( '/some/where/file.txt' );
1097             # $stream->write( sub{} );
1098             sub write
1099             {
1100 20     20 1 26810 my( $self ) = @_;
1101             # No data was provided
1102 20 50 33     341 return(0) if( !defined( $_[1] ) || !length( $_[1] ) );
1103 20         183 my $src = $self->source;
1104 20         14677 my $enc = $self->encoding->lower;
1105 20         12081 my $dec = $self->decoding->lower;
1106 20         11248 my $type = lc( Scalar::Util::reftype( $_[1] ) );
1107 20         135 my $data;
1108             my $size;
1109 20         0 my $len;
1110 20 100       87 if( $type eq 'code' )
1111             {
1112             # try-catch
1113 4         30 local $@;
1114             my $buf = eval
1115 4         18 {
1116 4         22 $_[1]->()
1117             };
1118 4 50       55 if( $@ )
1119             {
1120 0         0 return( $self->error( "Error getting data from callback: $@" ) );
1121             }
1122 4         17 $data = \$buf;
1123 4         35 $size = length( $$data );
1124             }
1125             else
1126             {
1127 16         148 $size = $self->_get_size( $_[1] );
1128             # If the data provided is not a reference i.e. a string and it does not have any
1129             # CRLF sequence and it is not a file that exists, OR it has multiple CRLF
1130             # sequences, then we treat it as a string, and to remove ambiguity, we make it a
1131             # scalar reference
1132 16 100 33     145812 if( !ref( $_[1] ) &&
    100 66        
    100 66        
1133             (
1134             ( index( $_[1], "\n" ) == -1 && !-e( $_[1] ) ) ||
1135             ( index( $_[1], "\n" ) != -1 )
1136             ) )
1137             {
1138 4         16 $data = \$_[1];
1139             }
1140             elsif( $type eq 'scalar' )
1141             {
1142 4         27 $data = $_[1];
1143             }
1144             elsif( $self->_is_a( $_[1] => 'Module::Generic::File' ) ||
1145             $self->_can( $_[1] => 'filename' ) )
1146             {
1147 4         177 $data = $_[1]->filename;
1148             }
1149             # otherwise, it is either a scalar reference, a glob or a file, and if it is none
1150             # of those, we return an error
1151             else
1152             {
1153 4         408 $data = $_[1];
1154 4 50 33     69 return( $self->error( "Unsupported data type '", overload::StrVal( $data ), "'. You can only provide a string, a scalar reference, a code reference, a glob or a file path." ) ) if( ref( $data ) && $type ne 'scalar' && $type ne 'glob' && $type ne 'code' );
      33        
      33        
1155             }
1156            
1157             # If we are dealing with a file, open it and use its file glob instead,
1158             # because some encoder like IO::Compress::Zip actually creates and archive of the file with the file path included, rather than just the file content as advertised.
1159             # See Bug #38
1160             # <https://github.com/pmqs/IO-Compress/issues/38>
1161 16 100       132 if( !ref( $data ) )
1162             {
1163 4         24 my $f = $self->new_file( $data );
1164 4   50     503941 $data = $f->open( '<', { binmode => 'raw' } ) ||
1165             return( $self->pass_error( $f->error ) );
1166             }
1167             }
1168              
1169 20         34051 my $stype = lc( Scalar::Util::reftype( $src ) );
1170 20 50       94 if( $stype eq 'code' )
1171             {
1172 0 0       0 if( $enc )
    0          
1173             {
1174 0         0 my $params = $self->_io_compress_params;
1175             # try-catch
1176 0         0 local $@;
1177             eval
1178 0         0 {
1179 0         0 $src->( $self->encode( $data, $params ) );
1180             };
1181 0 0       0 if( $@ )
1182             {
1183 0         0 return( $self->error( "Error executing calback to write $size bytes of data: $@" ) );
1184             }
1185 0         0 $len = $size;
1186             }
1187             elsif( $dec )
1188             {
1189 0         0 my $params = $self->_io_compress_params;
1190             # try-catch
1191 0         0 local $@;
1192             eval
1193 0         0 {
1194 0         0 $src->( $self->decode( $data, $params ) );
1195             };
1196 0 0       0 if( $@ )
1197             {
1198 0         0 return( $self->error( "Error executing calback to write $size bytes of data: $@" ) );
1199             }
1200 0         0 $len = $size;
1201             }
1202             else
1203             {
1204 0 0       0 if( $type eq 'scalar' )
    0          
1205             {
1206 0         0 $len = length( $$data );
1207             # try-catch
1208 0         0 local $@;
1209             eval
1210 0         0 {
1211 0         0 $src->( $$data );
1212             };
1213 0 0       0 if( $@ )
1214             {
1215 0         0 return( $self->error( "Error executing calback to write $size bytes of data: $@" ) );
1216             }
1217             }
1218             elsif( $type eq 'glob' )
1219             {
1220 0         0 my( $rv, $buf );
1221 0         0 while( $rv = CORE::read( $data, $buf, 10240 ) )
1222             {
1223             # try-catch
1224 0         0 local $@;
1225             eval
1226 0         0 {
1227 0         0 $src->( $buf );
1228             };
1229 0 0       0 if( $@ )
1230             {
1231 0         0 return( $self->error( "Error executing calback to write $size bytes of data: $@" ) );
1232             }
1233 0         0 $len += length( $buf );
1234             }
1235 0 0       0 return( $self->error( "Unable to read data from glob provided: $!" ) ) if( !defined( $rv ) );
1236             }
1237             else
1238             {
1239 0   0     0 my $f = $self->new_file( $data ) || return( $self->pass_error );
1240 0   0     0 my $fh = $f->open( '<' ) || return( $self->pass_error( $f->error ) );
1241 0         0 my $buf;
1242 0         0 my $rv = $fh->read( $buf );
1243 0 0       0 return( $self->error( "Unable to read data from file \"$f\" provided: $!" ) ) if( !defined( $rv ) );
1244             # try-catch
1245 0         0 local $@;
1246             eval
1247 0         0 {
1248 0         0 $src->( $buf );
1249             };
1250 0 0       0 if( $@ )
1251             {
1252 0         0 return( $self->error( "Error executing calback to write $size bytes of data: $@" ) );
1253             }
1254 0         0 $fh->close;
1255 0         0 $len = length( $buf );
1256             }
1257             }
1258             }
1259             else
1260             {
1261 20         115 my $filters;
1262 20 50       127 if( $dec )
    50          
1263             {
1264 0         0 $filters = $FILTER_MAP->{decode};
1265             }
1266             elsif( $enc )
1267             {
1268 20         454 $filters = $FILTER_MAP->{encode};
1269             }
1270            
1271 20         85 my $rv;
1272 20 50       64 if( $dec )
    50          
    0          
    0          
1273             {
1274 0         0 my $params = $self->_io_compress_params;
1275 0 0       0 return( $self->error( "No encoding found for \"$dec\"." ) ) if( !exists( $filters->{ $dec } ) );
1276             # try-catch
1277 0         0 local $@;
1278             ( $rv, my $err ) = eval
1279 0         0 {
1280 0         0 $filters->{ $dec }->( $data => $src, %$params );
1281             };
1282 0 0       0 if( $@ )
1283             {
1284 0 0       0 return( $self->error( "Error ", ( $self->encode ? 'encoding' : 'decoding' ), " $size bytes of data: $@" ) );
1285             }
1286 0 0       0 return( $self->error( "Unable to decode data to write to source: $err" ) ) if( !defined( $rv ) );
1287 0         0 $len = $size;
1288             }
1289             elsif( $enc )
1290             {
1291 20         526 my $params = $self->_io_compress_params;
1292 20 50       111 return( $self->error( "No encoding found for \"$enc\"." ) ) if( !exists( $filters->{ $enc } ) );
1293             # try-catch
1294 20         169 local $@;
1295             ( $rv, my $err ) = eval
1296 20         43 {
1297 20         115 $filters->{ $enc }->( $data => $src, %$params );
1298             };
1299 20 50       78 if( $@ )
1300             {
1301 0 0       0 return( $self->error( "Error ", ( $self->encode ? 'encoding' : 'decoding' ), " $size bytes of data: $@" ) );
1302             }
1303 20 50       114 return( $self->error( "Unable to encode data to write to source: $err" ) ) if( !defined( $rv ) );
1304 20         65 $len = $size;
1305             }
1306             elsif( $stype eq 'scalar' )
1307             {
1308 0 0       0 if( $type eq 'scalar' )
    0          
1309             {
1310 0         0 $$src .= $$data;
1311 0         0 $len = length( $$data );
1312             }
1313             elsif( $type eq 'glob' )
1314             {
1315 0         0 my( $rv, $buf );
1316 0         0 while( $rv = CORE::read( $data, $buf, 10240 ) )
1317             {
1318 0         0 $$src .= $buf;
1319 0         0 $len += length( $buf );
1320             }
1321 0 0       0 return( $self->error( "Unable to read data from glob provided: $!" ) ) if( !defined( $rv ) );
1322             }
1323             else
1324             {
1325 0   0     0 my $f = $self->new_file( $data ) || return( $self->pass_error );
1326 0   0     0 my $fh = $f->open( '<' ) ||
1327             return( $self->pass_error( $f->error ) );
1328 0         0 my $buf;
1329 0         0 my $rv = $fh->read( $buf );
1330 0 0       0 return( $self->error( "Unable to read data from file \"$f\" provided: $!" ) ) if( !defined( $rv ) );
1331 0         0 $$src .= $buf;
1332 0         0 $len = length( $buf );
1333             }
1334             }
1335             elsif( $stype eq 'glob' )
1336             {
1337 0 0       0 if( $type eq 'scalar' )
    0          
1338             {
1339 0 0       0 print( $src, $$data ) ||
1340             return( $self->error( "Unable to write ", length( $$data ), " bytes of data to source glob: $!" ) );
1341 0         0 $len = length( $$data );
1342             }
1343             elsif( $type eq 'glob' )
1344             {
1345 0         0 my $buf;
1346 0         0 while( CORE::read( $data, $buf, 10240 ) )
1347             {
1348 0 0       0 print( $src, $buf ) ||
1349             return( $self->error( "Unable to write ", length( $buf ), " bytes of data to source glob: $!" ) );
1350 0         0 $len += length( $buf );
1351             }
1352             }
1353             else
1354             {
1355 0   0     0 my $f = $self->new_file( $data ) || return( $self->pass_error );
1356 0   0     0 my $fh = $f->open( '<' ) ||
1357             return( $self->pass_error( $f->error ) );
1358 0         0 my $buf;
1359 0         0 while( $fh->read( $buf, 10240 ) )
1360             {
1361 0 0       0 print( $src, $buf ) ||
1362             return( $self->error( "Unable to write ", length( $buf ), " bytes of data to source glob: $!" ) );
1363 0         0 $len += length( $buf );
1364             }
1365             }
1366             }
1367             else
1368             {
1369 0   0     0 my $f = $self->new_file( $src ) || return( $self->pass_error );
1370 0   0     0 my $fh = $f->open( '>', { autoflush => 1 } ) || return( $self->pass_error( $f->error ) );
1371 0 0       0 if( $type eq 'scalar' )
    0          
1372             {
1373 0 0       0 $fh->print( $$data ) ||
1374             return( $self->error( "Unable to write ", length( $$data ), " bytes of data to file \"$f\": $!" ) );
1375 0         0 $len = length( $$data );
1376             }
1377             elsif( $type eq 'glob' )
1378             {
1379 0         0 my $buf;
1380 0         0 while( CORE::read( $data, $buf, 10240 ) )
1381             {
1382 0 0       0 $fh->print( $buf ) ||
1383             return( $self->error( "Unable to write ", length( $buf ), " bytes of data to file \"$f\": $!" ) );
1384 0         0 $len += length( $buf );
1385             }
1386             }
1387             else
1388             {
1389 0   0     0 my $f2 = $self->new_file( $data ) || return( $self->pass_error );
1390 0   0     0 my $fh2 = $f2->open( '<' ) ||
1391             return( $self->pass_error( $f2->error ) );
1392 0         0 my $buf;
1393 0         0 while( $fh2->read( $buf, 10240 ) )
1394             {
1395 0 0       0 $fh->print( $buf ) ||
1396             return( $self->error( "Unable to write ", length( $buf ), " bytes of data to source file \"$f\": $!" ) );
1397 0         0 $len += length( $buf );
1398             }
1399 0         0 $fh2->close;
1400             }
1401 0         0 $fh->close;
1402             }
1403             }
1404 20         103 return( $len );
1405             }
1406              
1407             sub _decodable_encodable
1408             {
1409 2     2   8 my $self = shift( @_ );
1410             # 1 for encodable, 0 for decodable
1411 2         4 my $enc_or_dec = shift( @_ );
1412 2   50     12 my $what = shift( @_ ) || 'all';
1413 2         27 my $list = $self->new_array;
1414 2 50       65 my $offset = $enc_or_dec ? 0 : 1;
1415 2 50 33     17 if( $self->_is_array( $what ) )
    50          
    50          
1416             {
1417 0         0 $list = $what;
1418             }
1419             elsif( $what eq 'all' || $what eq 'auto' )
1420             {
1421 0         0 $list = [sort( keys( %$CLASSES ) )];
1422             }
1423             elsif( $what eq 'browser' )
1424             {
1425 2         102 foreach( keys( %$CLASSES ) )
1426             {
1427 46 100       234 $list->push( $_ ) if( $CLASSES->{ $_ }->[2] );
1428             }
1429             }
1430             else
1431             {
1432 0         0 return( $self->error( "Unsupported keyword '$what' used." ) );
1433             }
1434            
1435 2         14 my $res = $self->new_array;
1436 2         52 foreach my $enc ( @$list )
1437             {
1438             # inflate is just an alias for deflate
1439 18 100 100     137 next if( $enc eq 'inflate' || $enc eq 'rawinflate' || substr( $enc, 0, 2 ) eq 'x-' );
      100        
1440 10 50       33 if( !exists( $CLASSES->{ $enc } ) )
1441             {
1442 0 0       0 warn( "Unsupported content encoding \"$enc\"." ) if( $self->_is_warnings_enabled( 'HTTP::Promise' ) );
1443 0         0 next;
1444             }
1445 10         41 my $encoder_class = $CLASSES->{ $enc }->[$offset];
1446 10 50       27 my $is_installed_method = ( $enc_or_dec ? 'is_encoder_installed' : 'is_decoder_installed' );
1447 10 50       262 if( my $coderef = $encoder_class->can( $is_installed_method ) )
    50          
1448             {
1449 0 0       0 $res->push( $enc ) if( $coderef->() );
1450             }
1451             elsif( $self->_is_class_loadable( $encoder_class ) )
1452             {
1453 10         1211 $res->push( $enc );
1454             }
1455             }
1456 2         24 return( $res );
1457             }
1458              
1459             sub _get_size
1460             {
1461 121     121   548 my $self = shift( @_ );
1462 121 100 66     1901 if( ref( $_[0] ) )
    100 33        
1463             {
1464 87         686 my $type = lc( Scalar::Util::reftype( $_[0] ) );
1465 87 100       537 if( $type eq 'scalar' )
    100          
    50          
1466             {
1467 71         180 return( length( ${$_[0]} ) );
  71         305  
1468             }
1469             elsif( $type eq 'glob' )
1470             {
1471 12 100 33     49 if( $self->_is_a( $_[0] => 'Module::Generic::Scalar::IO' ) )
    50          
    50          
1472             {
1473 8         346 return( $_[0]->size );
1474             }
1475             elsif( $self->_is_object( $_[0] ) && $self->_can( $_[0] => 'size' ) )
1476             {
1477 0         0 return( $_[0]->size );
1478             }
1479             elsif( fileno( $_[0] ) )
1480             {
1481 4         412 return( -s( $_[0] ) );
1482             }
1483             }
1484             elsif( $self->_is_a( $_[0] => 'Module::Generic::File' ) )
1485             {
1486 4         244 return( $_[0]->size );
1487             }
1488 0         0 return;
1489             }
1490             # If the data provided is not a reference i.e. a string and it does not have any
1491             # CRLF sequence and it is not a file that exists, OR it has multiple CRLF
1492             # sequences, then we treat it as a string, and to remove ambiguity, we make it a
1493             # scalar reference
1494             elsif( !ref( $_[0] ) &&
1495             (
1496             ( index( $_[0], "\n" ) == -1 && !-e( $_[0] ) ) ||
1497             ( index( $_[0], "\n" ) != -1 )
1498             ) )
1499             {
1500 4         24 return( length( $_[0] ) );
1501             }
1502             else
1503             {
1504 30         363 return( -s( $_[0] ) );
1505             }
1506             }
1507              
1508             sub _io_compress_params
1509             {
1510 125     125   854 my $self = shift( @_ );
1511 125         382 my $opts = {};
1512 125         1261 my $ref = $self->compress_params;
1513 125 100       328769 if( @_ )
1514             {
1515 105         357 $opts = shift( @_ );
1516 105         1839 my @keys = grep( /^[A-Z]\w+$/, keys( %$opts ) );
1517 105 100       1036 @$ref{ @keys } = @$opts{ @keys } if( scalar( @keys ) );
1518             }
1519 125         810 return( $ref );
1520             }
1521              
1522             # Because the IO::Compress and IO::Uncompress family does not recognise a scalar object
1523             # as a valid scalar reference, we have to normalise it, before we can pass it to the filters
1524             # Remove this once IO::Compress has accepted my pull request to change
1525             # IO::Compress::Base::Common->whatIs made on 2022-04-11
1526             # <https://github.com/pmqs/IO-Compress/pull/40>
1527             sub _normalise
1528             {
1529 81     81   437 my $self = shift( @_ );
1530 81 100       660 if( ref( $_[0] ) )
1531             {
1532 59         573 my $type = lc( Scalar::Util::reftype( $_[0] ) );
1533 59 50 0     401 if( $type eq 'scalar' )
    0          
    0          
1534             {
1535             # if it is a regular scalar reference, we return it
1536             # return( $self->_is_object( $_[0] ) ? \${$_[0]} : $_[0] );
1537 59 100       348 if( $self->_is_object( $_[0] ) )
1538             {
1539 39         555 my $tmp = ${$_[0]};
  39         200  
1540 39         694 return( \$tmp );
1541             }
1542             else
1543             {
1544 20         332 return( $_[0] );
1545             }
1546             }
1547             elsif( $type eq 'glob' )
1548             {
1549 0         0 return( $_[0] );
1550             }
1551             elsif( $self->_is_a( $_[0] => 'Module::Generic::File' ) || $self->_can( $_[0] => 'filename' ) )
1552             {
1553 0         0 return( $_[0]->filename );
1554             }
1555             else
1556             {
1557 0         0 return( $_[0] );
1558             }
1559             }
1560             else
1561             {
1562 22         179 return( $_[0] );
1563             }
1564             }
1565              
1566             # NOTE: sub FREEZE is inherited
1567              
1568 1     1 0 87 sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
1569              
1570 1     1 0 166 sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
1571              
1572             # NOTE: sub THAW is inherited
1573              
1574             # NOTE: HTTP::Promise::Stream::Generic class
1575             {
1576             package
1577             HTTP::Promise::Stream::Generic;
1578             BEGIN
1579             {
1580 14     14   151 use strict;
  14         44  
  14         500  
1581 14     14   88 use warnings;
  14         40  
  14         557  
1582 14     14   102 use parent qw( Module::Generic );
  14         40  
  14         114  
1583 14     14   1336 use vars qw( $VERSION $EXCEPTION_CLASS );
  14         76  
  14         884  
1584 14     14   2169 use Module::Generic::File::IO;
  14         15570  
  14         271  
1585 14     14   9818 use Module::Generic::Scalar::IO;
  14         38823  
  14         272  
1586             # use Nice::Try;
1587 14     14   1090 our $EXCEPTION_CLASS = 'HTTP::Promise::Exception';
1588 14         552 our $VERSION = $HTTP::Promise::Stream::VERSION;
1589             };
1590              
1591 14     14   112 use strict;
  14         50  
  14         300  
1592 14     14   72 use warnings;
  14         80  
  14         931  
1593              
1594             sub init
1595             {
1596 30     30   2444969 my $self = shift( @_ );
1597 30   33     253 my $class = ( ref( $self ) || $self );
1598 30         1121 $self->{_init_strict_use_sub} = 1;
1599 14     14   128 no strict 'refs';
  14         32  
  14         16524  
1600 30 50       84 $self->{_exception_class} = defined( ${"${class}\::EXCEPTION_CLASS"} ) ? ${"${class}\::EXCEPTION_CLASS"} : $EXCEPTION_CLASS;
  30         379  
  30         390  
1601 30 50       368 $self->SUPER::init( @_ ) || return( $self->pass_error );
1602 30         2599 return( $self );
1603             }
1604              
1605             sub _get_glob_from_arg
1606             {
1607 58     58   197 my $self = shift( @_ );
1608 58         133 my $this = shift( @_ );
1609 58 50 66     847 return( $self->error( "No argument was provided." ) ) if( !defined( $this ) || ( !ref( $this ) && !length( $this ) ) );
      66        
1610 58         264 my $opts = $self->_get_args_as_hash( @_ );
1611 58 100       5196 $opts->{write} = 0 if( !exists( $opts->{write} ) );
1612 58 100       426 my $mode = $opts->{write} ? '+>' : '<';
1613 58         146 my $fh;
1614 58         113 my $is_native_glob = 0;
1615 58 100       453 if( $self->_is_glob( $this ) )
    100          
1616             {
1617 3         52 $fh = $this;
1618             # even if this is a scalar reference opened in memory, perl will return -1, which is true
1619 3 50       27 $is_native_glob++ if( fileno( $this ) );
1620             }
1621             elsif( $self->_is_scalar( $this ) )
1622             {
1623 29   50     1883 $fh = Module::Generic::Scalar::IO->new( $this, $mode ) ||
1624             return( $self->pass_error( Module::Generic::Scalar::IO->error ) );
1625 29         25682 $is_native_glob++;
1626             }
1627             else
1628             {
1629 26   50     1075 my $f = $self->new_file( "$this" ) || return( $self->pass_error );
1630 26 50 66     3404855 return( $self->error( "File '$this' does not exist." ) ) if( !$f->exists && !$opts->{write} );
1631 26   50     3109 $fh = $f->open( $mode, { binmode => 'raw', ( $opts->{write} ? ( autoflush => 1 ) : () ) } ) ||
1632             return( $self->pass_error( $f->error ) );
1633 26         996311 $is_native_glob++;
1634             }
1635 58         89502 my $flags;
1636 58 50       877 if( $self->_can( $fh => 'fcntl' ) )
1637             {
1638 58         3128 $flags = $fh->fcntl( F_GETFL, 0 );
1639             }
1640             else
1641             {
1642 0         0 $flags = fcntl( $fh, F_GETFL, 0 );
1643             }
1644            
1645 58 50       2458 if( defined( $flags ) )
1646             {
1647 58 100       462 if( $opts->{write} )
1648             {
1649 29 50       337 unless( $flags & ( O_RDWR | O_WRONLY | O_APPEND ) )
1650             {
1651 0         0 return( $self->error( "Filehandle provided does not have write permission enabled." ) );
1652             }
1653             }
1654             # read mode then
1655             else
1656             {
1657 29 50 33     291 unless( ( ( $flags & O_RDONLY ) == O_RDONLY ) || ( $flags & O_RDWR ) )
1658             {
1659 0         0 return( $self->error( "Filehandle provided does not have read permission enabled. File handle flags value is '$flags'" ) );
1660             }
1661             }
1662             }
1663            
1664             # We check if the file handle is an object, in which case we use its method, because
1665             # it may not be a true glob and calling perl's core read() or print() on it would not
1666             # work unless that glob object has implemented a tie. See perltie manual page.
1667 58         302 my $op;
1668             my $meth;
1669 58 100       267 if( $opts->{write} )
1670             {
1671 29 50 0     160 if( $is_native_glob )
    0          
1672             {
1673             $op = sub
1674             {
1675 357     357   6353 my $rv = print( $fh @_ );
1676 357 50       1104 return( $self->error( "Error writing ", CORE::length( $_[0] ), " bytes of data to output: $!" ) ) if( !defined( $rv ) );
1677 357         1132 return( $rv );
1678 29         580 };
1679             }
1680             elsif( ( $meth = ( $self->_can( $fh => 'print' ) || $self->_can( $fh => 'write' ) ) ) )
1681             {
1682             $op = sub
1683             {
1684             # try-catch
1685 0     0   0 local $@;
1686             my $rv = eval
1687 0         0 {
1688 0         0 $fh->$meth( @_ );
1689             };
1690 0 0       0 if( $@ )
1691             {
1692 0         0 return( $self->error( "Error writing ", CORE::length( $_[0] ), " bytes of data to output: $@" ) );
1693             }
1694 0 0       0 if( !defined( $rv ) )
1695             {
1696 0         0 my $err;
1697 0 0       0 if( defined( $! ) )
    0          
    0          
1698             {
1699 0         0 $err = $!;
1700             }
1701             elsif( $self->_can( $fh => 'error' ) )
1702             {
1703 0         0 $err = $fh->error;
1704             }
1705             elsif( $self->_can( $fh => 'errstr' ) )
1706             {
1707 0         0 $err = $fh->errstr;
1708             }
1709 0         0 return( $self->error( "Error writing ", CORE::length( $_[0] ), " bytes of data to output: $err" ) );
1710             }
1711 0         0 return( $rv );
1712 0         0 };
1713             }
1714             else
1715             {
1716 0         0 return( $self->error( "The file handle provided is not a native opened one and does not support the print() or write() methods." ) );
1717             }
1718             }
1719             else
1720             {
1721 29 50       102 if( $is_native_glob )
    0          
1722             {
1723             $op = sub
1724             {
1725 351     351   1487 my $n = read( $fh, $_[0], $_[1] );
1726 351 50       745 return( $self->error( "Error reading ", $_[1], " bytes of data from input: $!" ) ) if( !defined( $n ) );
1727 351         852 return( $n );
1728 29         494 };
1729             }
1730             elsif( $self->_can( $fh => 'read' ) )
1731             {
1732             $op = sub
1733             {
1734             # try-catch
1735 0     0   0 local $@;
1736             my $n = eval
1737 0         0 {
1738 0         0 $fh->read( @_ );
1739             };
1740 0 0       0 if( $@ )
1741             {
1742 0         0 return( $self->error( "Error reading ", $_[1], " bytes of data from input: $@" ) );
1743             }
1744 0 0       0 if( !defined( $n ) )
1745             {
1746 0         0 my $err;
1747 0 0       0 if( defined( $! ) )
    0          
    0          
1748             {
1749 0         0 $err = $!;
1750             }
1751             elsif( $self->_can( $fh => 'error' ) )
1752             {
1753 0         0 $err = $fh->error;
1754             }
1755             elsif( $self->_can( $fh => 'errstr' ) )
1756             {
1757 0         0 $err = $fh->errstr;
1758             }
1759 0         0 return( $self->error( "Error reading ", $_[1], " bytes of data from intput: $err" ) );
1760             }
1761 0         0 return( $n );
1762 0         0 };
1763             }
1764             else
1765             {
1766 0         0 return( $self->error( "The file handle provided is not a native opened one and does not support the read() method." ) );
1767             }
1768             }
1769 58         1184 return( $fh, $op );
1770             }
1771              
1772             # NOTE: sub FREEZE is inherited
1773              
1774 4     4   323 sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
1775              
1776 4     4   826 sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
1777              
1778             # NOTE: sub THAW is inherited
1779             }
1780              
1781             1;
1782             # NOTE: POD
1783             __END__
1784              
1785             =encoding utf-8
1786              
1787             =head1 NAME
1788              
1789             HTTP::Promise::Stream - Data Stream Encoding and Decoding
1790              
1791             =head1 SYNOPSIS
1792              
1793             use HTTP::Promise::Stream;
1794             my $this = HTTP::Promise::Stream->new ||
1795             die( HTTP::Promise::Stream->error, "\n" );
1796              
1797             =head1 VERSION
1798              
1799             v0.2.0
1800              
1801             =head1 DESCRIPTION
1802              
1803             L<HTTP::Promise::Stream> serves to set a stream of data tha that optionally may need to be encoding or decoding, and read or write data from or to it that may also need to be compressed or decompressed.
1804              
1805             Once those versatile parameters are set, one can use the class method to access or write the data and the necessary encoding or decoding is done automatically.
1806              
1807             =head1 CONSTRUCTOR
1808              
1809             =head2 new
1810              
1811             Provided with a stream source, and some optional parameters and this will return a new L<HTTP::Promise::Stream> object.
1812              
1813             Currently supported stream sources are: scalar reference, glob and file path.
1814              
1815             If an error occurred, this sets an L<error|Module::Generic/error> and returns C<undef>
1816              
1817             Supported parameters are:
1818              
1819             =over 4
1820              
1821             =item * C<decoding>
1822              
1823             A string representing the encoding to use for decoding data. Currently supported encodings are: gzip, bzip2, deflate/inflate and zip
1824              
1825             =item * C<encoding>
1826              
1827             A string representing the encoding to use for encoding data. Currently supported encodings are: gzip, bzip2, deflate/inflate and zip
1828              
1829             =back
1830              
1831             =head1 METHODS
1832              
1833             =head2 as_string
1834              
1835             Returns the source stream as a string, or C<undef> and an L<error|Module::Generic/error> occurred.
1836              
1837             =head2 compress_params
1838              
1839             Sets or gets an hash of parameters-value pairs to be used for the compression algorithm used.
1840              
1841             =head2 decodable
1842              
1843             Provided with a C<target> and this returns an L<array object|Module::Generic::Array> of decoders that are installed.
1844              
1845             The C<target> can be a string or an array reference of decoder names. If the target string C<all> is specified, then, this will check all supported encodings. See L</supported>. If the target string C<browser> is specified, then ths will check only the supported encodings that are also supported by web browsers. If no target is specified, it defaults to C<all>.
1846              
1847             If the target is an array reference, it will return the list of supported decoders in the order provided.
1848              
1849             my $all = $stream->decodable;
1850             # Same as above
1851             my $all = $stream->decodable( 'all' );
1852             my $all = $stream->decodable( 'browser' );
1853             my $all = $stream->decodable( [qw( gzip br deflate )] );
1854             # $all could contain gzip and br for example
1855              
1856             Note that for most encoding, encoding and decoding is done by different classes.
1857              
1858             =head2 decode
1859              
1860             $stream->decode( $data );
1861             $stream->decode( $data, { encoding => bzip2 } );
1862             $stream->decode( $data, { decoding => bzip2 } );
1863             my $decoded = $stream->decode;
1864             my $decoded = $stream->decode( { encoding => bzip2 } );
1865             my $decoded = $stream->decode( { decoding => bzip2 } );
1866              
1867             This behaves in two different ways depending on the parameters provided:
1868              
1869             =over 4
1870              
1871             =item 1. with C<data> provided
1872              
1873             This will decode the C<data> provided using the encoding specified and write the decoded data to the source stream.
1874              
1875             =item 2. without C<data> provided
1876              
1877             This will decode the source stream directly and return the data thus decoded.
1878              
1879             =back
1880              
1881             This method will take the required encoding in the following order: from the C<decoding> parameter, from the C<encoding> parameter, or from L</decoding> as set during object instantiation.
1882              
1883             If the encoding specified is not supported this will return an error.
1884              
1885             It returns true upon success, or sets an L<error|Module::Generic/error> and returns C<undef>
1886              
1887             =head2 decoding
1888              
1889             This is a string. Sets or gets the encoding used for decoding. Supported encodings are: gzip, bzip2, inflate/deflate and zip
1890              
1891             =head2 encodable
1892              
1893             Provided with a C<target> and this returns an L<array object|Module::Generic::Array> of encoders that are installed.
1894              
1895             The C<target> can be a string or an array reference of decoder names. If the target string C<all> is specified, then, this will check all supported encodings. See L</supported>. If the target string C<browser> is specified, then ths will check only the supported encodings that are also supported by web browsers. If no target is specified, it defaults to C<all>.
1896              
1897             If the target is an array reference, it will return the list of supported encoders in the order provided.
1898              
1899             my $all = $stream->encodable;
1900             # Same as above
1901             my $all = $stream->encodable( 'all' );
1902             my $all = $stream->encodable( 'browser' );
1903             my $all = $stream->encodable( [qw( gzip br deflate )] );
1904             # $all could contain gzip and br for example
1905              
1906             Note that for most encoding, encoding and decoding is done by different classes.
1907              
1908             =head2 encode
1909              
1910             $stream->encode( $data );
1911             $stream->encode( $data, { encoding => bzip2 } );
1912             $stream->encode( $data, { decoding => bzip2 } );
1913             my $encoded = $stream->encode;
1914             my $encoded = $stream->encode( { encoding => bzip2 } );
1915             my $encoded = $stream->encode( { decoding => bzip2 } );
1916              
1917             This is the alter ego of L</decode>
1918              
1919             This behaves in two different ways depending on the parameters provided:
1920              
1921             =over 4
1922              
1923             =item 1. with C<data> provided
1924              
1925             This will encode the C<data> provided using the encoding specified and write the encoded data to the source stream.
1926              
1927             =item 2. without C<data> provided
1928              
1929             This will encode the source stream directly and return the data thus encoded.
1930              
1931             =back
1932              
1933             This method will take the required encoding in the following order: from the C<encoding> parameter, or from L</encoding> as set during object instantiation.
1934              
1935             If the encoding specified is not supported this will return an error.
1936              
1937             It returns true upon success, or sets an L<error|Module::Generic/error> and returns C<undef>
1938              
1939             =head2 encoding
1940              
1941             This is a string. Sets or gets the encoding used for encoding. Supported encodings are: gzip, bzip2, inflate/deflate and zip
1942              
1943             =head2 encoding2suffix
1944              
1945             Provided with a string of comma-separated encodings, or an array reference of encodings and this will return an L<array object|Module::Generic::Array> of associated file extensions.
1946              
1947             For example:
1948              
1949             my $a = HTTP::Promise::Stream->encoding2suffix( [qw( base64 gzip )] );
1950             # $a contains: b64 and gz
1951              
1952             my $a = HTTP::Promise::Stream->encoding2suffix( 'gzip' );
1953             # $a contains: gz
1954              
1955             =head2 load
1956              
1957             This attempts the load the specified encoding related class and returns true upon success or false otherwise.
1958              
1959             It sets an L<error|Module::Generic/error> and returns C<undef> upon error.
1960              
1961             For example:
1962              
1963             if( HTTP::Promise::Stream->load( 'bzip2' ) )
1964             {
1965             my $s = HTTP::Promise::Stream->new( \$data, encoding => 'bzip2' );
1966             my $output = Module::Generic::Scalar->new;
1967             my $len = $s->read( $output, { Transparent => 0 } );
1968             die( $s->error ) if( !defined( $len ) );
1969             say "Ok, $len bytes were encoded.";
1970             }
1971             else
1972             {
1973             say "Encoder/decoder bzip2 related modules are not installed on this system.";
1974             }
1975              
1976             See also L</supported>, which will tell you if L<HTTP::Promise::Stream> even supports the specified encoding.
1977              
1978             =head2 read
1979              
1980             $stream->read( $buffer );
1981             $stream->read( $buffer, $len );
1982             $stream->read( $buffer, $len, $offset );
1983             $stream->read( *buffer );
1984             $stream->read( *buffer, $len );
1985             $stream->read( sub{} );
1986             $stream->read( sub{}, $len );
1987             $stream->read( \$buffer );
1988             $stream->read( \$buffer, $len );
1989             $stream->read( \$buffer, $len, $offset );
1990             $stream->read( '/some/where/file.txt' );
1991             $stream->read( '/some/where/file.txt', $len );
1992              
1993             Provided with some parameters, as detailed below, and this will either encode or decode the stream if any encoding was provided at all and into the read buffer specified.
1994              
1995             Possible read buffers are:
1996              
1997             =over 4
1998              
1999             =item * scalar
2000              
2001             =item * scalar reference
2002              
2003             =item * file handle (glob)
2004              
2005             =item * subroutine reference or anonymous subroutine
2006              
2007             =item * file path
2008              
2009             =back
2010              
2011             It takes as optional parameters the C<length> of data, possibly encoded or decoded if any encoding was provided, and an optional C<offset>. However, note that the C<offset> argument is not used and ignored if the data buffer is not a string or a scalar reference.
2012              
2013             Also you can specify an hash reference of options as the last parameter. Recognised options are:
2014              
2015             =over 4
2016              
2017             =item * autoflush
2018              
2019             Boolean value. If true, this will set the auto flush.
2020              
2021             =item * binmode
2022              
2023             The encoding to be used when opening the file specified, if one is specified. See L</binmode>
2024              
2025             =item * mode
2026              
2027             The mode in which to open the file specified, if one is specified.
2028              
2029             Possible modes can be >, +>, >>, +<, w, w+, r+, a, a+, < and r or an integer representing a bitwise value such as O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK, O_SYNC, O_TRUNC, O_RDONLY, O_WRONLY, O_RDWR. For example: C<O_WRONLY|O_APPEND> For that see L<Fcntl>
2030              
2031             =item * other parameters starting with an uppercase letter
2032              
2033             Those parameters will be passed directly to the encoder/decoder.
2034              
2035             my $s = HTTP::Promise::Stream->new( \$data, decoding => 'inflate' );
2036             # Transparent and its value are passed directly to IO::Uncompress::Inflate
2037             $s->read( \$output, { Transparent => 0 } );
2038              
2039             =back
2040              
2041             A typical recommended parameter used for the C<IO::Compress> and C<IO::Uncompress> families is C<Transparent> set to C<0>, otherwise, the default is C<1> and it would be lenient and any encoding/decoding issues with the data would be ignored.
2042              
2043             For example, when using C<inflate> to uncompress data compressed with C<deflate>, some encoder do not format the data correctly, or declare it as C<deflate> when they really meant C<rawdeflate>, i.e. without the zlib headers and trailers. By default with C<Transparent> set to C<1>, L<IO::Uncompress::Inflate> will simply pass through the data. However, you are better of catching the error and resort to using C<rawinflate> instead.
2044              
2045             For example:
2046              
2047             use v5.17;
2048             use HTTP::Promise::Stream;
2049             my $data = '80jNyclXCM8vyklRBAA=';
2050             my $buff = '';
2051             my $s = HTTP::Promise::Stream->new( \$data, decoding => 'base64' ) ||
2052             die( HTTP::Promise::Stream->error );
2053             my $len = $s->read( \$buff );
2054             die( $s->error ) if( !defined( $len ) );
2055            
2056             say "Now inflating data.";
2057             $data = $buff;
2058             $buff = '';
2059             my $s = HTTP::Promise::Stream->new( \$data, decoding => 'deflate' ) ||
2060             die( HTTP::Promise::Stream->error );
2061             $len = $s->read( \$buff, { Transparent => 0 } );
2062             if( !defined( $len ) )
2063             {
2064             # Trying with rawinflate instead
2065             if( $s->error->message =~ /Header Error: CRC mismatch/ )
2066             {
2067             say "Found deflate encoding error (", $s->error->message, "), trying with rawinflate instead.";
2068             my $s = HTTP::Promise::Stream->new( \$data, decoding => 'rawdeflate' ) ||
2069             die( HTTP::Promise::Stream->error );
2070             $len = $s->read( \$buff, { Transparent => 0 } );
2071             die( $s->error ) if( !defined( $len ) );
2072             }
2073             else
2074             {
2075             die( $s->error );
2076             }
2077             }
2078             say $buff; # Hello world
2079              
2080             =head2 source
2081              
2082             Set or get the source stream.
2083              
2084             =head2 suffix2encoding
2085              
2086             Provided with a filename, and this will return an L<array object|Module::Generic::Array> containing the encoding naes associated with the extensions found.
2087              
2088             For example:
2089              
2090             my $a = HTTP::Promise::Stream->suffix2encoding( 'file.html.gz' );
2091             # $a contains: gzip
2092              
2093             my $a = HTTP::Promise::Stream->suffix2encoding( 'file.html' );
2094             # $a contains nothing
2095              
2096             =head2 supported
2097              
2098             Provided with an encoding name and this returns true if it is supported, or false otherwise.
2099              
2100             Currently supported encodings are:
2101              
2102             =over 4
2103              
2104             =item Base64
2105              
2106             Supported natively. See L<HTTP::Promise::Stream::Base64>
2107              
2108             =item Brotli
2109              
2110             Requires L<IO::Compress::Brotli> for encoding and L<IO::Uncompress::Brotli> for decoding.
2111              
2112             See also L<caniuse|https://caniuse.com/brotli>
2113              
2114             =item Bzip2
2115              
2116             Requires L<IO::Compress::Bzip2> for encoding and L<IO::Uncompress::Bunzip2> for decoding.
2117              
2118             =item Deflate and Inflate
2119              
2120             Requires L<IO::Compress::Deflate> for encoding and L<IO::Uncompress::Inflate> for decoding.
2121              
2122             This is the same as C<rawdeflate> and C<rawinflate>, except it has zlib headers and trailers.
2123              
2124             See also its L<rfc1950|https://tools.ietf.org/html/rfc1950>, L<the Wikipedia page|https://en.wikipedia.org/wiki/Deflate> and L<Mozilla documentation about Content-Encoding|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Encoding#directives>
2125              
2126             Note that some web server announce data encoded with C<deflate> whereas they really mean C<rawdeflate>, so you might want to use the C<Transparent> parameter set to C<0> when using L</read>
2127              
2128             =item Gzip
2129              
2130             Requires L<IO::Compress::Gzip> for encoding and L<IO::Uncompress::Gunzip> for decoding.
2131              
2132             See also L<caniuse|https://caniuse.com/sr_content-encoding-gzip>
2133              
2134             =item Lzf
2135              
2136             This is Lempel-Ziv-Free compression.
2137              
2138             Requires L<IO::Compress::Lzf> for encoding and L<IO::Uncompress::UnLzf> for decoding.
2139              
2140             See L<Stackoverflow discussion|https://stackoverflow.com/questions/5089112/whatre-lzo-and-lzf-and-the-differences>
2141              
2142             =item Lzip
2143              
2144             Requires L<IO::Compress::Lzip> for encoding and L<IO::Uncompress::UnLzip> for decoding.
2145              
2146             =item Lzma
2147              
2148             Requires L<IO::Compress::Lzma> for encoding and L<IO::Uncompress::UnLzma> for decoding.
2149              
2150             See L<Wikipedia page|https://fr.wikipedia.org/wiki/LZMA>
2151              
2152             =item Lzop
2153              
2154             Requires L<IO::Compress::Lzop> for encoding and L<IO::Uncompress::UnLzop> for decoding.
2155              
2156             "lzop is a file compressor which is very similar to L<gzip|http://www.gzip.org/>. lzop uses the L<LZO data compression library|http://www.oberhumer.com/opensource/lzo/> for compression services, and its main advantages over gzip are much higher compression and decompression speed (at the cost of some compression ratio)."
2157              
2158             See the L<compressor home page|https://www.lzop.org/> and L<Wikipedia page|https://en.wikipedia.org/wiki/Lzop>
2159              
2160             =item Lzw
2161              
2162             This is Lempel-Ziv-Welch compression.
2163              
2164             Requires L<Compress::LZW> for encoding and for decoding.
2165              
2166             A.k.a C<compress>, this was used commonly until some corporation purchased the patent and started asking everyone for royalties. The patent expired in 2003. Gzip took over since then.
2167              
2168             =item QuptedPrint
2169              
2170             Requires the XS module L<MIME::QuotedPrint> for encoding and decoding.
2171              
2172             This encodes and decodes the quoted-printable data according to L<rfc2045, section 6.7|https://tools.ietf.org/html/rfc2045#section-6.7>
2173              
2174             See also the L<Wikipedia page|https://en.wikipedia.org/wiki/Quoted-printable>
2175              
2176             =item Raw deflate
2177              
2178             Requires L<IO::Compress::RawDeflate> for encoding and L<IO::Uncompress::RawInflate> for decoding.
2179              
2180             This is the same as C<deflate> and C<inflate>, but without the zlib headers and trailers.
2181              
2182             See also its L<rfc1951|https://tools.ietf.org/html/rfc1951> and L<Mozilla documentation about Content-Encoding|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Encoding#directives>
2183              
2184             =item UU encoding and decoding
2185              
2186             Supported natively. See L<HTTP::Promise::Stream::UU>
2187              
2188             =item Xz
2189              
2190             Requires L<IO::Compress::Xz> for encoding and L<IO::Uncompress::UnXz> for decoding.
2191              
2192             Reportedly, "xz achieves higher compression rates than alternatives like gzip and bzip2. Decompression speed is higher than bzip2, but lower than gzip. Compression can be much slower than gzip, and is slower than bzip2 for high levels of compression, and is most useful when a compressed file will be used many times."
2193              
2194             See L<compressor home page|https://tukaani.org/xz/> and L<Wikipedia page|https://en.wikipedia.org/wiki/XZ_Utils>
2195              
2196             =item Zip
2197              
2198             Requires L<IO::Compress::Zip> for encoding and L<IO::Uncompress::Unzip> for decoding.
2199              
2200             =item Zstd
2201              
2202             Requires L<IO::Compress::Zstd> for encoding and L<IO::Uncompress::UnZstd> for decoding.
2203              
2204             See L<rfc8878|https://tools.ietf.org/html/rfc8878> and L<Wikipedia page|https://en.wikipedia.org/wiki/Zstd>
2205              
2206             =back
2207              
2208             See also L</load>, which will tell you if the specified encoding related modules are installed on the system or not.
2209              
2210             =head2 write
2211              
2212             $stream->write( $data );
2213             $stream->write( \$data );
2214             $stream->write( *$data );
2215             $stream->write( '/some/where/file.txt' );
2216             $stream->write( sub{} );
2217              
2218             Provided with some data, and this will read the data provided, and write it, possibly encoded or decoded, depending on whether a decoding or encoding was provided, to the stream source.
2219              
2220             It returns the amount of bytes written to the source stream, but before any possible encoding or decoding.
2221              
2222             The data that can be provided are:
2223              
2224             =over 4
2225              
2226             =item * string
2227              
2228             Note that the difference between a file and a string is slim. To distinguish the two, this method will treat as a string any value that is not a reference and that either contains a CRLF sequence, or that does not contain a CRLF sequence and is not an existing file.
2229              
2230             =item * scalar reference
2231              
2232             =item * file handle (glob)
2233              
2234             =item * file path
2235              
2236             Note that the difference between a file and a string is slim. So to distinguish the two, this method will treat as a file a value that has no CRLR sequence
2237              
2238             =item * code reference (anonymous subroutine or subroutine reference)
2239              
2240             It will be called once and expect data in return. If the code executed dies, the exception will be trapped using try-catch block from L<Nice::Try>
2241              
2242             =back
2243              
2244             The behaviour is different depending on the source type and the data type being provided. Below is an in-depth explanation:
2245              
2246             =over 4
2247              
2248             =item 1. Source stream is a code reference
2249              
2250             =over 8
2251              
2252             =item 1.1 Data is to be encoded
2253              
2254             Data is encoded with L</encode>, then the source code reference is executed, passing it the encoded data
2255              
2256             =item 1.2 Data is to be decoded
2257              
2258             Data is decoded with L</decode>, then the source code reference is executed, passing it the decoded data
2259              
2260             =item 1.3 Data is scalar reference
2261              
2262             The source code reference is executed, passing it the content of the scalar reference
2263              
2264             =item 1.4 Data is a glob
2265              
2266             The file handle is read by chunks of 10Kb (10240 bytes) and each time the source code reference is called passing it the data chunk read.
2267              
2268             =item 1.5 Data is a file path
2269              
2270             The file is opened in read mode, and all its content is provided in one pass to the source code reference.
2271              
2272             =back
2273              
2274             =item 2. Data is the be encoded
2275              
2276             The appropriate encoder is called to encode the data and write to the source stream.
2277              
2278             =item 3. Data is to be decoded
2279              
2280             The appropriate decoder is called to decode the data and write to the source stream.
2281              
2282             =item 4. Source stream is a scalar reference
2283              
2284             =over 8
2285              
2286             =item 4.1 Data is a scalar reference
2287              
2288             The provided data is simply appended to the source stream.
2289              
2290             =item 4.2 Data is a glob
2291              
2292             The file handle is read by chunks of 10Kb (10240 bytes) and appended to the source stream.
2293              
2294             =item 4.3 Data is a file path
2295              
2296             The file is opened in read mode and its content appended to the source stream.
2297              
2298             =back
2299              
2300             =item 5. Source stream is a glob
2301              
2302             =over 8
2303              
2304             =item 5.1 Data is a scalar reference
2305              
2306             The file handle of the source stream is called with L</print> and the data is printed to it.
2307              
2308             =item 5.2 Data is a glob
2309              
2310             The data file handle is read by chunks of 10Kb (10240 bytes) and each one printed to the source stream file handle.
2311              
2312             =item 5.3 Data is a file path
2313              
2314             The given file path is read in read mode and each chunk of 10Kb (10240 bytes) read is printed to the source stream file handle.
2315              
2316             =back
2317              
2318             =item 6. Source stream is a file path
2319              
2320             The source file is opened in write clobbering mode.
2321              
2322             =over 8
2323              
2324             =item 6.1 Data is a scalar reference
2325              
2326             The data is printed to the source stream
2327              
2328             =item 6.2 Data is a glob
2329              
2330             Data from the glob is read by chunks of 10Kb (10240 bytes) and each one printed to the source stream
2331              
2332             =item 6.3 Data is a file path.
2333              
2334             The file is opened in read mode and its content is read by chunks o 10Kb (10240 bytes) and each chunk printed to the source stream.
2335              
2336             =back
2337              
2338             =back
2339              
2340             =for Pod::Coverage _get_size
2341              
2342             =head1 AUTHOR
2343              
2344             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
2345              
2346             =head1 SEE ALSO
2347              
2348             L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Compression>, L<Content-Encoding documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Encoding>
2349              
2350             L<Wikipedia page|https://en.wikipedia.org/wiki/HTTP_compression>
2351              
2352             L<PerlIO::via::gzip>, L<PerlIO::via::Bzip2>, L<PerlIO::via::Base64>, L<PerlIO::via::QuotedPrint>, L<PerlIO::via::xz>
2353              
2354             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>
2355              
2356             =head1 COPYRIGHT & LICENSE
2357              
2358             Copyright(c) 2022 DEGUEST Pte. Ltd.
2359              
2360             All rights reserved
2361             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
2362              
2363             =cut