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
|
|
823309
|
use strict; |
|
14
|
|
|
|
|
49
|
|
|
14
|
|
|
|
|
526
|
|
18
|
14
|
|
|
14
|
|
97
|
use warnings; |
|
14
|
|
|
|
|
64
|
|
|
14
|
|
|
|
|
437
|
|
19
|
14
|
|
|
14
|
|
86
|
use warnings::register; |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
2471
|
|
20
|
14
|
|
|
14
|
|
129
|
use parent qw( Module::Generic ); |
|
14
|
|
|
|
|
46
|
|
|
14
|
|
|
|
|
196
|
|
21
|
14
|
|
|
14
|
|
399949
|
use vars qw( $FILTER_MAP $CLASSES $ENCODING_SUFFIX $SUFFIX_ENCODING ); |
|
14
|
|
|
|
|
60
|
|
|
14
|
|
|
|
|
1094
|
|
22
|
|
|
|
|
|
|
# use Nice::Try; |
23
|
14
|
|
|
14
|
|
121
|
use Scalar::Util; |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
750
|
|
24
|
14
|
|
|
14
|
|
93
|
use constant HAS_BROWSER_SUPPORT => 1; |
|
14
|
|
|
|
|
30
|
|
|
14
|
|
|
|
|
1232
|
|
25
|
14
|
|
|
14
|
|
365
|
our $VERSION = 'v0.2.0'; |
26
|
|
|
|
|
|
|
}; |
27
|
|
|
|
|
|
|
|
28
|
14
|
|
|
14
|
|
143
|
use strict; |
|
14
|
|
|
|
|
36
|
|
|
14
|
|
|
|
|
351
|
|
29
|
14
|
|
|
14
|
|
82
|
use warnings; |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
456
|
|
30
|
14
|
|
|
14
|
|
94
|
no warnings 'uninitialized'; |
|
14
|
|
|
|
|
48
|
|
|
14
|
|
|
|
|
802
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
{ |
33
|
14
|
|
|
14
|
|
107
|
no warnings 'once'; |
|
14
|
|
|
|
|
48
|
|
|
14
|
|
|
|
|
141039
|
|
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
|
3522841
|
my $self = shift( @_ ); |
630
|
122
|
|
|
|
|
374
|
my $src = shift( @_ ); |
631
|
122
|
0
|
33
|
|
|
832
|
return( $self->error( "No stream was provided." ) ) if( !defined( $src ) && !length( $src ) ); |
632
|
122
|
100
|
|
|
|
1026
|
my $type = ref( $src ) ? lc( Scalar::Util::reftype( $src ) ) : ''; |
633
|
122
|
100
|
|
|
|
466
|
if( ref( $src ) ) |
634
|
|
|
|
|
|
|
{ |
635
|
121
|
100
|
66
|
|
|
960
|
if( $self->_is_a( $src => 'Module::Generic::File' ) ) |
|
|
50
|
33
|
|
|
|
|
636
|
|
|
|
|
|
|
{ |
637
|
47
|
|
|
|
|
2920
|
$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
|
|
|
|
21
|
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
|
|
|
|
|
5413
|
$self->{compress_params} = {}; |
652
|
122
|
|
|
|
|
659
|
$self->{encoding} = undef; |
653
|
122
|
|
|
|
|
532
|
$self->{decoding} = undef; |
654
|
122
|
|
|
|
|
389
|
$self->{_init_strict_use_sub} = 1; |
655
|
122
|
|
|
|
|
380
|
$self->{_exception_class} = 'HTTP::Promise::Exception'; |
656
|
122
|
50
|
|
|
|
604
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
657
|
122
|
|
|
|
|
120841
|
$self->source( $src ); |
658
|
122
|
|
|
|
|
99111
|
$self->{read_tmp_file} = undef; |
659
|
122
|
|
|
|
|
489
|
$self->{src_file_handle} = undef; |
660
|
122
|
100
|
66
|
|
|
2033
|
if( defined( $self->{encoding} ) && length( $self->{encoding} ) ) |
|
|
100
|
66
|
|
|
|
|
661
|
|
|
|
|
|
|
{ |
662
|
33
|
100
|
|
|
|
598
|
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
|
|
|
|
1112
|
return( $self->error( "Decoding provided \"$self->{decoding}\" is unsupported." ) ) if( !exists( $FILTER_MAP->{decode}->{ $self->{decoding} } ) ); |
667
|
|
|
|
|
|
|
} |
668
|
118
|
|
|
|
|
1069
|
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
|
906
|
sub compress_params { return( shift->_set_get_hash_as_mix_object( 'compress_params', @_ ) ); } |
723
|
|
|
|
|
|
|
|
724
|
2
|
|
|
2
|
1
|
25
|
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
|
6342
|
my( $self ) = @_; |
733
|
13
|
|
|
|
|
32
|
my $opts = {}; |
734
|
13
|
100
|
|
|
|
71
|
$opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' ); |
735
|
13
|
|
100
|
|
|
50
|
$opts->{encoding} //= ''; |
736
|
13
|
|
50
|
|
|
98
|
$opts->{decoding} //= ''; |
737
|
13
|
|
66
|
|
|
80
|
my $dec = $opts->{decoding} || $opts->{encoding} || $self->decoding->lower; |
738
|
13
|
|
|
|
|
684
|
my $src = $self->source; |
739
|
|
|
|
|
|
|
# Scalar reference or glob |
740
|
13
|
50
|
|
|
|
9625
|
my $this = @_ >= 2 ? $_[1] : $src; |
741
|
13
|
|
|
|
|
58
|
my $size = $self->_get_size( $this ); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
# No need to bother going further |
744
|
13
|
50
|
33
|
|
|
110
|
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
|
|
|
|
|
42
|
my $filters = $FILTER_MAP->{decode}; |
752
|
13
|
50
|
|
|
|
54
|
return( $self->error( "Unknown decoding \"$dec\"." ) ) if( !exists( $filters->{ $dec } ) ); |
753
|
13
|
|
|
|
|
65
|
my $params = $self->_io_compress_params( $opts ); |
754
|
13
|
|
|
|
|
37
|
my $rv; |
755
|
|
|
|
|
|
|
# Decode some data provided and into the stream |
756
|
13
|
50
|
|
|
|
46
|
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
|
|
|
|
|
22
|
my $buf; |
766
|
13
|
|
|
|
|
83
|
( $rv, my $err ) = $filters->{ $dec }->( $src => \$buf, %$params ); |
767
|
13
|
50
|
|
|
|
36
|
return( $self->error( "Unable to decode $size bytes of data from the stream with $dec: $err" ) ) if( !defined( $rv ) ); |
768
|
13
|
50
|
|
|
|
67
|
return( $buf ) if( defined( $rv ) ); |
769
|
0
|
|
|
|
|
0
|
return( $rv ); |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
|
773
|
173
|
|
|
173
|
1
|
13288
|
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
|
26305
|
my( $self ) = @_; |
784
|
12
|
|
|
|
|
25
|
my $opts = {}; |
785
|
12
|
50
|
|
|
|
49
|
$opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' ); |
786
|
12
|
|
50
|
|
|
46
|
$opts->{encoding} //= ''; |
787
|
12
|
|
33
|
|
|
33
|
my $enc = $opts->{encoding} || $self->encoding->lower; |
788
|
12
|
|
|
|
|
36
|
my $src = $self->source; |
789
|
|
|
|
|
|
|
# Scalar reference or glob |
790
|
12
|
50
|
|
|
|
9174
|
my $this = @_ >= 2 ? $_[1] : $src; |
791
|
12
|
|
|
|
|
48
|
my $size = $self->_get_size( $this ); |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# No need to bother going further |
794
|
12
|
50
|
33
|
|
|
153
|
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
|
|
|
|
|
36
|
my $filters = $FILTER_MAP->{encode}; |
802
|
12
|
50
|
|
|
|
38
|
return( $self->error( "Unknown encoding \"$enc\". Supported encodings are: ", join( ', ', sort( keys( %$filters ) ) ) ) ) if( !exists( $filters->{ $enc } ) ); |
803
|
12
|
|
|
|
|
35
|
my $params = $self->_io_compress_params( $opts ); |
804
|
12
|
|
|
|
|
19
|
my $rv; |
805
|
|
|
|
|
|
|
# Encode some data provided and into the stream |
806
|
12
|
50
|
|
|
|
29
|
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
|
|
|
|
|
17
|
my $buf; |
816
|
12
|
|
|
|
|
16
|
my $ref = \$buf; |
817
|
12
|
|
|
|
|
125
|
( $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
|
|
|
|
59
|
return( $buf ) if( defined( $rv ) ); |
820
|
0
|
|
|
|
|
0
|
return( $rv ); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
133
|
|
|
133
|
1
|
5842
|
sub encoding { return( shift->_set_get_scalar_as_object( 'encoding', @_ ) ); } |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
sub encoding2suffix |
827
|
|
|
|
|
|
|
{ |
828
|
16
|
|
|
16
|
1
|
6987
|
my $self = shift( @_ ); |
829
|
16
|
|
|
|
|
21
|
my $this = shift( @_ ); |
830
|
16
|
0
|
0
|
|
|
68
|
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
|
|
|
|
173
|
my $encodings = $self->new_array( $self->_is_array( $this ) ? $this : [split( /[[:blank:]\h]*,[[:blank:]\h]*/, lc( "${this}" ) )] ); |
832
|
16
|
|
|
|
|
424
|
my $ext = $self->new_array; |
833
|
16
|
|
|
|
|
211
|
foreach( @$encodings ) |
834
|
|
|
|
|
|
|
{ |
835
|
17
|
100
|
|
|
|
72
|
return( $self->error( "Unknown encoding provided \"$_\"." ) ) if( !exists( $ENCODING_SUFFIX->{ $_ } ) ); |
836
|
16
|
|
|
|
|
42
|
$ext->push( $ENCODING_SUFFIX->{ $_ } ); |
837
|
|
|
|
|
|
|
} |
838
|
15
|
|
|
|
|
96
|
return( $ext ); |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub load |
842
|
|
|
|
|
|
|
{ |
843
|
1
|
|
|
1
|
1
|
9
|
my $self = shift( @_ ); |
844
|
1
|
|
50
|
|
|
15
|
my $enc = shift( @_ ) || return( $self->error( "No encoding was provided." ) ); |
845
|
1
|
|
|
|
|
6
|
$enc = lc( $enc ); |
846
|
1
|
50
|
|
|
|
20
|
return(0) if( !exists( $CLASSES->{ $enc } ) ); |
847
|
1
|
|
|
|
|
28
|
my $opts = $self->_get_args_as_hash( @_ ); |
848
|
1
|
|
|
|
|
14
|
my $p = {}; |
849
|
1
|
50
|
33
|
|
|
14
|
$p->{version} = $opts->{version} if( exists( $opts->{version} ) && length( $opts->{version} ) ); |
850
|
1
|
|
|
|
|
9
|
my( $encoder, $decoder ) = @{$CLASSES->{ $enc }}; |
|
1
|
|
|
|
|
17
|
|
851
|
1
|
|
|
|
|
3
|
my $ok = 0; |
852
|
1
|
|
|
|
|
3
|
for( $encoder, $decoder ) |
853
|
|
|
|
|
|
|
{ |
854
|
2
|
50
|
66
|
|
|
28
|
$ok++, next if( $_ eq $decoder && $decoder eq $encoder ); |
855
|
2
|
50
|
|
|
|
19
|
$self->_load_class( $_, $p ) || next; |
856
|
2
|
|
|
|
|
12459
|
$ok++; |
857
|
|
|
|
|
|
|
} |
858
|
1
|
50
|
|
|
|
20
|
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
|
1029582
|
my( $self ) = @_; |
872
|
80
|
|
|
|
|
298
|
my $opts = {}; |
873
|
80
|
100
|
|
|
|
696
|
$opts = pop( @_ ) if( ref( $_[-1] ) eq 'HASH' ); |
874
|
80
|
50
|
33
|
|
|
842
|
$opts->{binmode} = 'raw' if( !exists( $opts->{binmode} ) || !length( $opts->{binmode} ) ); |
875
|
80
|
|
|
|
|
378
|
my $src = $self->source; |
876
|
80
|
|
66
|
|
|
59983
|
my $enc = $self->encoding->lower || lc( $opts->{encoding} ); |
877
|
80
|
|
66
|
|
|
47918
|
my $dec = $self->decoding->lower || lc( $opts->{decoding} ); |
878
|
80
|
|
|
|
|
45770
|
my $io = $self->{src_file_handle}; |
879
|
80
|
|
|
|
|
499
|
my $tempfile = $self->{read_tmp_file}; |
880
|
80
|
50
|
|
|
|
381
|
unless( $io ) |
881
|
|
|
|
|
|
|
{ |
882
|
80
|
|
50
|
|
|
814
|
$tempfile = $self->{read_tmp_file} = $self->new_tempfile || |
883
|
|
|
|
|
|
|
return( $self->error( "Unable to get a new tempfile: ", $self->error ) ); |
884
|
80
|
100
|
|
|
|
4214239
|
if( $enc ) |
|
|
50
|
|
|
|
|
|
885
|
|
|
|
|
|
|
{ |
886
|
12
|
|
|
|
|
457
|
my $params = $self->_io_compress_params( $opts ); |
887
|
12
|
|
|
|
|
99
|
my $filters = $FILTER_MAP->{encode}; |
888
|
12
|
50
|
|
|
|
125
|
return( $self->error( "Unknown encoding \"$enc\"." ) ) if( !exists( $filters->{ $enc } ) ); |
889
|
12
|
|
|
|
|
303
|
my( $rv, $err ) = $filters->{ $enc }->( $self->_normalise( $src ) => "$tempfile", %$params ); |
890
|
12
|
|
|
|
|
239
|
my $size = $self->_get_size( $src ); |
891
|
12
|
50
|
|
|
|
218
|
return( $self->error( "Unable to encode $size bytes of data into the stream with $enc: $err" ) ) if( !defined( $rv ) ); |
892
|
12
|
|
50
|
|
|
249
|
$io = $self->{src_file_handle} = $tempfile->open( '<', { binmode => $opts->{binmode} }) || |
893
|
|
|
|
|
|
|
return( $self->pass_error( $tempfile ) ); |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
elsif( $dec ) |
896
|
|
|
|
|
|
|
{ |
897
|
68
|
|
|
|
|
2081
|
my $params = $self->_io_compress_params( $opts ); |
898
|
68
|
|
|
|
|
574
|
my $filters = $FILTER_MAP->{decode}; |
899
|
68
|
50
|
|
|
|
471
|
return( $self->error( "Unknown decoding \"$dec\"." ) ) if( !exists( $filters->{ $dec } ) ); |
900
|
68
|
|
|
|
|
1406
|
my( $rv, $err ) = $filters->{ $dec }->( $self->_normalise( $src ) => "$tempfile", %$params ); |
901
|
68
|
|
|
|
|
855
|
my $size = $self->_get_size( $src ); |
902
|
68
|
100
|
|
|
|
472
|
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
|
|
|
1654
|
$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
|
|
|
|
|
376346
|
my $len; |
933
|
79
|
100
|
33
|
|
|
1464
|
if( ref( $_[1] ) eq 'CODE' ) |
|
|
100
|
33
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
934
|
|
|
|
|
|
|
{ |
935
|
4
|
|
|
|
|
29
|
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
|
|
|
|
36
|
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
|
|
|
|
|
80
|
$len = $io->read( $buf, $tempfile->length ); |
946
|
4
|
50
|
|
|
|
147859
|
return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) ); |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
# try-catch |
950
|
4
|
|
|
|
|
502
|
local $@; |
951
|
|
|
|
|
|
|
eval |
952
|
4
|
|
|
|
|
17
|
{ |
953
|
4
|
|
|
|
|
49
|
$_[1]->( $buf ); |
954
|
|
|
|
|
|
|
}; |
955
|
4
|
50
|
|
|
|
4613
|
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
|
|
|
|
760
|
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
|
|
|
|
|
256
|
$len = $io->read( ${$_[1]}, $tempfile->length ); |
|
61
|
|
|
|
|
951
|
|
975
|
61
|
50
|
|
|
|
2264420
|
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
|
|
|
|
|
16
|
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
|
|
|
|
56
|
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
|
|
|
|
|
16
|
my $chunklen; |
993
|
4
|
|
|
|
|
35
|
while( $chunklen = $io->read( $buf, 10240 ) ) |
994
|
|
|
|
|
|
|
{ |
995
|
4
|
|
|
|
|
555
|
$len += $chunklen; |
996
|
|
|
|
|
|
|
#my $rv = CORE::print( $_[1], $buf ); |
997
|
4
|
|
|
|
|
32
|
my $rv = $_[1]->print( $buf ); |
998
|
4
|
50
|
|
|
|
618
|
return( $self->error( "Unable to print ", CORE::length( $buf ), " bytes of data to provided file handle '", $_[1], "': $!" ) ) if( !$rv ); |
999
|
|
|
|
|
|
|
} |
1000
|
4
|
50
|
|
|
|
368
|
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
|
|
|
493
|
my $f = $self->new_file( $_[1] ) || return( $self->pass_error ); |
1011
|
6
|
|
|
|
|
773989
|
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
|
|
|
|
94
|
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
|
|
|
|
|
144
|
$len = $io->read( $buf, $tempfile->length ); |
1022
|
6
|
50
|
|
|
|
225426
|
return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) ); |
1023
|
|
|
|
|
|
|
} |
1024
|
6
|
50
|
|
|
|
891
|
my $mode = $opts->{mode} ? $opts->{mode} : '>'; |
1025
|
6
|
|
|
|
|
35
|
my $params = {}; |
1026
|
6
|
50
|
|
|
|
108
|
$params->{binmode} = $opts->{binmode} if( $opts->{binmode} ); |
1027
|
6
|
50
|
|
|
|
61
|
$params->{autoflush} = $opts->{autoflush} if( $opts->{autoflush} ); |
1028
|
6
|
50
|
|
|
|
100
|
$f->open( $mode, $params ) || |
1029
|
|
|
|
|
|
|
return( $self->pass_error( $f->error ) ); |
1030
|
6
|
50
|
|
|
|
264586
|
$f->print( $buf ) || return( $self->pass_error( $f->error ) ); |
1031
|
6
|
|
|
|
|
7480
|
$f->close; |
1032
|
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
# A regular string |
1034
|
|
|
|
|
|
|
else |
1035
|
|
|
|
|
|
|
{ |
1036
|
4
|
50
|
|
|
|
209
|
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
|
|
|
|
147437
|
return( $self->error( "Unable to read bytes from source: $!" ) ) if( !defined( $len ) ); |
1050
|
|
|
|
|
|
|
} |
1051
|
|
|
|
|
|
|
} |
1052
|
79
|
|
|
|
|
41657
|
return( $len ); |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
|
1055
|
247
|
|
|
247
|
1
|
1137
|
sub source { return( shift->_set_get_scalar( 'source', @_ ) ); } |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
sub suffix2encoding |
1058
|
|
|
|
|
|
|
{ |
1059
|
16
|
|
|
16
|
1
|
7260
|
my $self = shift( @_ ); |
1060
|
16
|
|
50
|
|
|
73
|
my $file = shift( @_ ) || return( $self->pass_error( "No file was provided to guess encoding." ) ); |
1061
|
16
|
|
|
|
|
51
|
my @parts = reverse( split( /\./, $file ) ); |
1062
|
16
|
100
|
66
|
|
|
64
|
unless( defined( $SUFFIX_ENCODING ) && %$SUFFIX_ENCODING ) |
1063
|
|
|
|
|
|
|
{ |
1064
|
1
|
|
|
|
|
10
|
my @keys = keys( %$ENCODING_SUFFIX ); |
1065
|
1
|
|
|
|
|
8
|
my @vals = @$ENCODING_SUFFIX{ @keys }; |
1066
|
1
|
|
|
|
|
2
|
$SUFFIX_ENCODING = {}; |
1067
|
1
|
|
|
|
|
12
|
@$SUFFIX_ENCODING{ @vals } = @keys; |
1068
|
|
|
|
|
|
|
} |
1069
|
16
|
|
|
|
|
50
|
my $encs = $self->new_array; |
1070
|
16
|
|
|
|
|
11753
|
foreach( @parts ) |
1071
|
|
|
|
|
|
|
{ |
1072
|
32
|
100
|
|
|
|
175
|
if( exists( $SUFFIX_ENCODING->{ $_ } ) ) |
1073
|
|
|
|
|
|
|
{ |
1074
|
16
|
|
|
|
|
79
|
$encs->push( $SUFFIX_ENCODING->{ $_ } ); |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
else |
1077
|
|
|
|
|
|
|
{ |
1078
|
16
|
|
|
|
|
26
|
last; |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
} |
1081
|
16
|
|
|
|
|
35
|
return( $encs->reverse ); |
1082
|
|
|
|
|
|
|
} |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
sub supported |
1085
|
|
|
|
|
|
|
{ |
1086
|
2
|
|
|
2
|
1
|
16
|
my $self = shift( @_ ); |
1087
|
2
|
50
|
33
|
|
|
53
|
return( $self->error( "No encoding was provided to check if it exists." ) ) if( !@_ || !defined( $_[0] ) || !length( $_[0] ) ); |
|
|
|
33
|
|
|
|
|
1088
|
2
|
|
|
|
|
12
|
my $this = lc( shift( @_ ) ); |
1089
|
2
|
50
|
33
|
|
|
33
|
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
|
29437
|
my( $self ) = @_; |
1101
|
|
|
|
|
|
|
# No data was provided |
1102
|
20
|
50
|
33
|
|
|
385
|
return(0) if( !defined( $_[1] ) || !length( $_[1] ) ); |
1103
|
20
|
|
|
|
|
184
|
my $src = $self->source; |
1104
|
20
|
|
|
|
|
14928
|
my $enc = $self->encoding->lower; |
1105
|
20
|
|
|
|
|
12293
|
my $dec = $self->decoding->lower; |
1106
|
20
|
|
|
|
|
11273
|
my $type = lc( Scalar::Util::reftype( $_[1] ) ); |
1107
|
20
|
|
|
|
|
94
|
my $data; |
1108
|
|
|
|
|
|
|
my $size; |
1109
|
20
|
|
|
|
|
0
|
my $len; |
1110
|
20
|
100
|
|
|
|
177
|
if( $type eq 'code' ) |
1111
|
|
|
|
|
|
|
{ |
1112
|
|
|
|
|
|
|
# try-catch |
1113
|
4
|
|
|
|
|
24
|
local $@; |
1114
|
|
|
|
|
|
|
my $buf = eval |
1115
|
4
|
|
|
|
|
19
|
{ |
1116
|
4
|
|
|
|
|
24
|
$_[1]->() |
1117
|
|
|
|
|
|
|
}; |
1118
|
4
|
50
|
|
|
|
74
|
if( $@ ) |
1119
|
|
|
|
|
|
|
{ |
1120
|
0
|
|
|
|
|
0
|
return( $self->error( "Error getting data from callback: $@" ) ); |
1121
|
|
|
|
|
|
|
} |
1122
|
4
|
|
|
|
|
12
|
$data = \$buf; |
1123
|
4
|
|
|
|
|
41
|
$size = length( $$data ); |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
else |
1126
|
|
|
|
|
|
|
{ |
1127
|
16
|
|
|
|
|
186
|
$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
|
|
|
149211
|
if( !ref( $_[1] ) && |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
1133
|
|
|
|
|
|
|
( |
1134
|
|
|
|
|
|
|
( index( $_[1], "\n" ) == -1 && !-e( $_[1] ) ) || |
1135
|
|
|
|
|
|
|
( index( $_[1], "\n" ) != -1 ) |
1136
|
|
|
|
|
|
|
) ) |
1137
|
|
|
|
|
|
|
{ |
1138
|
4
|
|
|
|
|
31
|
$data = \$_[1]; |
1139
|
|
|
|
|
|
|
} |
1140
|
|
|
|
|
|
|
elsif( $type eq 'scalar' ) |
1141
|
|
|
|
|
|
|
{ |
1142
|
4
|
|
|
|
|
26
|
$data = $_[1]; |
1143
|
|
|
|
|
|
|
} |
1144
|
|
|
|
|
|
|
elsif( $self->_is_a( $_[1] => 'Module::Generic::File' ) || |
1145
|
|
|
|
|
|
|
$self->_can( $_[1] => 'filename' ) ) |
1146
|
|
|
|
|
|
|
{ |
1147
|
4
|
|
|
|
|
212
|
$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
|
|
|
|
|
368
|
$data = $_[1]; |
1154
|
4
|
50
|
33
|
|
|
62
|
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
|
|
|
|
170
|
if( !ref( $data ) ) |
1162
|
|
|
|
|
|
|
{ |
1163
|
4
|
|
|
|
|
27
|
my $f = $self->new_file( $data ); |
1164
|
4
|
|
50
|
|
|
518975
|
$data = $f->open( '<', { binmode => 'raw' } ) || |
1165
|
|
|
|
|
|
|
return( $self->pass_error( $f->error ) ); |
1166
|
|
|
|
|
|
|
} |
1167
|
|
|
|
|
|
|
} |
1168
|
|
|
|
|
|
|
|
1169
|
20
|
|
|
|
|
34275
|
my $stype = lc( Scalar::Util::reftype( $src ) ); |
1170
|
20
|
50
|
|
|
|
118
|
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
|
|
|
|
|
114
|
my $filters; |
1262
|
20
|
50
|
|
|
|
124
|
if( $dec ) |
|
|
50
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
{ |
1264
|
0
|
|
|
|
|
0
|
$filters = $FILTER_MAP->{decode}; |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
elsif( $enc ) |
1267
|
|
|
|
|
|
|
{ |
1268
|
20
|
|
|
|
|
550
|
$filters = $FILTER_MAP->{encode}; |
1269
|
|
|
|
|
|
|
} |
1270
|
|
|
|
|
|
|
|
1271
|
20
|
|
|
|
|
71
|
my $rv; |
1272
|
20
|
50
|
|
|
|
74
|
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
|
|
|
|
|
676
|
my $params = $self->_io_compress_params; |
1292
|
20
|
50
|
|
|
|
130
|
return( $self->error( "No encoding found for \"$enc\"." ) ) if( !exists( $filters->{ $enc } ) ); |
1293
|
|
|
|
|
|
|
# try-catch |
1294
|
20
|
|
|
|
|
249
|
local $@; |
1295
|
|
|
|
|
|
|
( $rv, my $err ) = eval |
1296
|
20
|
|
|
|
|
65
|
{ |
1297
|
20
|
|
|
|
|
139
|
$filters->{ $enc }->( $data => $src, %$params ); |
1298
|
|
|
|
|
|
|
}; |
1299
|
20
|
50
|
|
|
|
99
|
if( $@ ) |
1300
|
|
|
|
|
|
|
{ |
1301
|
0
|
0
|
|
|
|
0
|
return( $self->error( "Error ", ( $self->encode ? 'encoding' : 'decoding' ), " $size bytes of data: $@" ) ); |
1302
|
|
|
|
|
|
|
} |
1303
|
20
|
50
|
|
|
|
79
|
return( $self->error( "Unable to encode data to write to source: $err" ) ) if( !defined( $rv ) ); |
1304
|
20
|
|
|
|
|
108
|
$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
|
|
|
|
|
123
|
return( $len ); |
1405
|
|
|
|
|
|
|
} |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
sub _decodable_encodable |
1408
|
|
|
|
|
|
|
{ |
1409
|
2
|
|
|
2
|
|
15
|
my $self = shift( @_ ); |
1410
|
|
|
|
|
|
|
# 1 for encodable, 0 for decodable |
1411
|
2
|
|
|
|
|
10
|
my $enc_or_dec = shift( @_ ); |
1412
|
2
|
|
50
|
|
|
9
|
my $what = shift( @_ ) || 'all'; |
1413
|
2
|
|
|
|
|
44
|
my $list = $self->new_array; |
1414
|
2
|
50
|
|
|
|
71
|
my $offset = $enc_or_dec ? 0 : 1; |
1415
|
2
|
50
|
33
|
|
|
21
|
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
|
|
|
|
|
94
|
foreach( keys( %$CLASSES ) ) |
1426
|
|
|
|
|
|
|
{ |
1427
|
46
|
100
|
|
|
|
250
|
$list->push( $_ ) if( $CLASSES->{ $_ }->[2] ); |
1428
|
|
|
|
|
|
|
} |
1429
|
|
|
|
|
|
|
} |
1430
|
|
|
|
|
|
|
else |
1431
|
|
|
|
|
|
|
{ |
1432
|
0
|
|
|
|
|
0
|
return( $self->error( "Unsupported keyword '$what' used." ) ); |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
|
1435
|
2
|
|
|
|
|
34
|
my $res = $self->new_array; |
1436
|
2
|
|
|
|
|
67
|
foreach my $enc ( @$list ) |
1437
|
|
|
|
|
|
|
{ |
1438
|
|
|
|
|
|
|
# inflate is just an alias for deflate |
1439
|
18
|
100
|
100
|
|
|
154
|
next if( $enc eq 'inflate' || $enc eq 'rawinflate' || substr( $enc, 0, 2 ) eq 'x-' ); |
|
|
|
100
|
|
|
|
|
1440
|
10
|
50
|
|
|
|
40
|
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
|
|
|
|
|
36
|
my $encoder_class = $CLASSES->{ $enc }->[$offset]; |
1446
|
10
|
50
|
|
|
|
21
|
my $is_installed_method = ( $enc_or_dec ? 'is_encoder_installed' : 'is_decoder_installed' ); |
1447
|
10
|
50
|
|
|
|
323
|
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
|
|
|
|
|
1309
|
$res->push( $enc ); |
1454
|
|
|
|
|
|
|
} |
1455
|
|
|
|
|
|
|
} |
1456
|
2
|
|
|
|
|
20
|
return( $res ); |
1457
|
|
|
|
|
|
|
} |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
sub _get_size |
1460
|
|
|
|
|
|
|
{ |
1461
|
121
|
|
|
121
|
|
461
|
my $self = shift( @_ ); |
1462
|
121
|
100
|
66
|
|
|
2142
|
if( ref( $_[0] ) ) |
|
|
100
|
33
|
|
|
|
|
1463
|
|
|
|
|
|
|
{ |
1464
|
87
|
|
|
|
|
762
|
my $type = lc( Scalar::Util::reftype( $_[0] ) ); |
1465
|
87
|
100
|
|
|
|
519
|
if( $type eq 'scalar' ) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
{ |
1467
|
71
|
|
|
|
|
183
|
return( length( ${$_[0]} ) ); |
|
71
|
|
|
|
|
418
|
|
1468
|
|
|
|
|
|
|
} |
1469
|
|
|
|
|
|
|
elsif( $type eq 'glob' ) |
1470
|
|
|
|
|
|
|
{ |
1471
|
12
|
100
|
33
|
|
|
48
|
if( $self->_is_a( $_[0] => 'Module::Generic::Scalar::IO' ) ) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
{ |
1473
|
8
|
|
|
|
|
404
|
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
|
|
|
|
|
409
|
return( -s( $_[0] ) ); |
1482
|
|
|
|
|
|
|
} |
1483
|
|
|
|
|
|
|
} |
1484
|
|
|
|
|
|
|
elsif( $self->_is_a( $_[0] => 'Module::Generic::File' ) ) |
1485
|
|
|
|
|
|
|
{ |
1486
|
4
|
|
|
|
|
248
|
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
|
|
|
|
|
26
|
return( length( $_[0] ) ); |
1501
|
|
|
|
|
|
|
} |
1502
|
|
|
|
|
|
|
else |
1503
|
|
|
|
|
|
|
{ |
1504
|
30
|
|
|
|
|
371
|
return( -s( $_[0] ) ); |
1505
|
|
|
|
|
|
|
} |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
sub _io_compress_params |
1509
|
|
|
|
|
|
|
{ |
1510
|
125
|
|
|
125
|
|
502
|
my $self = shift( @_ ); |
1511
|
125
|
|
|
|
|
404
|
my $opts = {}; |
1512
|
125
|
|
|
|
|
1109
|
my $ref = $self->compress_params; |
1513
|
125
|
100
|
|
|
|
324150
|
if( @_ ) |
1514
|
|
|
|
|
|
|
{ |
1515
|
105
|
|
|
|
|
367
|
$opts = shift( @_ ); |
1516
|
105
|
|
|
|
|
1857
|
my @keys = grep( /^[A-Z]\w+$/, keys( %$opts ) ); |
1517
|
105
|
100
|
|
|
|
838
|
@$ref{ @keys } = @$opts{ @keys } if( scalar( @keys ) ); |
1518
|
|
|
|
|
|
|
} |
1519
|
125
|
|
|
|
|
828
|
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
|
|
458
|
my $self = shift( @_ ); |
1530
|
81
|
100
|
|
|
|
646
|
if( ref( $_[0] ) ) |
1531
|
|
|
|
|
|
|
{ |
1532
|
59
|
|
|
|
|
593
|
my $type = lc( Scalar::Util::reftype( $_[0] ) ); |
1533
|
59
|
50
|
0
|
|
|
436
|
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
|
|
|
|
313
|
if( $self->_is_object( $_[0] ) ) |
1538
|
|
|
|
|
|
|
{ |
1539
|
39
|
|
|
|
|
463
|
my $tmp = ${$_[0]}; |
|
39
|
|
|
|
|
246
|
|
1540
|
39
|
|
|
|
|
600
|
return( \$tmp ); |
1541
|
|
|
|
|
|
|
} |
1542
|
|
|
|
|
|
|
else |
1543
|
|
|
|
|
|
|
{ |
1544
|
20
|
|
|
|
|
300
|
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
|
|
|
|
|
267
|
return( $_[0] ); |
1563
|
|
|
|
|
|
|
} |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
# NOTE: sub FREEZE is inherited |
1567
|
|
|
|
|
|
|
|
1568
|
1
|
|
|
1
|
0
|
75
|
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); } |
1569
|
|
|
|
|
|
|
|
1570
|
1
|
|
|
1
|
0
|
162
|
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
|
|
144
|
use strict; |
|
14
|
|
|
|
|
58
|
|
|
14
|
|
|
|
|
512
|
|
1581
|
14
|
|
|
14
|
|
98
|
use warnings; |
|
14
|
|
|
|
|
36
|
|
|
14
|
|
|
|
|
574
|
|
1582
|
14
|
|
|
14
|
|
97
|
use parent qw( Module::Generic ); |
|
14
|
|
|
|
|
40
|
|
|
14
|
|
|
|
|
126
|
|
1583
|
14
|
|
|
14
|
|
1251
|
use vars qw( $VERSION $EXCEPTION_CLASS ); |
|
14
|
|
|
|
|
60
|
|
|
14
|
|
|
|
|
978
|
|
1584
|
14
|
|
|
14
|
|
2500
|
use Module::Generic::File::IO; |
|
14
|
|
|
|
|
15989
|
|
|
14
|
|
|
|
|
227
|
|
1585
|
14
|
|
|
14
|
|
9857
|
use Module::Generic::Scalar::IO; |
|
14
|
|
|
|
|
39198
|
|
|
14
|
|
|
|
|
251
|
|
1586
|
|
|
|
|
|
|
# use Nice::Try; |
1587
|
14
|
|
|
14
|
|
1100
|
our $EXCEPTION_CLASS = 'HTTP::Promise::Exception'; |
1588
|
14
|
|
|
|
|
565
|
our $VERSION = $HTTP::Promise::Stream::VERSION; |
1589
|
|
|
|
|
|
|
}; |
1590
|
|
|
|
|
|
|
|
1591
|
14
|
|
|
14
|
|
111
|
use strict; |
|
14
|
|
|
|
|
35
|
|
|
14
|
|
|
|
|
302
|
|
1592
|
14
|
|
|
14
|
|
75
|
use warnings; |
|
14
|
|
|
|
|
55
|
|
|
14
|
|
|
|
|
879
|
|
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
sub init |
1595
|
|
|
|
|
|
|
{ |
1596
|
30
|
|
|
30
|
|
2422627
|
my $self = shift( @_ ); |
1597
|
30
|
|
33
|
|
|
234
|
my $class = ( ref( $self ) || $self ); |
1598
|
30
|
|
|
|
|
1142
|
$self->{_init_strict_use_sub} = 1; |
1599
|
14
|
|
|
14
|
|
114
|
no strict 'refs'; |
|
14
|
|
|
|
|
34
|
|
|
14
|
|
|
|
|
16602
|
|
1600
|
30
|
50
|
|
|
|
82
|
$self->{_exception_class} = defined( ${"${class}\::EXCEPTION_CLASS"} ) ? ${"${class}\::EXCEPTION_CLASS"} : $EXCEPTION_CLASS; |
|
30
|
|
|
|
|
321
|
|
|
30
|
|
|
|
|
361
|
|
1601
|
30
|
50
|
|
|
|
319
|
$self->SUPER::init( @_ ) || return( $self->pass_error ); |
1602
|
30
|
|
|
|
|
2670
|
return( $self ); |
1603
|
|
|
|
|
|
|
} |
1604
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
sub _get_glob_from_arg |
1606
|
|
|
|
|
|
|
{ |
1607
|
58
|
|
|
58
|
|
175
|
my $self = shift( @_ ); |
1608
|
58
|
|
|
|
|
130
|
my $this = shift( @_ ); |
1609
|
58
|
50
|
66
|
|
|
882
|
return( $self->error( "No argument was provided." ) ) if( !defined( $this ) || ( !ref( $this ) && !length( $this ) ) ); |
|
|
|
66
|
|
|
|
|
1610
|
58
|
|
|
|
|
256
|
my $opts = $self->_get_args_as_hash( @_ ); |
1611
|
58
|
100
|
|
|
|
5406
|
$opts->{write} = 0 if( !exists( $opts->{write} ) ); |
1612
|
58
|
100
|
|
|
|
465
|
my $mode = $opts->{write} ? '+>' : '<'; |
1613
|
58
|
|
|
|
|
187
|
my $fh; |
1614
|
58
|
|
|
|
|
117
|
my $is_native_glob = 0; |
1615
|
58
|
100
|
|
|
|
456
|
if( $self->_is_glob( $this ) ) |
|
|
100
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
{ |
1617
|
3
|
|
|
|
|
62
|
$fh = $this; |
1618
|
|
|
|
|
|
|
# even if this is a scalar reference opened in memory, perl will return -1, which is true |
1619
|
3
|
50
|
|
|
|
24
|
$is_native_glob++ if( fileno( $this ) ); |
1620
|
|
|
|
|
|
|
} |
1621
|
|
|
|
|
|
|
elsif( $self->_is_scalar( $this ) ) |
1622
|
|
|
|
|
|
|
{ |
1623
|
29
|
|
50
|
|
|
2102
|
$fh = Module::Generic::Scalar::IO->new( $this, $mode ) || |
1624
|
|
|
|
|
|
|
return( $self->pass_error( Module::Generic::Scalar::IO->error ) ); |
1625
|
29
|
|
|
|
|
26823
|
$is_native_glob++; |
1626
|
|
|
|
|
|
|
} |
1627
|
|
|
|
|
|
|
else |
1628
|
|
|
|
|
|
|
{ |
1629
|
26
|
|
50
|
|
|
1137
|
my $f = $self->new_file( "$this" ) || return( $self->pass_error ); |
1630
|
26
|
50
|
66
|
|
|
3389862
|
return( $self->error( "File '$this' does not exist." ) ) if( !$f->exists && !$opts->{write} ); |
1631
|
26
|
|
50
|
|
|
3175
|
$fh = $f->open( $mode, { binmode => 'raw', ( $opts->{write} ? ( autoflush => 1 ) : () ) } ) || |
1632
|
|
|
|
|
|
|
return( $self->pass_error( $f->error ) ); |
1633
|
26
|
|
|
|
|
972460
|
$is_native_glob++; |
1634
|
|
|
|
|
|
|
} |
1635
|
58
|
|
|
|
|
88063
|
my $flags; |
1636
|
58
|
50
|
|
|
|
931
|
if( $self->_can( $fh => 'fcntl' ) ) |
1637
|
|
|
|
|
|
|
{ |
1638
|
58
|
|
|
|
|
3433
|
$flags = $fh->fcntl( F_GETFL, 0 ); |
1639
|
|
|
|
|
|
|
} |
1640
|
|
|
|
|
|
|
else |
1641
|
|
|
|
|
|
|
{ |
1642
|
0
|
|
|
|
|
0
|
$flags = fcntl( $fh, F_GETFL, 0 ); |
1643
|
|
|
|
|
|
|
} |
1644
|
|
|
|
|
|
|
|
1645
|
58
|
50
|
|
|
|
2430
|
if( defined( $flags ) ) |
1646
|
|
|
|
|
|
|
{ |
1647
|
58
|
100
|
|
|
|
404
|
if( $opts->{write} ) |
1648
|
|
|
|
|
|
|
{ |
1649
|
29
|
50
|
|
|
|
361
|
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
|
|
|
266
|
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
|
|
|
|
|
176
|
my $op; |
1668
|
|
|
|
|
|
|
my $meth; |
1669
|
58
|
100
|
|
|
|
230
|
if( $opts->{write} ) |
1670
|
|
|
|
|
|
|
{ |
1671
|
29
|
50
|
0
|
|
|
192
|
if( $is_native_glob ) |
|
|
0
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
{ |
1673
|
|
|
|
|
|
|
$op = sub |
1674
|
|
|
|
|
|
|
{ |
1675
|
357
|
|
|
357
|
|
6011
|
my $rv = print( $fh @_ ); |
1676
|
357
|
50
|
|
|
|
1066
|
return( $self->error( "Error writing ", CORE::length( $_[0] ), " bytes of data to output: $!" ) ) if( !defined( $rv ) ); |
1677
|
357
|
|
|
|
|
1185
|
return( $rv ); |
1678
|
29
|
|
|
|
|
655
|
}; |
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
|
|
|
|
122
|
if( $is_native_glob ) |
|
|
0
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
{ |
1723
|
|
|
|
|
|
|
$op = sub |
1724
|
|
|
|
|
|
|
{ |
1725
|
351
|
|
|
351
|
|
1472
|
my $n = read( $fh, $_[0], $_[1] ); |
1726
|
351
|
50
|
|
|
|
725
|
return( $self->error( "Error reading ", $_[1], " bytes of data from input: $!" ) ) if( !defined( $n ) ); |
1727
|
351
|
|
|
|
|
859
|
return( $n ); |
1728
|
29
|
|
|
|
|
522
|
}; |
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
|
|
|
|
|
1050
|
return( $fh, $op ); |
1770
|
|
|
|
|
|
|
} |
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
# NOTE: sub FREEZE is inherited |
1773
|
|
|
|
|
|
|
|
1774
|
4
|
|
|
4
|
|
261
|
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); } |
1775
|
|
|
|
|
|
|
|
1776
|
4
|
|
|
4
|
|
682
|
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 |