← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:20 2013

Filename/usr/lib/perl/5.10/IO/Uncompress/Base.pm
StatementsExecuted 71 statements in 8.58ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
66131µs31µsIO::Uncompress::Base::::_notAvailableIO::Uncompress::Base::_notAvailable
11125µs29µsIO::Uncompress::Base::::BEGIN@4IO::Uncompress::Base::BEGIN@4
11124µs285µsIO::Uncompress::Base::::BEGIN@17IO::Uncompress::Base::BEGIN@17
11122µs60µsIO::Uncompress::Base::::BEGIN@94IO::Uncompress::Base::BEGIN@94
11120µs73µsIO::Uncompress::Base::::BEGIN@413IO::Uncompress::Base::BEGIN@413
11119µs135µsIO::Uncompress::Base::::BEGIN@23IO::Uncompress::Base::BEGIN@23
11117µs84µsIO::Uncompress::Base::::BEGIN@22IO::Uncompress::Base::BEGIN@22
11116µs21µsIO::Uncompress::Base::::BEGIN@6IO::Uncompress::Base::BEGIN@6
11116µs317µsIO::Uncompress::Base::::BEGIN@20IO::Uncompress::Base::BEGIN@20
11116µs78µsIO::Uncompress::Base::::BEGIN@21IO::Uncompress::Base::BEGIN@21
11114µs90µsIO::Uncompress::Base::::BEGIN@14IO::Uncompress::Base::BEGIN@14
11114µs27µsIO::Uncompress::Base::::BEGIN@5IO::Uncompress::Base::BEGIN@5
11111µs59µsIO::Uncompress::Base::::BEGIN@24IO::Uncompress::Base::BEGIN@24
11110µs67µsIO::Uncompress::Base::::BEGIN@15IO::Uncompress::Base::BEGIN@15
0000s0sIO::Uncompress::Base::::DESTROYIO::Uncompress::Base::DESTROY
0000s0sIO::Uncompress::Base::::HeaderErrorIO::Uncompress::Base::HeaderError
0000s0sIO::Uncompress::Base::::READLINEIO::Uncompress::Base::READLINE
0000s0sIO::Uncompress::Base::::TIEHANDLEIO::Uncompress::Base::TIEHANDLE
0000s0sIO::Uncompress::Base::::TrailerErrorIO::Uncompress::Base::TrailerError
0000s0sIO::Uncompress::Base::::TruncatedHeaderIO::Uncompress::Base::TruncatedHeader
0000s0sIO::Uncompress::Base::::TruncatedTrailerIO::Uncompress::Base::TruncatedTrailer
0000s0sIO::Uncompress::Base::::UNTIEIO::Uncompress::Base::UNTIE
0000s0sIO::Uncompress::Base::::__ANON__[:1405]IO::Uncompress::Base::__ANON__[:1405]
0000s0sIO::Uncompress::Base::::_createIO::Uncompress::Base::_create
0000s0sIO::Uncompress::Base::::_getlineIO::Uncompress::Base::_getline
0000s0sIO::Uncompress::Base::::_infIO::Uncompress::Base::_inf
0000s0sIO::Uncompress::Base::::_raw_readIO::Uncompress::Base::_raw_read
0000s0sIO::Uncompress::Base::::_rd2IO::Uncompress::Base::_rd2
0000s0sIO::Uncompress::Base::::_singleTargetIO::Uncompress::Base::_singleTarget
0000s0sIO::Uncompress::Base::::autoflushIO::Uncompress::Base::autoflush
0000s0sIO::Uncompress::Base::::binmodeIO::Uncompress::Base::binmode
0000s0sIO::Uncompress::Base::::checkParamsIO::Uncompress::Base::checkParams
0000s0sIO::Uncompress::Base::::ckInputParamIO::Uncompress::Base::ckInputParam
0000s0sIO::Uncompress::Base::::clearErrorIO::Uncompress::Base::clearError
0000s0sIO::Uncompress::Base::::closeIO::Uncompress::Base::close
0000s0sIO::Uncompress::Base::::closeErrorIO::Uncompress::Base::closeError
0000s0sIO::Uncompress::Base::::croakErrorIO::Uncompress::Base::croakError
0000s0sIO::Uncompress::Base::::eofIO::Uncompress::Base::eof
0000s0sIO::Uncompress::Base::::errorIO::Uncompress::Base::error
0000s0sIO::Uncompress::Base::::errorNoIO::Uncompress::Base::errorNo
0000s0sIO::Uncompress::Base::::filenoIO::Uncompress::Base::fileno
0000s0sIO::Uncompress::Base::::filterUncompressedIO::Uncompress::Base::filterUncompressed
0000s0sIO::Uncompress::Base::::getErrInfoIO::Uncompress::Base::getErrInfo
0000s0sIO::Uncompress::Base::::getHeaderInfoIO::Uncompress::Base::getHeaderInfo
0000s0sIO::Uncompress::Base::::getcIO::Uncompress::Base::getc
0000s0sIO::Uncompress::Base::::getlineIO::Uncompress::Base::getline
0000s0sIO::Uncompress::Base::::getlinesIO::Uncompress::Base::getlines
0000s0sIO::Uncompress::Base::::gotoNextStreamIO::Uncompress::Base::gotoNextStream
0000s0sIO::Uncompress::Base::::input_line_numberIO::Uncompress::Base::input_line_number
0000s0sIO::Uncompress::Base::::nextStreamIO::Uncompress::Base::nextStream
0000s0sIO::Uncompress::Base::::openedIO::Uncompress::Base::opened
0000s0sIO::Uncompress::Base::::postBlockChkIO::Uncompress::Base::postBlockChk
0000s0sIO::Uncompress::Base::::postCheckParamsIO::Uncompress::Base::postCheckParams
0000s0sIO::Uncompress::Base::::pushBackIO::Uncompress::Base::pushBack
0000s0sIO::Uncompress::Base::::readIO::Uncompress::Base::read
0000s0sIO::Uncompress::Base::::readBlockIO::Uncompress::Base::readBlock
0000s0sIO::Uncompress::Base::::resetIO::Uncompress::Base::reset
0000s0sIO::Uncompress::Base::::retErrIO::Uncompress::Base::retErr
0000s0sIO::Uncompress::Base::::saveErrorStringIO::Uncompress::Base::saveErrorString
0000s0sIO::Uncompress::Base::::saveStatusIO::Uncompress::Base::saveStatus
0000s0sIO::Uncompress::Base::::seekIO::Uncompress::Base::seek
0000s0sIO::Uncompress::Base::::setErrInfoIO::Uncompress::Base::setErrInfo
0000s0sIO::Uncompress::Base::::smartEofIO::Uncompress::Base::smartEof
0000s0sIO::Uncompress::Base::::smartReadIO::Uncompress::Base::smartRead
0000s0sIO::Uncompress::Base::::smartReadExactIO::Uncompress::Base::smartReadExact
0000s0sIO::Uncompress::Base::::smartSeekIO::Uncompress::Base::smartSeek
0000s0sIO::Uncompress::Base::::smartWriteIO::Uncompress::Base::smartWrite
0000s0sIO::Uncompress::Base::::streamCountIO::Uncompress::Base::streamCount
0000s0sIO::Uncompress::Base::::tellIO::Uncompress::Base::tell
0000s0sIO::Uncompress::Base::::trailingDataIO::Uncompress::Base::trailingData
0000s0sIO::Uncompress::Base::::ungetcIO::Uncompress::Base::ungetc
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1
2package IO::Uncompress::Base ;
3
4330µs234µs
# spent 29µs (25+5) within IO::Uncompress::Base::BEGIN@4 which was called: # once (25µs+5µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 4
use strict ;
# spent 29µs making 1 call to IO::Uncompress::Base::BEGIN@4 # spent 4µs making 1 call to strict::import
5331µs239µs
# spent 27µs (14+13) within IO::Uncompress::Base::BEGIN@5 which was called: # once (14µs+13µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 5
use warnings;
# spent 27µs making 1 call to IO::Uncompress::Base::BEGIN@5 # spent 13µs making 1 call to warnings::import
63116µs226µs
# spent 21µs (16+5) within IO::Uncompress::Base::BEGIN@6 which was called: # once (16µs+5µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 6
use bytes;
# spent 21µs making 1 call to IO::Uncompress::Base::BEGIN@6 # spent 5µs making 1 call to bytes::import
7
812µsour (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
9127µs@ISA = qw(Exporter IO::File);
10
11
121600ns$VERSION = '2.020';
13
14342µs2165µs
# spent 90µs (14+75) within IO::Uncompress::Base::BEGIN@14 which was called: # once (14µs+75µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 14
use constant G_EOF => 0 ;
# spent 90µs making 1 call to IO::Uncompress::Base::BEGIN@14 # spent 75µs making 1 call to constant::import
15340µs2125µs
# spent 67µs (10+58) within IO::Uncompress::Base::BEGIN@15 which was called: # once (10µs+58µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 15
use constant G_ERR => -1 ;
# spent 67µs making 1 call to IO::Uncompress::Base::BEGIN@15 # spent 58µs making 1 call to constant::import
16
17377µs3546µs
# spent 285µs (24+261) within IO::Uncompress::Base::BEGIN@17 which was called: # once (24µs+261µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 17
use IO::Compress::Base::Common 2.020 ;
# spent 285µs making 1 call to IO::Uncompress::Base::BEGIN@17 # spent 246µs making 1 call to Exporter::import # spent 15µs making 1 call to UNIVERSAL::VERSION
18#use Parse::Parameters ;
19
20336µs2617µs
# spent 317µs (16+300) within IO::Uncompress::Base::BEGIN@20 which was called: # once (16µs+300µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 20
use IO::File ;
# spent 317µs making 1 call to IO::Uncompress::Base::BEGIN@20 # spent 300µs making 1 call to Exporter::import
21356µs2141µs
# spent 78µs (16+63) within IO::Uncompress::Base::BEGIN@21 which was called: # once (16µs+63µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 21
use Symbol;
# spent 78µs making 1 call to IO::Uncompress::Base::BEGIN@21 # spent 63µs making 1 call to Exporter::import
22341µs2151µs
# spent 84µs (17+67) within IO::Uncompress::Base::BEGIN@22 which was called: # once (17µs+67µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 22
use Scalar::Util qw(readonly);
# spent 84µs making 1 call to IO::Uncompress::Base::BEGIN@22 # spent 67µs making 1 call to Exporter::import
23348µs2251µs
# spent 135µs (19+116) within IO::Uncompress::Base::BEGIN@23 which was called: # once (19µs+116µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 23
use List::Util qw(min);
# spent 135µs making 1 call to IO::Uncompress::Base::BEGIN@23 # spent 116µs making 1 call to Exporter::import
243446µs2108µs
# spent 59µs (11+48) within IO::Uncompress::Base::BEGIN@24 which was called: # once (11µs+48µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 24
use Carp ;
# spent 59µs making 1 call to IO::Uncompress::Base::BEGIN@24 # spent 48µs making 1 call to Exporter::import
25
261900ns%EXPORT_TAGS = ( );
2713µspush @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
28#Exporter::export_ok_tags('all') ;
29
- -
32sub smartRead
33{
34 my $self = $_[0];
35 my $out = $_[1];
36 my $size = $_[2];
37 $$out = "" ;
38
39 my $offset = 0 ;
40
41
42 if (defined *$self->{InputLength}) {
43 return 0
44 if *$self->{InputLengthRemaining} <= 0 ;
45 $size = min($size, *$self->{InputLengthRemaining});
46 }
47
48 if ( length *$self->{Prime} ) {
49 #$$out = substr(*$self->{Prime}, 0, $size, '') ;
50 $$out = substr(*$self->{Prime}, 0, $size) ;
51 substr(*$self->{Prime}, 0, $size) = '' ;
52 if (length $$out == $size) {
53 *$self->{InputLengthRemaining} -= length $$out
54 if defined *$self->{InputLength};
55
56 return length $$out ;
57 }
58 $offset = length $$out ;
59 }
60
61 my $get_size = $size - $offset ;
62
63 if (defined *$self->{FH}) {
64 if ($offset) {
65 # Not using this
66 #
67 # *$self->{FH}->read($$out, $get_size, $offset);
68 #
69 # because the filehandle may not support the offset parameter
70 # An example is Net::FTP
71 my $tmp = '';
72 *$self->{FH}->read($tmp, $get_size) > 0 &&
73 (substr($$out, $offset) = $tmp);
74 }
75 else
76 { *$self->{FH}->read($$out, $get_size) }
77 }
78 elsif (defined *$self->{InputEvent}) {
79 my $got = 1 ;
80 while (length $$out < $size) {
81 last
82 if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0;
83 }
84
85 if (length $$out > $size ) {
86 #*$self->{Prime} = substr($$out, $size, length($$out), '');
87 *$self->{Prime} = substr($$out, $size, length($$out));
88 substr($$out, $size, length($$out)) = '';
89 }
90
91 *$self->{EventEof} = 1 if $got <= 0 ;
92 }
93 else {
9432.31ms297µs
# spent 60µs (22+37) within IO::Uncompress::Base::BEGIN@94 which was called: # once (22µs+37µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 94
no warnings 'uninitialized';
# spent 60µs making 1 call to IO::Uncompress::Base::BEGIN@94 # spent 37µs making 1 call to warnings::unimport
95 my $buf = *$self->{Buffer} ;
96 $$buf = '' unless defined $$buf ;
97 #$$out = '' unless defined $$out ;
98 substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
99 if (*$self->{ConsumeInput})
100 { substr($$buf, 0, $get_size) = '' }
101 else
102 { *$self->{BufferOffset} += length($$out) - $offset }
103 }
104
105 *$self->{InputLengthRemaining} -= length($$out) #- $offset
106 if defined *$self->{InputLength};
107
108 $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ;
109
110 return length $$out;
111}
112
113sub pushBack
114{
115 my $self = shift ;
116
117 return if ! defined $_[0] || length $_[0] == 0 ;
118
119 if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
120 *$self->{Prime} = $_[0] . *$self->{Prime} ;
121 *$self->{InputLengthRemaining} += length($_[0]);
122 }
123 else {
124 my $len = length $_[0];
125
126 if($len > *$self->{BufferOffset}) {
127 *$self->{Prime} = substr($_[0], 0, $len - *$self->{BufferOffset}) . *$self->{Prime} ;
128 *$self->{InputLengthRemaining} = *$self->{InputLength};
129 *$self->{BufferOffset} = 0
130 }
131 else {
132 *$self->{InputLengthRemaining} += length($_[0]);
133 *$self->{BufferOffset} -= length($_[0]) ;
134 }
135 }
136}
137
138sub smartSeek
139{
140 my $self = shift ;
141 my $offset = shift ;
142 my $truncate = shift;
143 #print "smartSeek to $offset\n";
144
145 # TODO -- need to take prime into account
146 if (defined *$self->{FH})
147 { *$self->{FH}->seek($offset, SEEK_SET) }
148 else {
149 *$self->{BufferOffset} = $offset ;
150 substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = ''
151 if $truncate;
152 return 1;
153 }
154}
155
156sub smartWrite
157{
158 my $self = shift ;
159 my $out_data = shift ;
160
161 if (defined *$self->{FH}) {
162 # flush needed for 5.8.0
163 defined *$self->{FH}->write($out_data, length $out_data) &&
164 defined *$self->{FH}->flush() ;
165 }
166 else {
167 my $buf = *$self->{Buffer} ;
168 substr($$buf, *$self->{BufferOffset}, length $out_data) = $out_data ;
169 *$self->{BufferOffset} += length($out_data) ;
170 return 1;
171 }
172}
173
174sub smartReadExact
175{
176 return $_[0]->smartRead($_[1], $_[2]) == $_[2];
177}
178
179sub smartEof
180{
181 my ($self) = $_[0];
182 local $.;
183
184 return 0 if length *$self->{Prime} || *$self->{PushMode};
185
186 if (defined *$self->{FH})
187 {
188 # Could use
189 #
190 # *$self->{FH}->eof()
191 #
192 # here, but this can cause trouble if
193 # the filehandle is itself a tied handle, but it uses sysread.
194 # Then we get into mixing buffered & non-buffered IO, which will cause trouble
195
196 my $info = $self->getErrInfo();
197
198 my $buffer = '';
199 my $status = $self->smartRead(\$buffer, 1);
200 $self->pushBack($buffer) if length $buffer;
201 $self->setErrInfo($info);
202
203 return $status == 0 ;
204 }
205 elsif (defined *$self->{InputEvent})
206 { *$self->{EventEof} }
207 else
208 { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) }
209}
210
211sub clearError
212{
213 my $self = shift ;
214
215 *$self->{ErrorNo} = 0 ;
216 ${ *$self->{Error} } = '' ;
217}
218
219sub getErrInfo
220{
221 my $self = shift ;
222
223 return [ *$self->{ErrorNo}, ${ *$self->{Error} } ] ;
224}
225
226sub setErrInfo
227{
228 my $self = shift ;
229 my $ref = shift;
230
231 *$self->{ErrorNo} = $ref->[0] ;
232 ${ *$self->{Error} } = $ref->[1] ;
233}
234
235sub saveStatus
236{
237 my $self = shift ;
238 my $errno = shift() + 0 ;
239 #return $errno unless $errno || ! defined *$self->{ErrorNo};
240 #return $errno unless $errno ;
241
242 *$self->{ErrorNo} = $errno;
243 ${ *$self->{Error} } = '' ;
244
245 return *$self->{ErrorNo} ;
246}
247
248
249sub saveErrorString
250{
251 my $self = shift ;
252 my $retval = shift ;
253
254 #return $retval if ${ *$self->{Error} };
255
256 ${ *$self->{Error} } = shift ;
257 *$self->{ErrorNo} = shift() + 0 if @_ ;
258
259 #warn "saveErrorString: " . ${ *$self->{Error} } . " " . *$self->{Error} . "\n" ;
260 return $retval;
261}
262
263sub croakError
264{
265 my $self = shift ;
266 $self->saveErrorString(0, $_[0]);
267 croak $_[0];
268}
269
270
271sub closeError
272{
273 my $self = shift ;
274 my $retval = shift ;
275
276 my $errno = *$self->{ErrorNo};
277 my $error = ${ *$self->{Error} };
278
279 $self->close();
280
281 *$self->{ErrorNo} = $errno ;
282 ${ *$self->{Error} } = $error ;
283
284 return $retval;
285}
286
287sub error
288{
289 my $self = shift ;
290 return ${ *$self->{Error} } ;
291}
292
293sub errorNo
294{
295 my $self = shift ;
296 return *$self->{ErrorNo};
297}
298
299sub HeaderError
300{
301 my ($self) = shift;
302 return $self->saveErrorString(undef, "Header Error: $_[0]", STATUS_ERROR);
303}
304
305sub TrailerError
306{
307 my ($self) = shift;
308 return $self->saveErrorString(G_ERR, "Trailer Error: $_[0]", STATUS_ERROR);
309}
310
311sub TruncatedHeader
312{
313 my ($self) = shift;
314 return $self->HeaderError("Truncated in $_[0] Section");
315}
316
317sub TruncatedTrailer
318{
319 my ($self) = shift;
320 return $self->TrailerError("Truncated in $_[0] Section");
321}
322
323sub postCheckParams
324{
325 return 1;
326}
327
328sub checkParams
329{
330 my $self = shift ;
331 my $class = shift ;
332
333 my $got = shift || IO::Compress::Base::Parameters::new();
334
335 my $Valid = {
336 'BlockSize' => [1, 1, Parse_unsigned, 16 * 1024],
337 'AutoClose' => [1, 1, Parse_boolean, 0],
338 'Strict' => [1, 1, Parse_boolean, 0],
339 'Append' => [1, 1, Parse_boolean, 0],
340 'Prime' => [1, 1, Parse_any, undef],
341 'MultiStream' => [1, 1, Parse_boolean, 0],
342 'Transparent' => [1, 1, Parse_any, 1],
343 'Scan' => [1, 1, Parse_boolean, 0],
344 'InputLength' => [1, 1, Parse_unsigned, undef],
345 'BinModeOut' => [1, 1, Parse_boolean, 0],
346 #'Encode' => [1, 1, Parse_any, undef],
347
348 #'ConsumeInput' => [1, 1, Parse_boolean, 0],
349
350 $self->getExtraParams(),
351
352 #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0,
353 # ContinueAfterEof
354 } ;
355
356 $Valid->{TrailingData} = [1, 1, Parse_writable_scalar, undef]
357 if *$self->{OneShot} ;
358
359 $got->parse($Valid, @_ )
360 or $self->croakError("${class}: $got->{Error}") ;
361
362 $self->postCheckParams($got)
363 or $self->croakError("${class}: " . $self->error()) ;
364
365 return $got;
366}
367
368sub _create
369{
370 my $obj = shift;
371 my $got = shift;
372 my $append_mode = shift ;
373
374 my $class = ref $obj;
375 $obj->croakError("$class: Missing Input parameter")
376 if ! @_ && ! $got ;
377
378 my $inValue = shift ;
379
380 *$obj->{OneShot} = 0 ;
381
382 if (! $got)
383 {
384 $got = $obj->checkParams($class, undef, @_)
385 or return undef ;
386 }
387
388 my $inType = whatIsInput($inValue, 1);
389
390 $obj->ckInputParam($class, $inValue, 1)
391 or return undef ;
392
393 *$obj->{InNew} = 1;
394
395 $obj->ckParams($got)
396 or $obj->croakError("${class}: " . *$obj->{Error});
397
398 if ($inType eq 'buffer' || $inType eq 'code') {
399 *$obj->{Buffer} = $inValue ;
400 *$obj->{InputEvent} = $inValue
401 if $inType eq 'code' ;
402 }
403 else {
404 if ($inType eq 'handle') {
405 *$obj->{FH} = $inValue ;
406 *$obj->{Handle} = 1 ;
407
408 # Need to rewind for Scan
409 *$obj->{FH}->seek(0, SEEK_SET)
410 if $got->value('Scan');
411 }
412 else {
41335.19ms2126µs
# spent 73µs (20+53) within IO::Uncompress::Base::BEGIN@413 which was called: # once (20µs+53µs) by IO::Uncompress::RawInflate::BEGIN@11 at line 413
no warnings ;
# spent 73µs making 1 call to IO::Uncompress::Base::BEGIN@413 # spent 53µs making 1 call to warnings::unimport
414 my $mode = '<';
415 $mode = '+<' if $got->value('Scan');
416 *$obj->{StdIO} = ($inValue eq '-');
417 *$obj->{FH} = new IO::File "$mode $inValue"
418 or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ;
419 }
420
421 *$obj->{LineNo} = $. = 0;
422 setBinModeInput(*$obj->{FH}) ;
423
424 my $buff = "" ;
425 *$obj->{Buffer} = \$buff ;
426 }
427
428 if ($got->parsed('Encode')) {
429 my $want_encoding = $got->value('Encode');
430 *$obj->{Encoding} = getEncoding($obj, $class, $want_encoding);
431 }
432
433
434 *$obj->{InputLength} = $got->parsed('InputLength')
435 ? $got->value('InputLength')
436 : undef ;
437 *$obj->{InputLengthRemaining} = $got->value('InputLength');
438 *$obj->{BufferOffset} = 0 ;
439 *$obj->{AutoClose} = $got->value('AutoClose');
440 *$obj->{Strict} = $got->value('Strict');
441 *$obj->{BlockSize} = $got->value('BlockSize');
442 *$obj->{Append} = $got->value('Append');
443 *$obj->{AppendOutput} = $append_mode || $got->value('Append');
444 *$obj->{ConsumeInput} = $got->value('ConsumeInput');
445 *$obj->{Transparent} = $got->value('Transparent');
446 *$obj->{MultiStream} = $got->value('MultiStream');
447
448 # TODO - move these two into RawDeflate
449 *$obj->{Scan} = $got->value('Scan');
450 *$obj->{ParseExtra} = $got->value('ParseExtra')
451 || $got->value('Strict') ;
452 *$obj->{Type} = '';
453 *$obj->{Prime} = $got->value('Prime') || '' ;
454 *$obj->{Pending} = '';
455 *$obj->{Plain} = 0;
456 *$obj->{PlainBytesRead} = 0;
457 *$obj->{InflatedBytesRead} = 0;
458 *$obj->{UnCompSize} = new U64;
459 *$obj->{CompSize} = new U64;
460 *$obj->{TotalInflatedBytesRead} = 0;
461 *$obj->{NewStream} = 0 ;
462 *$obj->{EventEof} = 0 ;
463 *$obj->{ClassName} = $class ;
464 *$obj->{Params} = $got ;
465
466 if (*$obj->{ConsumeInput}) {
467 *$obj->{InNew} = 0;
468 *$obj->{Closed} = 0;
469 return $obj
470 }
471
472 my $status = $obj->mkUncomp($got);
473
474 return undef
475 unless defined $status;
476
477 if ( ! $status) {
478 return undef
479 unless *$obj->{Transparent};
480
481 $obj->clearError();
482 *$obj->{Type} = 'plain';
483 *$obj->{Plain} = 1;
484 #$status = $obj->mkIdentityUncomp($class, $got);
485 $obj->pushBack(*$obj->{HeaderPending}) ;
486 }
487
488 push @{ *$obj->{InfoList} }, *$obj->{Info} ;
489
490 $obj->saveStatus(STATUS_OK) ;
491 *$obj->{InNew} = 0;
492 *$obj->{Closed} = 0;
493
494 return $obj;
495}
496
497sub ckInputParam
498{
499 my $self = shift ;
500 my $from = shift ;
501 my $inType = whatIsInput($_[0], $_[1]);
502
503 $self->croakError("$from: input parameter not a filename, filehandle, array ref or scalar ref")
504 if ! $inType ;
505
506# if ($inType eq 'filename' )
507# {
508# return $self->saveErrorString(1, "$from: input filename is undef or null string", STATUS_ERROR)
509# if ! defined $_[0] || $_[0] eq '' ;
510#
511# if ($_[0] ne '-' && ! -e $_[0] )
512# {
513# return $self->saveErrorString(1,
514# "input file '$_[0]' does not exist", STATUS_ERROR);
515# }
516# }
517
518 return 1;
519}
520
521
522sub _inf
523{
524 my $obj = shift ;
525
526 my $class = (caller)[0] ;
527 my $name = (caller(1))[3] ;
528
529 $obj->croakError("$name: expected at least 1 parameters\n")
530 unless @_ >= 1 ;
531
532 my $input = shift ;
533 my $haveOut = @_ ;
534 my $output = shift ;
535
536
537 my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output)
538 or return undef ;
539
540 push @_, $output if $haveOut && $x->{Hash};
541
542 *$obj->{OneShot} = 1 ;
543
544 my $got = $obj->checkParams($name, undef, @_)
545 or return undef ;
546
547 if ($got->parsed('TrailingData'))
548 {
549 *$obj->{TrailingData} = $got->value('TrailingData');
550 }
551
552 *$obj->{MultiStream} = $got->value('MultiStream');
553 $got->value('MultiStream', 0);
554
555 $x->{Got} = $got ;
556
557# if ($x->{Hash})
558# {
559# while (my($k, $v) = each %$input)
560# {
561# $v = \$input->{$k}
562# unless defined $v ;
563#
564# $obj->_singleTarget($x, $k, $v, @_)
565# or return undef ;
566# }
567#
568# return keys %$input ;
569# }
570
571 if ($x->{GlobMap})
572 {
573 $x->{oneInput} = 1 ;
574 foreach my $pair (@{ $x->{Pairs} })
575 {
576 my ($from, $to) = @$pair ;
577 $obj->_singleTarget($x, $from, $to, @_)
578 or return undef ;
579 }
580
581 return scalar @{ $x->{Pairs} } ;
582 }
583
584 if (! $x->{oneOutput} )
585 {
586 my $inFile = ($x->{inType} eq 'filenames'
587 || $x->{inType} eq 'filename');
588
589 $x->{inType} = $inFile ? 'filename' : 'buffer';
590
591 foreach my $in ($x->{oneInput} ? $input : @$input)
592 {
593 my $out ;
594 $x->{oneInput} = 1 ;
595
596 $obj->_singleTarget($x, $in, $output, @_)
597 or return undef ;
598 }
599
600 return 1 ;
601 }
602
603 # finally the 1 to 1 and n to 1
604 return $obj->_singleTarget($x, $input, $output, @_);
605
606 croak "should not be here" ;
607}
608
609sub retErr
610{
611 my $x = shift ;
612 my $string = shift ;
613
614 ${ $x->{Error} } = $string ;
615
616 return undef ;
617}
618
619sub _singleTarget
620{
621 my $self = shift ;
622 my $x = shift ;
623 my $input = shift;
624 my $output = shift;
625
626 my $buff = '';
627 $x->{buff} = \$buff ;
628
629 my $fh ;
630 if ($x->{outType} eq 'filename') {
631 my $mode = '>' ;
632 $mode = '>>'
633 if $x->{Got}->value('Append') ;
634 $x->{fh} = new IO::File "$mode $output"
635 or return retErr($x, "cannot open file '$output': $!") ;
636 binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut');
637
638 }
639
640 elsif ($x->{outType} eq 'handle') {
641 $x->{fh} = $output;
642 binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut');
643 if ($x->{Got}->value('Append')) {
644 seek($x->{fh}, 0, SEEK_END)
645 or return retErr($x, "Cannot seek to end of output filehandle: $!") ;
646 }
647 }
648
649
650 elsif ($x->{outType} eq 'buffer' )
651 {
652 $$output = ''
653 unless $x->{Got}->value('Append');
654 $x->{buff} = $output ;
655 }
656
657 if ($x->{oneInput})
658 {
659 defined $self->_rd2($x, $input, $output)
660 or return undef;
661 }
662 else
663 {
664 for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input)
665 {
666 defined $self->_rd2($x, $element, $output)
667 or return undef ;
668 }
669 }
670
671
672 if ( ($x->{outType} eq 'filename' && $output ne '-') ||
673 ($x->{outType} eq 'handle' && $x->{Got}->value('AutoClose'))) {
674 $x->{fh}->close()
675 or return retErr($x, $!);
676 delete $x->{fh};
677 }
678
679 return 1 ;
680}
681
682sub _rd2
683{
684 my $self = shift ;
685 my $x = shift ;
686 my $input = shift;
687 my $output = shift;
688
689 my $z = createSelfTiedObject($x->{Class}, *$self->{Error});
690
691 $z->_create($x->{Got}, 1, $input, @_)
692 or return undef ;
693
694 my $status ;
695 my $fh = $x->{fh};
696
697 while (1) {
698
699 while (($status = $z->read($x->{buff})) > 0) {
700 if ($fh) {
701 print $fh ${ $x->{buff} }
702 or return $z->saveErrorString(undef, "Error writing to output file: $!", $!);
703 ${ $x->{buff} } = '' ;
704 }
705 }
706
707 if (! $x->{oneOutput} ) {
708 my $ot = $x->{outType} ;
709
710 if ($ot eq 'array')
711 { push @$output, $x->{buff} }
712 elsif ($ot eq 'hash')
713 { $output->{$input} = $x->{buff} }
714
715 my $buff = '';
716 $x->{buff} = \$buff;
717 }
718
719 last if $status < 0 || $z->smartEof();
720 #last if $status < 0 ;
721
722 last
723 unless *$self->{MultiStream};
724
725 $status = $z->nextStream();
726
727 last
728 unless $status == 1 ;
729 }
730
731 return $z->closeError(undef)
732 if $status < 0 ;
733
734 ${ *$self->{TrailingData} } = $z->trailingData()
735 if defined *$self->{TrailingData} ;
736
737 $z->close()
738 or return undef ;
739
740 return 1 ;
741}
742
743sub TIEHANDLE
744{
745 return $_[0] if ref($_[0]);
746 die "OOPS\n" ;
747
748}
749
750sub UNTIE
751{
752 my $self = shift ;
753}
754
755
756sub getHeaderInfo
757{
758 my $self = shift ;
759 wantarray ? @{ *$self->{InfoList} } : *$self->{Info};
760}
761
762sub readBlock
763{
764 my $self = shift ;
765 my $buff = shift ;
766 my $size = shift ;
767
768 if (defined *$self->{CompressedInputLength}) {
769 if (*$self->{CompressedInputLengthRemaining} == 0) {
770 delete *$self->{CompressedInputLength};
771 *$self->{CompressedInputLengthDone} = 1;
772 return STATUS_OK ;
773 }
774 $size = min($size, *$self->{CompressedInputLengthRemaining} );
775 *$self->{CompressedInputLengthRemaining} -= $size ;
776 }
777
778 my $status = $self->smartRead($buff, $size) ;
779 return $self->saveErrorString(STATUS_ERROR, "Error Reading Data")
780 if $status < 0 ;
781
782 if ($status == 0 ) {
783 *$self->{Closed} = 1 ;
784 *$self->{EndStream} = 1 ;
785 return $self->saveErrorString(STATUS_ERROR, "unexpected end of file", STATUS_ERROR);
786 }
787
788 return STATUS_OK;
789}
790
791sub postBlockChk
792{
793 return STATUS_OK;
794}
795
796sub _raw_read
797{
798 # return codes
799 # >0 - ok, number of bytes read
800 # =0 - ok, eof
801 # <0 - not ok
802
803 my $self = shift ;
804
805 return G_EOF if *$self->{Closed} ;
806 #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
807 return G_EOF if *$self->{EndStream} ;
808
809 my $buffer = shift ;
810 my $scan_mode = shift ;
811
812 if (*$self->{Plain}) {
813 my $tmp_buff ;
814 my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ;
815
816 return $self->saveErrorString(G_ERR, "Error reading data: $!", $!)
817 if $len < 0 ;
818
819 if ($len == 0 ) {
820 *$self->{EndStream} = 1 ;
821 }
822 else {
823 *$self->{PlainBytesRead} += $len ;
824 $$buffer .= $tmp_buff;
825 }
826
827 return $len ;
828 }
829
830 if (*$self->{NewStream}) {
831
832 $self->gotoNextStream() > 0
833 or return G_ERR;
834
835 # For the headers that actually uncompressed data, put the
836 # uncompressed data into the output buffer.
837 $$buffer .= *$self->{Pending} ;
838 my $len = length *$self->{Pending} ;
839 *$self->{Pending} = '';
840 return $len;
841 }
842
843 my $temp_buf = '';
844 my $outSize = 0;
845 my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ;
846 return G_ERR
847 if $status == STATUS_ERROR ;
848
849 my $buf_len = 0;
850 if ($status == STATUS_OK) {
851 my $beforeC_len = length $temp_buf;
852 my $before_len = defined $$buffer ? length $$buffer : 0 ;
853 $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer,
854 defined *$self->{CompressedInputLengthDone} ||
855 $self->smartEof(), $outSize);
856
857 # Remember the input buffer if it wasn't consumed completely
858 $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput};
859
860 return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo})
861 if $self->saveStatus($status) == STATUS_ERROR;
862
863 $self->postBlockChk($buffer, $before_len) == STATUS_OK
864 or return G_ERR;
865
866 $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0;
867
868 *$self->{CompSize}->add($beforeC_len - length $temp_buf) ;
869
870 *$self->{InflatedBytesRead} += $buf_len ;
871 *$self->{TotalInflatedBytesRead} += $buf_len ;
872 *$self->{UnCompSize}->add($buf_len) ;
873
874 $self->filterUncompressed($buffer);
875
876 if (*$self->{Encoding}) {
877 $$buffer = *$self->{Encoding}->decode($$buffer);
878 }
879 }
880
881 if ($status == STATUS_ENDSTREAM) {
882
883 *$self->{EndStream} = 1 ;
884#$self->pushBack($temp_buf) ;
885#$temp_buf = '';
886
887 my $trailer;
888 my $trailer_size = *$self->{Info}{TrailerLength} ;
889 my $got = 0;
890 if (*$self->{Info}{TrailerLength})
891 {
892 $got = $self->smartRead(\$trailer, $trailer_size) ;
893 }
894
895 if ($got == $trailer_size) {
896 $self->chkTrailer($trailer) == STATUS_OK
897 or return G_ERR;
898 }
899 else {
900 return $self->TrailerError("trailer truncated. Expected " .
901 "$trailer_size bytes, got $got")
902 if *$self->{Strict};
903 $self->pushBack($trailer) ;
904 }
905
906 # TODO - if want to file file pointer, do it here
907
908 if (! $self->smartEof()) {
909 *$self->{NewStream} = 1 ;
910
911 if (*$self->{MultiStream}) {
912 *$self->{EndStream} = 0 ;
913 return $buf_len ;
914 }
915 }
916
917 }
918
919
920 # return the number of uncompressed bytes read
921 return $buf_len ;
922}
923
924sub reset
925{
926 my $self = shift ;
927
928 return *$self->{Uncomp}->reset();
929}
930
931sub filterUncompressed
932{
933}
934
935#sub isEndStream
936#{
937# my $self = shift ;
938# return *$self->{NewStream} ||
939# *$self->{EndStream} ;
940#}
941
942sub nextStream
943{
944 my $self = shift ;
945
946 my $status = $self->gotoNextStream();
947 $status == 1
948 or return $status ;
949
950 *$self->{TotalInflatedBytesRead} = 0 ;
951 *$self->{LineNo} = $. = 0;
952
953 return 1;
954}
955
956sub gotoNextStream
957{
958 my $self = shift ;
959
960 if (! *$self->{NewStream}) {
961 my $status = 1;
962 my $buffer ;
963
964 # TODO - make this more efficient if know the offset for the end of
965 # the stream and seekable
966 $status = $self->read($buffer)
967 while $status > 0 ;
968
969 return $status
970 if $status < 0;
971 }
972
973 *$self->{NewStream} = 0 ;
974 *$self->{EndStream} = 0 ;
975 $self->reset();
976 *$self->{UnCompSize}->reset();
977 *$self->{CompSize}->reset();
978
979 my $magic = $self->ckMagic();
980 #*$self->{EndStream} = 0 ;
981
982 if ( ! defined $magic) {
983 if (! *$self->{Transparent} )
984 {
985 *$self->{EndStream} = 1 ;
986 return 0;
987 }
988
989 $self->clearError();
990 *$self->{Type} = 'plain';
991 *$self->{Plain} = 1;
992 $self->pushBack(*$self->{HeaderPending}) ;
993 }
994 else
995 {
996 *$self->{Info} = $self->readHeader($magic);
997
998 if ( ! defined *$self->{Info} ) {
999 *$self->{EndStream} = 1 ;
1000 return -1;
1001 }
1002 }
1003
1004 push @{ *$self->{InfoList} }, *$self->{Info} ;
1005
1006 return 1;
1007}
1008
1009sub streamCount
1010{
1011 my $self = shift ;
1012 return 1 if ! defined *$self->{InfoList};
1013 return scalar @{ *$self->{InfoList} } ;
1014}
1015
1016sub read
1017{
1018 # return codes
1019 # >0 - ok, number of bytes read
1020 # =0 - ok, eof
1021 # <0 - not ok
1022
1023 my $self = shift ;
1024
1025 return G_EOF if *$self->{Closed} ;
1026
1027 my $buffer ;
1028
1029 if (ref $_[0] ) {
1030 $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
1031 if readonly(${ $_[0] });
1032
1033 $self->croakError(*$self->{ClassName} . "::read: not a scalar reference $_[0]" )
1034 unless ref $_[0] eq 'SCALAR' ;
1035 $buffer = $_[0] ;
1036 }
1037 else {
1038 $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
1039 if readonly($_[0]);
1040
1041 $buffer = \$_[0] ;
1042 }
1043
1044 my $length = $_[1] ;
1045 my $offset = $_[2] || 0;
1046
1047 if (! *$self->{AppendOutput}) {
1048 if (! $offset) {
1049 $$buffer = '' ;
1050 }
1051 else {
1052 if ($offset > length($$buffer)) {
1053 $$buffer .= "\x00" x ($offset - length($$buffer));
1054 }
1055 else {
1056 substr($$buffer, $offset) = '';
1057 }
1058 }
1059 }
1060
1061 return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
1062
1063 # the core read will return 0 if asked for 0 bytes
1064 return 0 if defined $length && $length == 0 ;
1065
1066 $length = $length || 0;
1067
1068 $self->croakError(*$self->{ClassName} . "::read: length parameter is negative")
1069 if $length < 0 ;
1070
1071 # Short-circuit if this is a simple read, with no length
1072 # or offset specified.
1073 unless ( $length || $offset) {
1074 if (length *$self->{Pending}) {
1075 $$buffer .= *$self->{Pending} ;
1076 my $len = length *$self->{Pending};
1077 *$self->{Pending} = '' ;
1078 return $len ;
1079 }
1080 else {
1081 my $len = 0;
1082 $len = $self->_raw_read($buffer)
1083 while ! *$self->{EndStream} && $len == 0 ;
1084 return $len ;
1085 }
1086 }
1087
1088 # Need to jump through more hoops - either length or offset
1089 # or both are specified.
1090 my $out_buffer = *$self->{Pending} ;
1091 *$self->{Pending} = '';
1092
1093
1094 while (! *$self->{EndStream} && length($out_buffer) < $length)
1095 {
1096 my $buf_len = $self->_raw_read(\$out_buffer);
1097 return $buf_len
1098 if $buf_len < 0 ;
1099 }
1100
1101 $length = length $out_buffer
1102 if length($out_buffer) < $length ;
1103
1104 return 0
1105 if $length == 0 ;
1106
1107 $$buffer = ''
1108 if ! defined $$buffer;
1109
1110 $offset = length $$buffer
1111 if *$self->{AppendOutput} ;
1112
1113 *$self->{Pending} = $out_buffer;
1114 $out_buffer = \*$self->{Pending} ;
1115
1116 #substr($$buffer, $offset) = substr($$out_buffer, 0, $length, '') ;
1117 substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
1118 substr($$out_buffer, 0, $length) = '' ;
1119
1120 return $length ;
1121}
1122
1123sub _getline
1124{
1125 my $self = shift ;
1126
1127 # Slurp Mode
1128 if ( ! defined $/ ) {
1129 my $data ;
1130 1 while $self->read($data) > 0 ;
1131 return \$data ;
1132 }
1133
1134 # Record Mode
1135 if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) {
1136 my $reclen = ${$/} ;
1137 my $data ;
1138 $self->read($data, $reclen) ;
1139 return \$data ;
1140 }
1141
1142 # Paragraph Mode
1143 if ( ! length $/ ) {
1144 my $paragraph ;
1145 while ($self->read($paragraph) > 0 ) {
1146 if ($paragraph =~ s/^(.*?\n\n+)//s) {
1147 *$self->{Pending} = $paragraph ;
1148 my $par = $1 ;
1149 return \$par ;
1150 }
1151 }
1152 return \$paragraph;
1153 }
1154
1155 # $/ isn't empty, or a reference, so it's Line Mode.
1156 {
1157 my $line ;
1158 my $offset;
1159 my $p = \*$self->{Pending} ;
1160
1161 if (length(*$self->{Pending}) &&
1162 ($offset = index(*$self->{Pending}, $/)) >=0) {
1163 my $l = substr(*$self->{Pending}, 0, $offset + length $/ );
1164 substr(*$self->{Pending}, 0, $offset + length $/) = '';
1165 return \$l;
1166 }
1167
1168 while ($self->read($line) > 0 ) {
1169 my $offset = index($line, $/);
1170 if ($offset >= 0) {
1171 my $l = substr($line, 0, $offset + length $/ );
1172 substr($line, 0, $offset + length $/) = '';
1173 $$p = $line;
1174 return \$l;
1175 }
1176 }
1177
1178 return \$line;
1179 }
1180}
1181
1182sub getline
1183{
1184 my $self = shift;
1185 my $current_append = *$self->{AppendOutput} ;
1186 *$self->{AppendOutput} = 1;
1187 my $lineref = $self->_getline();
1188 $. = ++ *$self->{LineNo} if defined $$lineref ;
1189 *$self->{AppendOutput} = $current_append;
1190 return $$lineref ;
1191}
1192
1193sub getlines
1194{
1195 my $self = shift;
1196 $self->croakError(*$self->{ClassName} .
1197 "::getlines: called in scalar context\n") unless wantarray;
1198 my($line, @lines);
1199 push(@lines, $line)
1200 while defined($line = $self->getline);
1201 return @lines;
1202}
1203
1204sub READLINE
1205{
1206 goto &getlines if wantarray;
1207 goto &getline;
1208}
1209
1210sub getc
1211{
1212 my $self = shift;
1213 my $buf;
1214 return $buf if $self->read($buf, 1);
1215 return undef;
1216}
1217
1218sub ungetc
1219{
1220 my $self = shift;
1221 *$self->{Pending} = "" unless defined *$self->{Pending} ;
1222 *$self->{Pending} = $_[0] . *$self->{Pending} ;
1223}
1224
1225
1226sub trailingData
1227{
1228 my $self = shift ;
1229
1230 if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
1231 return *$self->{Prime} ;
1232 }
1233 else {
1234 my $buf = *$self->{Buffer} ;
1235 my $offset = *$self->{BufferOffset} ;
1236 return substr($$buf, $offset) ;
1237 }
1238}
1239
1240
1241sub eof
1242{
1243 my $self = shift ;
1244
1245 return (*$self->{Closed} ||
1246 (!length *$self->{Pending}
1247 && ( $self->smartEof() || *$self->{EndStream}))) ;
1248}
1249
1250sub tell
1251{
1252 my $self = shift ;
1253
1254 my $in ;
1255 if (*$self->{Plain}) {
1256 $in = *$self->{PlainBytesRead} ;
1257 }
1258 else {
1259 $in = *$self->{TotalInflatedBytesRead} ;
1260 }
1261
1262 my $pending = length *$self->{Pending} ;
1263
1264 return 0 if $pending > $in ;
1265 return $in - $pending ;
1266}
1267
1268sub close
1269{
1270 # todo - what to do if close is called before the end of the gzip file
1271 # do we remember any trailing data?
1272 my $self = shift ;
1273
1274 return 1 if *$self->{Closed} ;
1275
1276 untie *$self
1277 if $] >= 5.008 ;
1278
1279 my $status = 1 ;
1280
1281 if (defined *$self->{FH}) {
1282 if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
1283 #if ( *$self->{AutoClose}) {
1284 local $.;
1285 $! = 0 ;
1286 $status = *$self->{FH}->close();
1287 return $self->saveErrorString(0, $!, $!)
1288 if !*$self->{InNew} && $self->saveStatus($!) != 0 ;
1289 }
1290 delete *$self->{FH} ;
1291 $! = 0 ;
1292 }
1293 *$self->{Closed} = 1 ;
1294
1295 return 1;
1296}
1297
1298sub DESTROY
1299{
1300 my $self = shift ;
1301 local ($., $@, $!, $^E, $?);
1302
1303 $self->close() ;
1304}
1305
1306sub seek
1307{
1308 my $self = shift ;
1309 my $position = shift;
1310 my $whence = shift ;
1311
1312 my $here = $self->tell() ;
1313 my $target = 0 ;
1314
1315
1316 if ($whence == SEEK_SET) {
1317 $target = $position ;
1318 }
1319 elsif ($whence == SEEK_CUR) {
1320 $target = $here + $position ;
1321 }
1322 elsif ($whence == SEEK_END) {
1323 $target = $position ;
1324 $self->croakError(*$self->{ClassName} . "::seek: SEEK_END not allowed") ;
1325 }
1326 else {
1327 $self->croakError(*$self->{ClassName} ."::seek: unknown value, $whence, for whence parameter");
1328 }
1329
1330 # short circuit if seeking to current offset
1331 return 1 if $target == $here ;
1332
1333 # Outlaw any attempt to seek backwards
1334 $self->croakError( *$self->{ClassName} ."::seek: cannot seek backwards")
1335 if $target < $here ;
1336
1337 # Walk the file to the new offset
1338 my $offset = $target - $here ;
1339
1340 my $got;
1341 while (($got = $self->read(my $buffer, min($offset, *$self->{BlockSize})) ) > 0)
1342 {
1343 $offset -= $got;
1344 last if $offset == 0 ;
1345 }
1346
1347 $here = $self->tell() ;
1348 return $offset == 0 ? 1 : 0 ;
1349}
1350
1351sub fileno
1352{
1353 my $self = shift ;
1354 return defined *$self->{FH}
1355 ? fileno *$self->{FH}
1356 : undef ;
1357}
1358
1359sub binmode
1360{
1361 1;
1362# my $self = shift ;
1363# return defined *$self->{FH}
1364# ? binmode *$self->{FH}
1365# : 1 ;
1366}
1367
1368sub opened
1369{
1370 my $self = shift ;
1371 return ! *$self->{Closed} ;
1372}
1373
1374sub autoflush
1375{
1376 my $self = shift ;
1377 return defined *$self->{FH}
1378 ? *$self->{FH}->autoflush(@_)
1379 : undef ;
1380}
1381
1382sub input_line_number
1383{
1384 my $self = shift ;
1385 my $last = *$self->{LineNo};
1386 $. = *$self->{LineNo} = $_[1] if @_ ;
1387 return $last;
1388}
1389
1390
139113µs*BINMODE = \&binmode;
13921600ns*SEEK = \&seek;
13931500ns*READ = \&read;
13941400ns*sysread = \&read;
13951400ns*TELL = \&tell;
13961500ns*EOF = \&eof;
1397
13981400ns*FILENO = \&fileno;
13991400ns*CLOSE = \&close;
1400
1401sub _notAvailable
1402
# spent 31µs within IO::Uncompress::Base::_notAvailable which was called 6 times, avg 5µs/call: # once (10µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1412 # once (8µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1409 # once (3µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1413 # once (3µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1410 # once (3µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1411 # once (3µs+0s) by IO::Uncompress::RawInflate::BEGIN@11 at line 1414
{
140364µs my $name = shift ;
1404 #return sub { croak "$name Not Available" ; } ;
1405647µs return sub { croak "$name Not Available: File opened only for intput" ; } ;
1406}
1407
1408
140916µs18µs*print = _notAvailable('print');
# spent 8µs making 1 call to IO::Uncompress::Base::_notAvailable
141012µs13µs*PRINT = _notAvailable('print');
# spent 3µs making 1 call to IO::Uncompress::Base::_notAvailable
141112µs13µs*printf = _notAvailable('printf');
# spent 3µs making 1 call to IO::Uncompress::Base::_notAvailable
141212µs110µs*PRINTF = _notAvailable('printf');
# spent 10µs making 1 call to IO::Uncompress::Base::_notAvailable
141312µs13µs*write = _notAvailable('write');
# spent 3µs making 1 call to IO::Uncompress::Base::_notAvailable
141412µs13µs*WRITE = _notAvailable('write');
# spent 3µs making 1 call to IO::Uncompress::Base::_notAvailable
1415
1416#*sysread = \&read;
1417#*syswrite = \&_notAvailable;
1418
- -
1421package IO::Uncompress::Base ;
1422
1423
1424117µs1 ;
1425__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.