File Coverage

lib/HTTP/Promise/Stream/UU.pm
Criterion Covered Total %
statement 81 100 81.0
branch 18 36 50.0
condition 6 15 40.0
subroutine 14 19 73.6
pod 8 8 100.0
total 127 178 71.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Stream/UU.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/04/29
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::UU;
15             BEGIN
16             {
17 3     3   233061 use strict;
  3         15  
  3         99  
18 3     3   16 use warnings;
  3         6  
  3         87  
19 3     3   736 use HTTP::Promise::Stream;
  3         8  
  3         25  
20 3     3   911 use parent -norequire, qw( HTTP::Promise::Stream::Generic );
  3         6  
  3         23  
21 3     3   173 use vars qw( @EXPORT_OK $VERSION $EXCEPTION_CLASS $UUError );
  3         4  
  3         203  
22             use constant {
23 3         354 DECODE_BUFFER_SIZE => 1024,
24             ENCODE_BUFFER_SIZE => 45,
25 3     3   19 };
  3         6  
26 3     3   15 our @EXPORT_OK = qw( decode_uu encode_uu );
27 3         6 our $EXCEPTION_CLASS = 'HTTP::Promise::Exception';
28 3         65 our $VERSION = 'v0.2.0';
29             };
30              
31 3     3   21 use strict;
  3         9  
  3         67  
32 3     3   19 use warnings;
  3     0   5  
  3         3086  
