| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/IO/Compress/Base.pm |
| Statements | Executed 52 statements in 2.40ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.87ms | 5.36ms | IO::Compress::Base::BEGIN@9 |
| 1 | 1 | 1 | 452µs | 940µs | IO::Compress::Base::BEGIN@11 |
| 1 | 1 | 1 | 9µs | 25µs | IO::Compress::Base::BEGIN@914 |
| 1 | 1 | 1 | 7µs | 16µs | IO::Compress::Base::BEGIN@278 |
| 1 | 1 | 1 | 7µs | 8µs | IO::Compress::Base::BEGIN@6 |
| 6 | 6 | 1 | 6µs | 6µs | IO::Compress::Base::_notAvailable |
| 1 | 1 | 1 | 3µs | 6µs | IO::Compress::Base::BEGIN@7 |
| 1 | 1 | 1 | 3µs | 3µs | IO::Compress::Base::BEGIN@12 |
| 1 | 1 | 1 | 2µs | 2µs | IO::Compress::Base::BEGIN@17 |
| 1 | 1 | 1 | 2µs | 2µs | IO::Compress::Base::BEGIN@16 |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::DESTROY |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::TIEHANDLE |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::UNTIE |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::__ANON__[:983] |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_create |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_def |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_flushCompressed |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_newStream |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_singleTarget |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_wr2 |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_writeFinalTrailer |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::_writeTrailer |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::addInterStream |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::autoflush |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::beforePayload |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::binmode |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::checkParams |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::ckOutputParam |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::close |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::closeError |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::croakError |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::eof |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::error |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::errorNo |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::fileno |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::filterUncompressed |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::flush |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::getFileInfo |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::getOneShotParams |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::input_line_number |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::newStream |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::opened |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::output |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::outputPayload |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::print |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::printf |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::reset |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::saveErrorString |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::saveStatus |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::seek |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::syswrite |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::tell |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::writeAt |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | |||||
| 2 | package IO::Compress::Base ; | ||||
| 3 | |||||
| 4 | 1 | 7µs | require 5.006 ; | ||
| 5 | |||||
| 6 | 2 | 13µs | 2 | 9µs | # spent 8µs (7+900ns) within IO::Compress::Base::BEGIN@6 which was called:
# once (7µs+900ns) by IO::Compress::RawDeflate::BEGIN@9 at line 6 # spent 8µs making 1 call to IO::Compress::Base::BEGIN@6
# spent 900ns making 1 call to strict::import |
| 7 | 2 | 12µs | 2 | 8µs | # spent 6µs (3+2) within IO::Compress::Base::BEGIN@7 which was called:
# once (3µs+2µs) by IO::Compress::RawDeflate::BEGIN@9 at line 7 # spent 6µs making 1 call to IO::Compress::Base::BEGIN@7
# spent 2µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 3 | 76µs | 3 | 5.44ms | # spent 5.36ms (2.87+2.48) within IO::Compress::Base::BEGIN@9 which was called:
# once (2.87ms+2.48ms) by IO::Compress::RawDeflate::BEGIN@9 at line 9 # spent 5.36ms making 1 call to IO::Compress::Base::BEGIN@9
# spent 74µs making 1 call to Exporter::import
# spent 7µs making 1 call to UNIVERSAL::VERSION |
| 10 | |||||
| 11 | 2 | 90µs | 1 | 940µs | # spent 940µs (452+488) within IO::Compress::Base::BEGIN@11 which was called:
# once (452µs+488µs) by IO::Compress::RawDeflate::BEGIN@9 at line 11 # spent 940µs making 1 call to IO::Compress::Base::BEGIN@11 |
| 12 | 2 | 12µs | 1 | 3µs | # spent 3µs within IO::Compress::Base::BEGIN@12 which was called:
# once (3µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 12 # spent 3µs making 1 call to IO::Compress::Base::BEGIN@12 |
| 13 | |||||
| 14 | #use File::Glob; | ||||
| 15 | #require Exporter ; | ||||
| 16 | 2 | 10µs | 1 | 2µs | # spent 2µs within IO::Compress::Base::BEGIN@16 which was called:
# once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 16 # spent 2µs making 1 call to IO::Compress::Base::BEGIN@16 |
| 17 | 2 | 566µs | 1 | 2µs | # spent 2µs within IO::Compress::Base::BEGIN@17 which was called:
# once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 17 # spent 2µs making 1 call to IO::Compress::Base::BEGIN@17 |
| 18 | #use bytes; | ||||
| 19 | |||||
| 20 | our (@ISA, $VERSION); | ||||
| 21 | 1 | 9µs | @ISA = qw(Exporter IO::File); | ||
| 22 | |||||
| 23 | 1 | 300ns | $VERSION = '2.068'; | ||
| 24 | |||||
| 25 | #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. | ||||
| 26 | |||||
| 27 | sub saveStatus | ||||
| 28 | { | ||||
| 29 | my $self = shift ; | ||||
| 30 | ${ *$self->{ErrorNo} } = shift() + 0 ; | ||||
| 31 | ${ *$self->{Error} } = '' ; | ||||
| 32 | |||||
| 33 | return ${ *$self->{ErrorNo} } ; | ||||
| 34 | } | ||||
| 35 | |||||
| 36 | |||||
| 37 | sub saveErrorString | ||||
| 38 | { | ||||
| 39 | my $self = shift ; | ||||
| 40 | my $retval = shift ; | ||||
| 41 | ${ *$self->{Error} } = shift ; | ||||
| 42 | ${ *$self->{ErrorNo} } = shift() + 0 if @_ ; | ||||
| 43 | |||||
| 44 | return $retval; | ||||
| 45 | } | ||||
| 46 | |||||
| 47 | sub croakError | ||||
| 48 | { | ||||
| 49 | my $self = shift ; | ||||
| 50 | $self->saveErrorString(0, $_[0]); | ||||
| 51 | Carp::croak $_[0]; | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | sub closeError | ||||
| 55 | { | ||||
| 56 | my $self = shift ; | ||||
| 57 | my $retval = shift ; | ||||
| 58 | |||||
| 59 | my $errno = *$self->{ErrorNo}; | ||||
| 60 | my $error = ${ *$self->{Error} }; | ||||
| 61 | |||||
| 62 | $self->close(); | ||||
| 63 | |||||
| 64 | *$self->{ErrorNo} = $errno ; | ||||
| 65 | ${ *$self->{Error} } = $error ; | ||||
| 66 | |||||
| 67 | return $retval; | ||||
| 68 | } | ||||
| 69 | |||||
| - - | |||||
| 72 | sub error | ||||
| 73 | { | ||||
| 74 | my $self = shift ; | ||||
| 75 | return ${ *$self->{Error} } ; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | sub errorNo | ||||
| 79 | { | ||||
| 80 | my $self = shift ; | ||||
| 81 | return ${ *$self->{ErrorNo} } ; | ||||
| 82 | } | ||||
| 83 | |||||
| 84 | |||||
| 85 | sub writeAt | ||||
| 86 | { | ||||
| 87 | my $self = shift ; | ||||
| 88 | my $offset = shift; | ||||
| 89 | my $data = shift; | ||||
| 90 | |||||
| 91 | if (defined *$self->{FH}) { | ||||
| 92 | my $here = tell(*$self->{FH}); | ||||
| 93 | return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) | ||||
| 94 | if $here < 0 ; | ||||
| 95 | seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET) | ||||
| 96 | or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; | ||||
| 97 | defined *$self->{FH}->write($data, length $data) | ||||
| 98 | or return $self->saveErrorString(undef, $!, $!) ; | ||||
| 99 | seek(*$self->{FH}, $here, IO::Handle::SEEK_SET) | ||||
| 100 | or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; | ||||
| 101 | } | ||||
| 102 | else { | ||||
| 103 | substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ; | ||||
| 104 | } | ||||
| 105 | |||||
| 106 | return 1; | ||||
| 107 | } | ||||
| 108 | |||||
| 109 | sub outputPayload | ||||
| 110 | { | ||||
| 111 | |||||
| 112 | my $self = shift ; | ||||
| 113 | return $self->output(@_); | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | |||||
| 117 | sub output | ||||
| 118 | { | ||||
| 119 | my $self = shift ; | ||||
| 120 | my $data = shift ; | ||||
| 121 | my $last = shift ; | ||||
| 122 | |||||
| 123 | return 1 | ||||
| 124 | if length $data == 0 && ! $last ; | ||||
| 125 | |||||
| 126 | if ( *$self->{FilterContainer} ) { | ||||
| 127 | *_ = \$data; | ||||
| 128 | &{ *$self->{FilterContainer} }(); | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | if (length $data) { | ||||
| 132 | if ( defined *$self->{FH} ) { | ||||
| 133 | defined *$self->{FH}->write( $data, length $data ) | ||||
| 134 | or return $self->saveErrorString(0, $!, $!); | ||||
| 135 | } | ||||
| 136 | else { | ||||
| 137 | ${ *$self->{Buffer} } .= $data ; | ||||
| 138 | } | ||||
| 139 | } | ||||
| 140 | |||||
| 141 | return 1; | ||||
| 142 | } | ||||
| 143 | |||||
| 144 | sub getOneShotParams | ||||
| 145 | { | ||||
| 146 | return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean, 1], | ||||
| 147 | ); | ||||
| 148 | } | ||||
| 149 | |||||
| 150 | 1 | 4µs | our %PARAMS = ( | ||
| 151 | # Generic Parameters | ||||
| 152 | 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], | ||||
| 153 | 'encode' => [IO::Compress::Base::Common::Parse_any, undef], | ||||
| 154 | 'strict' => [IO::Compress::Base::Common::Parse_boolean, 1], | ||||
| 155 | 'append' => [IO::Compress::Base::Common::Parse_boolean, 0], | ||||
| 156 | 'binmodein' => [IO::Compress::Base::Common::Parse_boolean, 0], | ||||
| 157 | |||||
| 158 | 'filtercontainer' => [IO::Compress::Base::Common::Parse_code, undef], | ||||
| 159 | ); | ||||
| 160 | |||||
| 161 | sub checkParams | ||||
| 162 | { | ||||
| 163 | my $self = shift ; | ||||
| 164 | my $class = shift ; | ||||
| 165 | |||||
| 166 | my $got = shift || IO::Compress::Base::Parameters::new(); | ||||
| 167 | |||||
| 168 | $got->parse( | ||||
| 169 | { | ||||
| 170 | %PARAMS, | ||||
| 171 | |||||
| 172 | |||||
| 173 | $self->getExtraParams(), | ||||
| 174 | *$self->{OneShot} ? $self->getOneShotParams() | ||||
| 175 | : (), | ||||
| 176 | }, | ||||
| 177 | @_) or $self->croakError("${class}: " . $got->getError()) ; | ||||
| 178 | |||||
| 179 | return $got ; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | sub _create | ||||
| 183 | { | ||||
| 184 | my $obj = shift; | ||||
| 185 | my $got = shift; | ||||
| 186 | |||||
| 187 | *$obj->{Closed} = 1 ; | ||||
| 188 | |||||
| 189 | my $class = ref $obj; | ||||
| 190 | $obj->croakError("$class: Missing Output parameter") | ||||
| 191 | if ! @_ && ! $got ; | ||||
| 192 | |||||
| 193 | my $outValue = shift ; | ||||
| 194 | my $oneShot = 1 ; | ||||
| 195 | |||||
| 196 | if (! $got) | ||||
| 197 | { | ||||
| 198 | $oneShot = 0 ; | ||||
| 199 | $got = $obj->checkParams($class, undef, @_) | ||||
| 200 | or return undef ; | ||||
| 201 | } | ||||
| 202 | |||||
| 203 | my $lax = ! $got->getValue('strict') ; | ||||
| 204 | |||||
| 205 | my $outType = IO::Compress::Base::Common::whatIsOutput($outValue); | ||||
| 206 | |||||
| 207 | $obj->ckOutputParam($class, $outValue) | ||||
| 208 | or return undef ; | ||||
| 209 | |||||
| 210 | if ($outType eq 'buffer') { | ||||
| 211 | *$obj->{Buffer} = $outValue; | ||||
| 212 | } | ||||
| 213 | else { | ||||
| 214 | my $buff = "" ; | ||||
| 215 | *$obj->{Buffer} = \$buff ; | ||||
| 216 | } | ||||
| 217 | |||||
| 218 | # Merge implies Append | ||||
| 219 | my $merge = $got->getValue('merge') ; | ||||
| 220 | my $appendOutput = $got->getValue('append') || $merge ; | ||||
| 221 | *$obj->{Append} = $appendOutput; | ||||
| 222 | *$obj->{FilterContainer} = $got->getValue('filtercontainer') ; | ||||
| 223 | |||||
| 224 | if ($merge) | ||||
| 225 | { | ||||
| 226 | # Switch off Merge mode if output file/buffer is empty/doesn't exist | ||||
| 227 | if (($outType eq 'buffer' && length $$outValue == 0 ) || | ||||
| 228 | ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) ) | ||||
| 229 | { $merge = 0 } | ||||
| 230 | } | ||||
| 231 | |||||
| 232 | # If output is a file, check that it is writable | ||||
| 233 | #no warnings; | ||||
| 234 | #if ($outType eq 'filename' && -e $outValue && ! -w _) | ||||
| 235 | # { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) } | ||||
| 236 | |||||
| 237 | $obj->ckParams($got) | ||||
| 238 | or $obj->croakError("${class}: " . $obj->error()); | ||||
| 239 | |||||
| 240 | if ($got->getValue('encode')) { | ||||
| 241 | my $want_encoding = $got->getValue('encode'); | ||||
| 242 | *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding); | ||||
| 243 | my $x = *$obj->{Encoding}; | ||||
| 244 | } | ||||
| 245 | else { | ||||
| 246 | *$obj->{Encoding} = undef; | ||||
| 247 | } | ||||
| 248 | |||||
| 249 | $obj->saveStatus(STATUS_OK) ; | ||||
| 250 | |||||
| 251 | my $status ; | ||||
| 252 | if (! $merge) | ||||
| 253 | { | ||||
| 254 | *$obj->{Compress} = $obj->mkComp($got) | ||||
| 255 | or return undef; | ||||
| 256 | |||||
| 257 | *$obj->{UnCompSize} = new U64 ; | ||||
| 258 | *$obj->{CompSize} = new U64 ; | ||||
| 259 | |||||
| 260 | if ( $outType eq 'buffer') { | ||||
| 261 | ${ *$obj->{Buffer} } = '' | ||||
| 262 | unless $appendOutput ; | ||||
| 263 | } | ||||
| 264 | else { | ||||
| 265 | if ($outType eq 'handle') { | ||||
| 266 | *$obj->{FH} = $outValue ; | ||||
| 267 | setBinModeOutput(*$obj->{FH}) ; | ||||
| 268 | #$outValue->flush() ; | ||||
| 269 | *$obj->{Handle} = 1 ; | ||||
| 270 | if ($appendOutput) | ||||
| 271 | { | ||||
| 272 | seek(*$obj->{FH}, 0, IO::Handle::SEEK_END) | ||||
| 273 | or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; | ||||
| 274 | |||||
| 275 | } | ||||
| 276 | } | ||||
| 277 | elsif ($outType eq 'filename') { | ||||
| 278 | 2 | 1.29ms | 2 | 25µs | # spent 16µs (7+9) within IO::Compress::Base::BEGIN@278 which was called:
# once (7µs+9µs) by IO::Compress::RawDeflate::BEGIN@9 at line 278 # spent 16µs making 1 call to IO::Compress::Base::BEGIN@278
# spent 9µs making 1 call to warnings::unimport |
| 279 | my $mode = '>' ; | ||||
| 280 | $mode = '>>' | ||||
| 281 | if $appendOutput; | ||||
| 282 | *$obj->{FH} = new IO::File "$mode $outValue" | ||||
| 283 | or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; | ||||
| 284 | *$obj->{StdIO} = ($outValue eq '-'); | ||||
| 285 | setBinModeOutput(*$obj->{FH}) ; | ||||
| 286 | } | ||||
| 287 | } | ||||
| 288 | |||||
| 289 | *$obj->{Header} = $obj->mkHeader($got) ; | ||||
| 290 | $obj->output( *$obj->{Header} ) | ||||
| 291 | or return undef; | ||||
| 292 | $obj->beforePayload(); | ||||
| 293 | } | ||||
| 294 | else | ||||
| 295 | { | ||||
| 296 | *$obj->{Compress} = $obj->createMerge($outValue, $outType) | ||||
| 297 | or return undef; | ||||
| 298 | } | ||||
| 299 | |||||
| 300 | *$obj->{Closed} = 0 ; | ||||
| 301 | *$obj->{AutoClose} = $got->getValue('autoclose') ; | ||||
| 302 | *$obj->{Output} = $outValue; | ||||
| 303 | *$obj->{ClassName} = $class; | ||||
| 304 | *$obj->{Got} = $got; | ||||
| 305 | *$obj->{OneShot} = 0 ; | ||||
| 306 | |||||
| 307 | return $obj ; | ||||
| 308 | } | ||||
| 309 | |||||
| 310 | sub ckOutputParam | ||||
| 311 | { | ||||
| 312 | my $self = shift ; | ||||
| 313 | my $from = shift ; | ||||
| 314 | my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]); | ||||
| 315 | |||||
| 316 | $self->croakError("$from: output parameter not a filename, filehandle or scalar ref") | ||||
| 317 | if ! $outType ; | ||||
| 318 | |||||
| 319 | #$self->croakError("$from: output filename is undef or null string") | ||||
| 320 | #if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ; | ||||
| 321 | |||||
| 322 | $self->croakError("$from: output buffer is read-only") | ||||
| 323 | if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] }); | ||||
| 324 | |||||
| 325 | return 1; | ||||
| 326 | } | ||||
| 327 | |||||
| 328 | |||||
| 329 | sub _def | ||||
| 330 | { | ||||
| 331 | my $obj = shift ; | ||||
| 332 | |||||
| 333 | my $class= (caller)[0] ; | ||||
| 334 | my $name = (caller(1))[3] ; | ||||
| 335 | |||||
| 336 | $obj->croakError("$name: expected at least 1 parameters\n") | ||||
| 337 | unless @_ >= 1 ; | ||||
| 338 | |||||
| 339 | my $input = shift ; | ||||
| 340 | my $haveOut = @_ ; | ||||
| 341 | my $output = shift ; | ||||
| 342 | |||||
| 343 | my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) | ||||
| 344 | or return undef ; | ||||
| 345 | |||||
| 346 | push @_, $output if $haveOut && $x->{Hash}; | ||||
| 347 | |||||
| 348 | *$obj->{OneShot} = 1 ; | ||||
| 349 | |||||
| 350 | my $got = $obj->checkParams($name, undef, @_) | ||||
| 351 | or return undef ; | ||||
| 352 | |||||
| 353 | $x->{Got} = $got ; | ||||
| 354 | |||||
| 355 | # if ($x->{Hash}) | ||||
| 356 | # { | ||||
| 357 | # while (my($k, $v) = each %$input) | ||||
| 358 | # { | ||||
| 359 | # $v = \$input->{$k} | ||||
| 360 | # unless defined $v ; | ||||
| 361 | # | ||||
| 362 | # $obj->_singleTarget($x, 1, $k, $v, @_) | ||||
| 363 | # or return undef ; | ||||
| 364 | # } | ||||
| 365 | # | ||||
| 366 | # return keys %$input ; | ||||
| 367 | # } | ||||
| 368 | |||||
| 369 | if ($x->{GlobMap}) | ||||
| 370 | { | ||||
| 371 | $x->{oneInput} = 1 ; | ||||
| 372 | foreach my $pair (@{ $x->{Pairs} }) | ||||
| 373 | { | ||||
| 374 | my ($from, $to) = @$pair ; | ||||
| 375 | $obj->_singleTarget($x, 1, $from, $to, @_) | ||||
| 376 | or return undef ; | ||||
| 377 | } | ||||
| 378 | |||||
| 379 | return scalar @{ $x->{Pairs} } ; | ||||
| 380 | } | ||||
| 381 | |||||
| 382 | if (! $x->{oneOutput} ) | ||||
| 383 | { | ||||
| 384 | my $inFile = ($x->{inType} eq 'filenames' | ||||
| 385 | || $x->{inType} eq 'filename'); | ||||
| 386 | |||||
| 387 | $x->{inType} = $inFile ? 'filename' : 'buffer'; | ||||
| 388 | |||||
| 389 | foreach my $in ($x->{oneInput} ? $input : @$input) | ||||
| 390 | { | ||||
| 391 | my $out ; | ||||
| 392 | $x->{oneInput} = 1 ; | ||||
| 393 | |||||
| 394 | $obj->_singleTarget($x, $inFile, $in, \$out, @_) | ||||
| 395 | or return undef ; | ||||
| 396 | |||||
| 397 | push @$output, \$out ; | ||||
| 398 | #if ($x->{outType} eq 'array') | ||||
| 399 | # { push @$output, \$out } | ||||
| 400 | #else | ||||
| 401 | # { $output->{$in} = \$out } | ||||
| 402 | } | ||||
| 403 | |||||
| 404 | return 1 ; | ||||
| 405 | } | ||||
| 406 | |||||
| 407 | # finally the 1 to 1 and n to 1 | ||||
| 408 | return $obj->_singleTarget($x, 1, $input, $output, @_); | ||||
| 409 | |||||
| 410 | Carp::croak "should not be here" ; | ||||
| 411 | } | ||||
| 412 | |||||
| 413 | sub _singleTarget | ||||
| 414 | { | ||||
| 415 | my $obj = shift ; | ||||
| 416 | my $x = shift ; | ||||
| 417 | my $inputIsFilename = shift; | ||||
| 418 | my $input = shift; | ||||
| 419 | |||||
| 420 | if ($x->{oneInput}) | ||||
| 421 | { | ||||
| 422 | $obj->getFileInfo($x->{Got}, $input) | ||||
| 423 | if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ; | ||||
| 424 | |||||
| 425 | my $z = $obj->_create($x->{Got}, @_) | ||||
| 426 | or return undef ; | ||||
| 427 | |||||
| 428 | |||||
| 429 | defined $z->_wr2($input, $inputIsFilename) | ||||
| 430 | or return $z->closeError(undef) ; | ||||
| 431 | |||||
| 432 | return $z->close() ; | ||||
| 433 | } | ||||
| 434 | else | ||||
| 435 | { | ||||
| 436 | my $afterFirst = 0 ; | ||||
| 437 | my $inputIsFilename = ($x->{inType} ne 'array'); | ||||
| 438 | my $keep = $x->{Got}->clone(); | ||||
| 439 | |||||
| 440 | #for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) | ||||
| 441 | for my $element ( @$input) | ||||
| 442 | { | ||||
| 443 | my $isFilename = isaFilename($element); | ||||
| 444 | |||||
| 445 | if ( $afterFirst ++ ) | ||||
| 446 | { | ||||
| 447 | defined addInterStream($obj, $element, $isFilename) | ||||
| 448 | or return $obj->closeError(undef) ; | ||||
| 449 | } | ||||
| 450 | else | ||||
| 451 | { | ||||
| 452 | $obj->getFileInfo($x->{Got}, $element) | ||||
| 453 | if isaScalar($element) || $isFilename; | ||||
| 454 | |||||
| 455 | $obj->_create($x->{Got}, @_) | ||||
| 456 | or return undef ; | ||||
| 457 | } | ||||
| 458 | |||||
| 459 | defined $obj->_wr2($element, $isFilename) | ||||
| 460 | or return $obj->closeError(undef) ; | ||||
| 461 | |||||
| 462 | *$obj->{Got} = $keep->clone(); | ||||
| 463 | } | ||||
| 464 | return $obj->close() ; | ||||
| 465 | } | ||||
| 466 | |||||
| 467 | } | ||||
| 468 | |||||
| 469 | sub _wr2 | ||||
| 470 | { | ||||
| 471 | my $self = shift ; | ||||
| 472 | |||||
| 473 | my $source = shift ; | ||||
| 474 | my $inputIsFilename = shift; | ||||
| 475 | |||||
| 476 | my $input = $source ; | ||||
| 477 | if (! $inputIsFilename) | ||||
| 478 | { | ||||
| 479 | $input = \$source | ||||
| 480 | if ! ref $source; | ||||
| 481 | } | ||||
| 482 | |||||
| 483 | if ( ref $input && ref $input eq 'SCALAR' ) | ||||
| 484 | { | ||||
| 485 | return $self->syswrite($input, @_) ; | ||||
| 486 | } | ||||
| 487 | |||||
| 488 | if ( ! ref $input || isaFilehandle($input)) | ||||
| 489 | { | ||||
| 490 | my $isFilehandle = isaFilehandle($input) ; | ||||
| 491 | |||||
| 492 | my $fh = $input ; | ||||
| 493 | |||||
| 494 | if ( ! $isFilehandle ) | ||||
| 495 | { | ||||
| 496 | $fh = new IO::File "<$input" | ||||
| 497 | or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; | ||||
| 498 | } | ||||
| 499 | binmode $fh if *$self->{Got}->valueOrDefault('binmodein') ; | ||||
| 500 | |||||
| 501 | my $status ; | ||||
| 502 | my $buff ; | ||||
| 503 | my $count = 0 ; | ||||
| 504 | while ($status = read($fh, $buff, 16 * 1024)) { | ||||
| 505 | $count += length $buff; | ||||
| 506 | defined $self->syswrite($buff, @_) | ||||
| 507 | or return undef ; | ||||
| 508 | } | ||||
| 509 | |||||
| 510 | return $self->saveErrorString(undef, $!, $!) | ||||
| 511 | if ! defined $status ; | ||||
| 512 | |||||
| 513 | if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-') | ||||
| 514 | { | ||||
| 515 | $fh->close() | ||||
| 516 | or return undef ; | ||||
| 517 | } | ||||
| 518 | |||||
| 519 | return $count ; | ||||
| 520 | } | ||||
| 521 | |||||
| 522 | Carp::croak "Should not be here"; | ||||
| 523 | return undef; | ||||
| 524 | } | ||||
| 525 | |||||
| 526 | sub addInterStream | ||||
| 527 | { | ||||
| 528 | my $self = shift ; | ||||
| 529 | my $input = shift ; | ||||
| 530 | my $inputIsFilename = shift ; | ||||
| 531 | |||||
| 532 | if (*$self->{Got}->getValue('multistream')) | ||||
| 533 | { | ||||
| 534 | $self->getFileInfo(*$self->{Got}, $input) | ||||
| 535 | #if isaFilename($input) and $inputIsFilename ; | ||||
| 536 | if isaScalar($input) || isaFilename($input) ; | ||||
| 537 | |||||
| 538 | # TODO -- newStream needs to allow gzip/zip header to be modified | ||||
| 539 | return $self->newStream(); | ||||
| 540 | } | ||||
| 541 | elsif (*$self->{Got}->getValue('autoflush')) | ||||
| 542 | { | ||||
| 543 | #return $self->flush(Z_FULL_FLUSH); | ||||
| 544 | } | ||||
| 545 | |||||
| 546 | return 1 ; | ||||
| 547 | } | ||||
| 548 | |||||
| 549 | sub getFileInfo | ||||
| 550 | { | ||||
| 551 | } | ||||
| 552 | |||||
| 553 | sub TIEHANDLE | ||||
| 554 | { | ||||
| 555 | return $_[0] if ref($_[0]); | ||||
| 556 | die "OOPS\n" ; | ||||
| 557 | } | ||||
| 558 | |||||
| 559 | sub UNTIE | ||||
| 560 | { | ||||
| 561 | my $self = shift ; | ||||
| 562 | } | ||||
| 563 | |||||
| 564 | sub DESTROY | ||||
| 565 | { | ||||
| 566 | my $self = shift ; | ||||
| 567 | local ($., $@, $!, $^E, $?); | ||||
| 568 | |||||
| 569 | $self->close() ; | ||||
| 570 | |||||
| 571 | # TODO - memory leak with 5.8.0 - this isn't called until | ||||
| 572 | # global destruction | ||||
| 573 | # | ||||
| 574 | %{ *$self } = () ; | ||||
| 575 | undef $self ; | ||||
| 576 | } | ||||
| 577 | |||||
| - - | |||||
| 580 | sub filterUncompressed | ||||
| 581 | { | ||||
| 582 | } | ||||
| 583 | |||||
| 584 | sub syswrite | ||||
| 585 | { | ||||
| 586 | my $self = shift ; | ||||
| 587 | |||||
| 588 | my $buffer ; | ||||
| 589 | if (ref $_[0] ) { | ||||
| 590 | $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" ) | ||||
| 591 | unless ref $_[0] eq 'SCALAR' ; | ||||
| 592 | $buffer = $_[0] ; | ||||
| 593 | } | ||||
| 594 | else { | ||||
| 595 | $buffer = \$_[0] ; | ||||
| 596 | } | ||||
| 597 | |||||
| 598 | if (@_ > 1) { | ||||
| 599 | my $slen = defined $$buffer ? length($$buffer) : 0; | ||||
| 600 | my $len = $slen; | ||||
| 601 | my $offset = 0; | ||||
| 602 | $len = $_[1] if $_[1] < $len; | ||||
| 603 | |||||
| 604 | if (@_ > 2) { | ||||
| 605 | $offset = $_[2] || 0; | ||||
| 606 | $self->croakError(*$self->{ClassName} . "::write: offset outside string") | ||||
| 607 | if $offset > $slen; | ||||
| 608 | if ($offset < 0) { | ||||
| 609 | $offset += $slen; | ||||
| 610 | $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0; | ||||
| 611 | } | ||||
| 612 | my $rem = $slen - $offset; | ||||
| 613 | $len = $rem if $rem < $len; | ||||
| 614 | } | ||||
| 615 | |||||
| 616 | $buffer = \substr($$buffer, $offset, $len) ; | ||||
| 617 | } | ||||
| 618 | |||||
| 619 | return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending}; | ||||
| 620 | |||||
| 621 | # *$self->{Pending} .= $$buffer ; | ||||
| 622 | # | ||||
| 623 | # return length $$buffer | ||||
| 624 | # if (length *$self->{Pending} < 1024 * 16 && ! *$self->{FlushPending}) ; | ||||
| 625 | # | ||||
| 626 | # $$buffer = *$self->{Pending} ; | ||||
| 627 | # *$self->{Pending} = ''; | ||||
| 628 | |||||
| 629 | if (*$self->{Encoding}) { | ||||
| 630 | $$buffer = *$self->{Encoding}->encode($$buffer); | ||||
| 631 | } | ||||
| 632 | else { | ||||
| 633 | $] >= 5.008 and ( utf8::downgrade($$buffer, 1) | ||||
| 634 | or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:"); | ||||
| 635 | } | ||||
| 636 | |||||
| 637 | $self->filterUncompressed($buffer); | ||||
| 638 | |||||
| 639 | my $buffer_length = defined $$buffer ? length($$buffer) : 0 ; | ||||
| 640 | *$self->{UnCompSize}->add($buffer_length) ; | ||||
| 641 | |||||
| 642 | my $outBuffer=''; | ||||
| 643 | my $status = *$self->{Compress}->compr($buffer, $outBuffer) ; | ||||
| 644 | |||||
| 645 | return $self->saveErrorString(undef, *$self->{Compress}{Error}, | ||||
| 646 | *$self->{Compress}{ErrorNo}) | ||||
| 647 | if $status == STATUS_ERROR; | ||||
| 648 | |||||
| 649 | *$self->{CompSize}->add(length $outBuffer) ; | ||||
| 650 | |||||
| 651 | $self->outputPayload($outBuffer) | ||||
| 652 | or return undef; | ||||
| 653 | |||||
| 654 | return $buffer_length; | ||||
| 655 | } | ||||
| 656 | |||||
| 657 | sub print | ||||
| 658 | { | ||||
| 659 | my $self = shift; | ||||
| 660 | |||||
| 661 | #if (ref $self) { | ||||
| 662 | # $self = *$self{GLOB} ; | ||||
| 663 | #} | ||||
| 664 | |||||
| 665 | if (defined $\) { | ||||
| 666 | if (defined $,) { | ||||
| 667 | defined $self->syswrite(join($,, @_) . $\); | ||||
| 668 | } else { | ||||
| 669 | defined $self->syswrite(join("", @_) . $\); | ||||
| 670 | } | ||||
| 671 | } else { | ||||
| 672 | if (defined $,) { | ||||
| 673 | defined $self->syswrite(join($,, @_)); | ||||
| 674 | } else { | ||||
| 675 | defined $self->syswrite(join("", @_)); | ||||
| 676 | } | ||||
| 677 | } | ||||
| 678 | } | ||||
| 679 | |||||
| 680 | sub printf | ||||
| 681 | { | ||||
| 682 | my $self = shift; | ||||
| 683 | my $fmt = shift; | ||||
| 684 | defined $self->syswrite(sprintf($fmt, @_)); | ||||
| 685 | } | ||||
| 686 | |||||
| 687 | sub _flushCompressed | ||||
| 688 | { | ||||
| 689 | my $self = shift ; | ||||
| 690 | |||||
| 691 | my $outBuffer=''; | ||||
| 692 | my $status = *$self->{Compress}->flush($outBuffer, @_) ; | ||||
| 693 | return $self->saveErrorString(0, *$self->{Compress}{Error}, | ||||
| 694 | *$self->{Compress}{ErrorNo}) | ||||
| 695 | if $status == STATUS_ERROR; | ||||
| 696 | |||||
| 697 | if ( defined *$self->{FH} ) { | ||||
| 698 | *$self->{FH}->clearerr(); | ||||
| 699 | } | ||||
| 700 | |||||
| 701 | *$self->{CompSize}->add(length $outBuffer) ; | ||||
| 702 | |||||
| 703 | $self->outputPayload($outBuffer) | ||||
| 704 | or return 0; | ||||
| 705 | return 1; | ||||
| 706 | } | ||||
| 707 | |||||
| 708 | sub flush | ||||
| 709 | { | ||||
| 710 | my $self = shift ; | ||||
| 711 | |||||
| 712 | $self->_flushCompressed(@_) | ||||
| 713 | or return 0; | ||||
| 714 | |||||
| 715 | if ( defined *$self->{FH} ) { | ||||
| 716 | defined *$self->{FH}->flush() | ||||
| 717 | or return $self->saveErrorString(0, $!, $!); | ||||
| 718 | } | ||||
| 719 | |||||
| 720 | return 1; | ||||
| 721 | } | ||||
| 722 | |||||
| 723 | sub beforePayload | ||||
| 724 | { | ||||
| 725 | } | ||||
| 726 | |||||
| 727 | sub _newStream | ||||
| 728 | { | ||||
| 729 | my $self = shift ; | ||||
| 730 | my $got = shift; | ||||
| 731 | |||||
| 732 | my $class = ref $self; | ||||
| 733 | |||||
| 734 | $self->_writeTrailer() | ||||
| 735 | or return 0 ; | ||||
| 736 | |||||
| 737 | $self->ckParams($got) | ||||
| 738 | or $self->croakError("newStream: $self->{Error}"); | ||||
| 739 | |||||
| 740 | if ($got->getValue('encode')) { | ||||
| 741 | my $want_encoding = $got->getValue('encode'); | ||||
| 742 | *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding); | ||||
| 743 | } | ||||
| 744 | else { | ||||
| 745 | *$self->{Encoding} = undef; | ||||
| 746 | } | ||||
| 747 | |||||
| 748 | *$self->{Compress} = $self->mkComp($got) | ||||
| 749 | or return 0; | ||||
| 750 | |||||
| 751 | *$self->{Header} = $self->mkHeader($got) ; | ||||
| 752 | $self->output(*$self->{Header} ) | ||||
| 753 | or return 0; | ||||
| 754 | |||||
| 755 | *$self->{UnCompSize}->reset(); | ||||
| 756 | *$self->{CompSize}->reset(); | ||||
| 757 | |||||
| 758 | $self->beforePayload(); | ||||
| 759 | |||||
| 760 | return 1 ; | ||||
| 761 | } | ||||
| 762 | |||||
| 763 | sub newStream | ||||
| 764 | { | ||||
| 765 | my $self = shift ; | ||||
| 766 | |||||
| 767 | my $got = $self->checkParams('newStream', *$self->{Got}, @_) | ||||
| 768 | or return 0 ; | ||||
| 769 | |||||
| 770 | $self->_newStream($got); | ||||
| 771 | |||||
| 772 | # *$self->{Compress} = $self->mkComp($got) | ||||
| 773 | # or return 0; | ||||
| 774 | # | ||||
| 775 | # *$self->{Header} = $self->mkHeader($got) ; | ||||
| 776 | # $self->output(*$self->{Header} ) | ||||
| 777 | # or return 0; | ||||
| 778 | # | ||||
| 779 | # *$self->{UnCompSize}->reset(); | ||||
| 780 | # *$self->{CompSize}->reset(); | ||||
| 781 | # | ||||
| 782 | # $self->beforePayload(); | ||||
| 783 | # | ||||
| 784 | # return 1 ; | ||||
| 785 | } | ||||
| 786 | |||||
| 787 | sub reset | ||||
| 788 | { | ||||
| 789 | my $self = shift ; | ||||
| 790 | return *$self->{Compress}->reset() ; | ||||
| 791 | } | ||||
| 792 | |||||
| 793 | sub _writeTrailer | ||||
| 794 | { | ||||
| 795 | my $self = shift ; | ||||
| 796 | |||||
| 797 | my $trailer = ''; | ||||
| 798 | |||||
| 799 | my $status = *$self->{Compress}->close($trailer) ; | ||||
| 800 | return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) | ||||
| 801 | if $status == STATUS_ERROR; | ||||
| 802 | |||||
| 803 | *$self->{CompSize}->add(length $trailer) ; | ||||
| 804 | |||||
| 805 | $trailer .= $self->mkTrailer(); | ||||
| 806 | defined $trailer | ||||
| 807 | or return 0; | ||||
| 808 | |||||
| 809 | return $self->output($trailer); | ||||
| 810 | } | ||||
| 811 | |||||
| 812 | sub _writeFinalTrailer | ||||
| 813 | { | ||||
| 814 | my $self = shift ; | ||||
| 815 | |||||
| 816 | return $self->output($self->mkFinalTrailer()); | ||||
| 817 | } | ||||
| 818 | |||||
| 819 | sub close | ||||
| 820 | { | ||||
| 821 | my $self = shift ; | ||||
| 822 | return 1 if *$self->{Closed} || ! *$self->{Compress} ; | ||||
| 823 | *$self->{Closed} = 1 ; | ||||
| 824 | |||||
| 825 | untie *$self | ||||
| 826 | if $] >= 5.008 ; | ||||
| 827 | |||||
| 828 | *$self->{FlushPending} = 1 ; | ||||
| 829 | $self->_writeTrailer() | ||||
| 830 | or return 0 ; | ||||
| 831 | |||||
| 832 | $self->_writeFinalTrailer() | ||||
| 833 | or return 0 ; | ||||
| 834 | |||||
| 835 | $self->output( "", 1 ) | ||||
| 836 | or return 0; | ||||
| 837 | |||||
| 838 | if (defined *$self->{FH}) { | ||||
| 839 | |||||
| 840 | if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { | ||||
| 841 | $! = 0 ; | ||||
| 842 | *$self->{FH}->close() | ||||
| 843 | or return $self->saveErrorString(0, $!, $!); | ||||
| 844 | } | ||||
| 845 | delete *$self->{FH} ; | ||||
| 846 | # This delete can set $! in older Perls, so reset the errno | ||||
| 847 | $! = 0 ; | ||||
| 848 | } | ||||
| 849 | |||||
| 850 | return 1; | ||||
| 851 | } | ||||
| 852 | |||||
| 853 | |||||
| 854 | #sub total_in | ||||
| 855 | #sub total_out | ||||
| 856 | #sub msg | ||||
| 857 | # | ||||
| 858 | #sub crc | ||||
| 859 | #{ | ||||
| 860 | # my $self = shift ; | ||||
| 861 | # return *$self->{Compress}->crc32() ; | ||||
| 862 | #} | ||||
| 863 | # | ||||
| 864 | #sub msg | ||||
| 865 | #{ | ||||
| 866 | # my $self = shift ; | ||||
| 867 | # return *$self->{Compress}->msg() ; | ||||
| 868 | #} | ||||
| 869 | # | ||||
| 870 | #sub dict_adler | ||||
| 871 | #{ | ||||
| 872 | # my $self = shift ; | ||||
| 873 | # return *$self->{Compress}->dict_adler() ; | ||||
| 874 | #} | ||||
| 875 | # | ||||
| 876 | #sub get_Level | ||||
| 877 | #{ | ||||
| 878 | # my $self = shift ; | ||||
| 879 | # return *$self->{Compress}->get_Level() ; | ||||
| 880 | #} | ||||
| 881 | # | ||||
| 882 | #sub get_Strategy | ||||
| 883 | #{ | ||||
| 884 | # my $self = shift ; | ||||
| 885 | # return *$self->{Compress}->get_Strategy() ; | ||||
| 886 | #} | ||||
| 887 | |||||
| 888 | |||||
| 889 | sub tell | ||||
| 890 | { | ||||
| 891 | my $self = shift ; | ||||
| 892 | |||||
| 893 | return *$self->{UnCompSize}->get32bit() ; | ||||
| 894 | } | ||||
| 895 | |||||
| 896 | sub eof | ||||
| 897 | { | ||||
| 898 | my $self = shift ; | ||||
| 899 | |||||
| 900 | return *$self->{Closed} ; | ||||
| 901 | } | ||||
| 902 | |||||
| 903 | |||||
| 904 | sub seek | ||||
| 905 | { | ||||
| 906 | my $self = shift ; | ||||
| 907 | my $position = shift; | ||||
| 908 | my $whence = shift ; | ||||
| 909 | |||||
| 910 | my $here = $self->tell() ; | ||||
| 911 | my $target = 0 ; | ||||
| 912 | |||||
| 913 | #use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); | ||||
| 914 | 2 | 276µs | 2 | 41µs | # spent 25µs (9+16) within IO::Compress::Base::BEGIN@914 which was called:
# once (9µs+16µs) by IO::Compress::RawDeflate::BEGIN@9 at line 914 # spent 25µs making 1 call to IO::Compress::Base::BEGIN@914
# spent 16µs making 1 call to Exporter::import |
| 915 | |||||
| 916 | if ($whence == IO::Handle::SEEK_SET) { | ||||
| 917 | $target = $position ; | ||||
| 918 | } | ||||
| 919 | elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) { | ||||
| 920 | $target = $here + $position ; | ||||
| 921 | } | ||||
| 922 | else { | ||||
| 923 | $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter"); | ||||
| 924 | } | ||||
| 925 | |||||
| 926 | # short circuit if seeking to current offset | ||||
| 927 | return 1 if $target == $here ; | ||||
| 928 | |||||
| 929 | # Outlaw any attempt to seek backwards | ||||
| 930 | $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards") | ||||
| 931 | if $target < $here ; | ||||
| 932 | |||||
| 933 | # Walk the file to the new offset | ||||
| 934 | my $offset = $target - $here ; | ||||
| 935 | |||||
| 936 | my $buffer ; | ||||
| 937 | defined $self->syswrite("\x00" x $offset) | ||||
| 938 | or return 0; | ||||
| 939 | |||||
| 940 | return 1 ; | ||||
| 941 | } | ||||
| 942 | |||||
| 943 | sub binmode | ||||
| 944 | { | ||||
| 945 | 1; | ||||
| 946 | # my $self = shift ; | ||||
| 947 | # return defined *$self->{FH} | ||||
| 948 | # ? binmode *$self->{FH} | ||||
| 949 | # : 1 ; | ||||
| 950 | } | ||||
| 951 | |||||
| 952 | sub fileno | ||||
| 953 | { | ||||
| 954 | my $self = shift ; | ||||
| 955 | return defined *$self->{FH} | ||||
| 956 | ? *$self->{FH}->fileno() | ||||
| 957 | : undef ; | ||||
| 958 | } | ||||
| 959 | |||||
| 960 | sub opened | ||||
| 961 | { | ||||
| 962 | my $self = shift ; | ||||
| 963 | return ! *$self->{Closed} ; | ||||
| 964 | } | ||||
| 965 | |||||
| 966 | sub autoflush | ||||
| 967 | { | ||||
| 968 | my $self = shift ; | ||||
| 969 | return defined *$self->{FH} | ||||
| 970 | ? *$self->{FH}->autoflush(@_) | ||||
| 971 | : undef ; | ||||
| 972 | } | ||||
| 973 | |||||
| 974 | sub input_line_number | ||||
| 975 | { | ||||
| 976 | return undef ; | ||||
| 977 | } | ||||
| 978 | |||||
| 979 | |||||
| 980 | sub _notAvailable | ||||
| 981 | # spent 6µs within IO::Compress::Base::_notAvailable which was called 6 times, avg 933ns/call:
# once (2µs+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 986
# once (800ns+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 987
# once (700ns+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 988
# once (600ns+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 989
# once (500ns+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 990
# once (500ns+0s) by IO::Compress::RawDeflate::BEGIN@9 at line 991 | ||||
| 982 | 6 | 800ns | my $name = shift ; | ||
| 983 | 6 | 13µs | return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; | ||
| 984 | } | ||||
| 985 | |||||
| 986 | 1 | 2µs | 1 | 2µs | *read = _notAvailable('read'); # spent 2µs making 1 call to IO::Compress::Base::_notAvailable |
| 987 | 1 | 500ns | 1 | 800ns | *READ = _notAvailable('read'); # spent 800ns making 1 call to IO::Compress::Base::_notAvailable |
| 988 | 1 | 400ns | 1 | 700ns | *readline = _notAvailable('readline'); # spent 700ns making 1 call to IO::Compress::Base::_notAvailable |
| 989 | 1 | 400ns | 1 | 600ns | *READLINE = _notAvailable('readline'); # spent 600ns making 1 call to IO::Compress::Base::_notAvailable |
| 990 | 1 | 400ns | 1 | 500ns | *getc = _notAvailable('getc'); # spent 500ns making 1 call to IO::Compress::Base::_notAvailable |
| 991 | 1 | 300ns | 1 | 500ns | *GETC = _notAvailable('getc'); # spent 500ns making 1 call to IO::Compress::Base::_notAvailable |
| 992 | |||||
| 993 | 1 | 400ns | *FILENO = \&fileno; | ||
| 994 | 1 | 100ns | *PRINT = \&print; | ||
| 995 | 1 | 100ns | *PRINTF = \&printf; | ||
| 996 | 1 | 100ns | *WRITE = \&syswrite; | ||
| 997 | 1 | 100ns | *write = \&syswrite; | ||
| 998 | 1 | 100ns | *SEEK = \&seek; | ||
| 999 | 1 | 100ns | *TELL = \&tell; | ||
| 1000 | 1 | 100ns | *EOF = \&eof; | ||
| 1001 | 1 | 100ns | *CLOSE = \&close; | ||
| 1002 | 1 | 200ns | *BINMODE = \&binmode; | ||
| 1003 | |||||
| 1004 | #*sysread = \&_notAvailable; | ||||
| 1005 | #*syswrite = \&_write; | ||||
| 1006 | |||||
| 1007 | 1 | 8µs | 1; | ||
| 1008 | |||||
| 1009 | __END__ |