33              
34             sub decode
35             {
36 0     1 1 0 my $self = shift( @_ );
37 1         2276 my $from = shift( @_ );
38 1         9 my $to = shift( @_ );
39 1         4 my $opts = $self->_get_args_as_hash( @_ );
40 1         9 my( $from_fh, $reader ) = $self->_get_glob_from_arg( $from );
41 1         15 my( $to_fh, $writer ) = $self->_get_glob_from_arg( $to, write => 1 );
42 1 50 33     13 return( $self->pass_error ) if( !defined( $from_fh ) || !defined( $to_fh ) );
43 1         17 my( $n, $buff );
44 1         3 $buff = '';
45            
46             my $getline = sub
47             {
48 1 100 66 8   13 if( length( $buff ) > 0 && $buff =~ s/^((?:[^\015\012]+)\015?\012)// )
49             {
50 8         62 return( $1 );
51             }
52             else
53             {
54 7         26 while( $n = $reader->( $buff, DECODE_BUFFER_SIZE, length( $buff ) ) )
55             {
56 1 50       10 if( $buff =~ s/^((?:[^\015\012]+)\015?\012)// )
57             {
58 1         24 return( $1 );
59             }
60             else
61             {
62 1         12 next;
63             }
64             }
65 0         0 return;
66             }
67 1         6 };
68            
69 0         0 my( $mode, $fname );
70 1         5 my $done;
71 1         0 local $_;
72             # Credit: brian d foy <https://metacpan.org/dist/PerlPowerTools/view/bin/uudecode>
73 1         2 READ: while( defined( $_ = $getline->() ) )
74             {
75 1 50       2 next unless( ( $mode, $fname ) = /^begin[[:blank:]\h]+(\d+)[[:blank:]\h]+(\S+)/ );
76 1         23 $self->filename( $fname );
77 1         7 $self->mode( $mode );
78 1         826 $opts->{filename} = $fname;
79 1         35866 $opts->{mode} = $mode;
80 1         5 $done = 0;
81 1         9 LINE: while( defined( $_ = $getline->() ) )
82             {
83 1 100       9 if( /^end$/ )
84             {
85 7         18 $done = 1;
86 1         3 last READ;
87             }
88 1 50       3 next LINE if( /[a-z]/ );
89 6 50       16 next LINE unless int( ( ( ( ord( $_ ) - 32 ) & 077 ) + 2 ) / 3 ) == int( length( $_ ) / 4 );
90 6         20 my $rv = $writer->( unpack( 'u', $_ ) );
91 6 50       26 return( $self->pass_error ) if( !defined( $rv ) );
92             }
93             }
94 6 50       27 return( $self->error( "No UU encoded data found." ) ) if( !defined( $done ) );
95 1 50       4 return( $self->error( "Missing end. input data stream may be truncated." ) ) if( !$done );
96 1         3 return( $self );
97             }
98              
99             sub decode_uu
100             {
101 1     0 1 23 my $s = __PACKAGE__->new;
102 0         0 my $rv = $s->decode( @_ );
103 0 0       0 if( !defined( $rv ) )
104             {
105 0         0 $UUError = $s->error;
106 0         0 return;
107             }
108             else
109             {
110 0         0 undef( $UUError );
111 0         0 return( $rv );
112             }
113             }
114              
115             sub encode
116             {
117 0     1 1 0 my $self = shift( @_ );
118 1         9237 my $from = shift( @_ );
119 1         18 my $to = shift( @_ );
120 1         18 my $opts = $self->_get_args_as_hash( @_ );
121 1         18 my( $from_fh, $reader ) = $self->_get_glob_from_arg( $from );
122 1         273 my( $to_fh, $writer ) = $self->_get_glob_from_arg( $to, write => 1 );
123 1 50 33     7 return( $self->pass_error ) if( !defined( $from_fh ) || !defined( $to_fh ) );
124 1 50 33     79 my $fname = ( exists( $opts->{filename} ) && length( $opts->{filename} ) ) ? $opts->{filename} : 'unknown.bin';
125 1 50 33     20 my $mode = ( exists( $opts->{mode} ) && length( $opts->{mode} ) ) ? $opts->{mode} : 0644;
126 1         34 my( $n, $buff );
127            
128 1         9 my $rv = $writer->( sprintf( "begin %03o $fname\n", $mode ) );
129 1 50       6 return( $self->pass_error ) if( !defined( $rv ) );
130 1         10 while( $n = $reader->( $buff, ENCODE_BUFFER_SIZE ) )
131             {
132 1         12 $writer->( pack( 'u', $buff ) );
133             }
134 5 50       23 defined( $writer->( "`\n" ) ) or return( $self->pass_error );
135 1 50       10 defined( $writer->( "end\n" ) ) or return( $self->pass_error );
136 1         3 return( $self );
137             }
138              
139             sub encode_uu
140             {
141 1     0 1 22 my $s = __PACKAGE__->new;
142 0         0 my $rv = $s->encode( @_ );
143 0 0       0 if( !defined( $rv ) )
144             {
145 0         0 $UUError = $s->error;
146 0         0 return;
147             }
148             else
149             {
150 0         0 undef( $UUError );
151 0         0 return( $rv );
152             }
153             }
154              
155 0     1 1 0 sub filename { return( shift->_set_get_scalar( 'filename', @_ ) ); }
156              
157 1     0 1 38 sub is_decoder_installed { return(1); }
158              
159 0     0 1 0 sub is_encoder_installed { return(1); }
160              
161 0     1 1 0 sub mode { return( shift->_set_get_number( 'mode', @_ ) ); }
162              
163             # NOTE: sub FREEZE is inherited
164              
165             # NOTE: sub STORABLE_freeze is inherited
166              
167             # NOTE: sub STORABLE_thaw is inherited
168              
169             # NOTE: sub THAW is inherited
170              
171             1;
172             # NOTE: POD
173             __END__
174              
175             =encoding utf-8
176              
177             =head1 NAME
178              
179             HTTP::Promise::Stream::UU - Stream Encoder for UU Encoding
180              
181             =head1 SYNOPSIS
182              
183             use HTTP::Promise::Stream::UU;
184             my $s = HTTP::Promise::Stream::UU->new ||
185             die( HTTP::Promise::Stream::UU->error, "\n" );
186             $s->encode( $input => $output, eol => "\n" ) ||
187             die( $s->error );
188             $s->decode( $input => $output ) || die( $s->error );
189             HTTP::Promise::Stream::UU::encode_uu( $input => $output, eol => "\n" ) ||
190             die( $HTTP::Promise::Stream::UU::UUError );
191             HTTP::Promise::Stream::UU::decode_uu( $input => $output, eol => "\n" ) ||
192             die( $HTTP::Promise::Stream::UU::UUError );
193              
194             =head1 VERSION
195              
196             v0.2.0
197              
198             =head1 DESCRIPTION
199              
200             This implements an encoding and decoding mechanism for UU encoding using either of the following on input and output:
201              
202             =over 4
203              
204             =item C<filepath>
205              
206             If the parameter is neither a scalar reference nor a file handle, it will be assumed to be a file path.
207              
208             =item C<file handle>
209              
210             This can be a native file handle, or an object oriented one as long as it implements the C<print> or C<write>, and C<read> methods. The C<read> method is expected to return the number of bytes read or C<undef> upon error. The C<print> and C<write> methods are expected to simply return true upon success and C<undef> upon error.
211              
212             Alternatively, those methods can die and those exceptions wil be caught.
213              
214             =item C<scalar reference>
215              
216             This can be a simple scalar reference, or an object scalar reference.
217              
218             =back
219              
220             =head1 CONSTRUCTOR
221              
222             =head2 new
223              
224             Creates a new L<HTTP::Promise::Stream::UU> object and returns it.
225              
226             =head1 METHODS
227              
228             =head2 decode
229              
230             This takes 2 arguments: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
231              
232             It will decode the UU encoded data and write the result into the output.
233              
234             It returns true upon success and sets an L<error|Module::Generic/error> and return C<undef> upon error.
235              
236             =head2 encode
237              
238             This takes 2 arguments: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
239              
240             It will encode the data into UU encoded data and write the result into the output.
241              
242             Possible options are:
243              
244             =over 4
245              
246             =item I<filename>
247              
248             The file name (not the file path) to be used for UU encoding.
249              
250             =item I<mode>
251              
252             The file octal permisions, like C<0644>. It defaults to C<0644> if nothing is provided.
253              
254             =back
255              
256             It returns true upon success and sets an L<error|Module::Generic/error> and return C<undef> upon error.
257              
258             =head1 CLASS FUNCTIONS
259              
260             The following class functions are available and can also be exported, such as:
261              
262             use HTTP::Promise::Stream::Brotli qw( decode_uu encode_uu );
263              
264             =head2 decode_uu
265              
266             This takes the same 2 arguments used in L</decode>: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
267              
268             It will decode the UU encoded data and write the result into the output.
269              
270             It returns true upon success, and upon error, it will set the error in the global variable C<$UUError> and return C<undef>
271              
272             my $decoded = HTTP::Promise::Stream::UU::decode_uu( $encoded );
273             die( "Something went wrong: $HTTP::Promise::Stream::UU::UUError\n" if( !defined( $decoded ) );
274             print( "Decoded data is: $decoded\n" );
275              
276             =head2 encode_uu
277              
278             This takes the same 2 arguments used in L</encode>: an input and an output. Each one can be either a file path, a file handle, or a scalar reference.
279              
280             It will encode the data into UU encoded data and write the result into the output.
281              
282             It returns true upon success, and upon error, it will set the error in the global variable C<$UUError> and return C<undef>
283              
284             my $encoded = HTTP::Promise::Stream::UU::encode_uu( $data );
285             die( "Something went wrong: $HTTP::Promise::Stream::UU::UUError\n" if( !defined( $encoded ) );
286             print( "Encoded data is: $encoded\n" );
287              
288             =head2 is_decoder_installed
289              
290             Always returns true, because decoding is done internally.
291              
292             =head2 is_encoder_installed
293              
294             Always returns true, because encoding is done internally.
295              
296             =head1 AUTHOR
297              
298             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
299              
300             =head1 SEE ALSO
301              
302             L<Wikipedia page|https://en.wikipedia.org/wiki/Uuencoding>
303              
304             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>
305              
306             =head1 COPYRIGHT & LICENSE
307              
308             Copyright(c) 2022 DEGUEST Pte. Ltd.
309              
310             All rights reserved.
311              
312             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
313              
314             =cut