| File | /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Compress/Base/Common.pm |
| Statements Executed | 122 |
| Statement Execution Time | 4.35ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 1.47ms | 3.46ms | IO::Compress::Base::Common::BEGIN@9 |
| 1 | 1 | 1 | 23µs | 27µs | IO::Compress::Base::Common::BEGIN@3 |
| 1 | 1 | 1 | 19µs | 50µs | U64::BEGIN@820 |
| 1 | 1 | 1 | 17µs | 22µs | IO::Compress::Base::Common::BEGIN@101 |
| 1 | 1 | 1 | 13µs | 58µs | IO::Compress::Base::Common::BEGIN@8 |
| 1 | 1 | 1 | 12µs | 15µs | IO::Compress::Base::Common::BEGIN@5 |
| 1 | 1 | 1 | 11µs | 43µs | IO::Compress::Base::Common::BEGIN@42 |
| 1 | 1 | 1 | 10µs | 14µs | IO::Compress::Base::Common::BEGIN@501 |
| 1 | 1 | 1 | 9µs | 38µs | IO::Compress::Base::Common::BEGIN@43 |
| 1 | 1 | 1 | 9µs | 58µs | IO::Compress::Base::Common::BEGIN@41 |
| 1 | 1 | 1 | 8µs | 43µs | IO::Compress::Base::Common::BEGIN@461 |
| 1 | 1 | 1 | 8µs | 37µs | U64::BEGIN@818 |
| 1 | 1 | 1 | 8µs | 39µs | IO::Compress::Base::Common::BEGIN@130 |
| 1 | 1 | 1 | 8µs | 39µs | IO::Compress::Base::Common::BEGIN@131 |
| 1 | 1 | 1 | 8µs | 23µs | IO::Compress::Base::Common::BEGIN@502 |
| 1 | 1 | 1 | 8µs | 19µs | IO::Compress::Base::Common::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 39µs | IO::Compress::Base::Common::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 37µs | IO::Compress::Base::Common::BEGIN@132 |
| 1 | 1 | 1 | 7µs | 32µs | IO::Compress::Base::Common::BEGIN@44 |
| 1 | 1 | 1 | 7µs | 46µs | IO::Compress::Base::Common::BEGIN@463 |
| 1 | 1 | 1 | 7µs | 34µs | IO::Compress::Base::Common::BEGIN@462 |
| 1 | 1 | 1 | 7µs | 44µs | IO::Compress::Base::Common::BEGIN@503 |
| 1 | 1 | 1 | 7µs | 34µs | IO::Compress::Base::Common::BEGIN@134 |
| 1 | 1 | 1 | 7µs | 39µs | IO::Compress::Base::Common::BEGIN@464 |
| 1 | 1 | 1 | 7µs | 31µs | IO::Compress::Base::Common::BEGIN@465 |
| 1 | 1 | 1 | 6µs | 73µs | IO::Compress::Base::Common::BEGIN@473 |
| 1 | 1 | 1 | 6µs | 32µs | IO::Compress::Base::Common::BEGIN@474 |
| 1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::BEGIN@476 |
| 1 | 1 | 1 | 6µs | 29µs | U64::BEGIN@819 |
| 1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::BEGIN@466 |
| 1 | 1 | 1 | 6µs | 29µs | IO::Compress::Base::Common::BEGIN@469 |
| 1 | 1 | 1 | 6µs | 29µs | IO::Compress::Base::Common::BEGIN@470 |
| 1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::BEGIN@471 |
| 1 | 1 | 1 | 6µs | 28µs | IO::Compress::Base::Common::BEGIN@477 |
| 1 | 1 | 1 | 6µs | 29µs | IO::Compress::Base::Common::BEGIN@475 |
| 1 | 1 | 1 | 6µs | 6µs | IO::Compress::Base::Common::BEGIN@268 |
| 1 | 1 | 1 | 5µs | 28µs | IO::Compress::Base::Common::BEGIN@478 |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::ParseParameters |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::cleanFileGlobString |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::createSelfTiedObject |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::getEncoding |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::hasEncode |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::isaFileGlobString |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::isaFilehandle |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::isaFilename |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::oneTarget |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::setBinModeInput |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::setBinModeOutput |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::whatIs |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::whatIsInput |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::whatIsOutput |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::_checkType |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::clone |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::new |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::parse |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::parsed |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::setError |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::value |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::valueOrDefault |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::wantValue |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::croakError |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::new |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::saveErrorString |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::validateInputArray |
| 0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::validateInputFilenames |
| 0 | 0 | 0 | 0s | 0s | U64::add |
| 0 | 0 | 0 | 0s | 0s | U64::clone |
| 0 | 0 | 0 | 0s | 0s | U64::equal |
| 0 | 0 | 0 | 0s | 0s | U64::get32bit |
| 0 | 0 | 0 | 0s | 0s | U64::getHigh |
| 0 | 0 | 0 | 0s | 0s | U64::getLow |
| 0 | 0 | 0 | 0s | 0s | U64::getPacked_V32 |
| 0 | 0 | 0 | 0s | 0s | U64::getPacked_V64 |
| 0 | 0 | 0 | 0s | 0s | U64::new |
| 0 | 0 | 0 | 0s | 0s | U64::newUnpack_V32 |
| 0 | 0 | 0 | 0s | 0s | U64::newUnpack_V64 |
| 0 | 0 | 0 | 0s | 0s | U64::pack_V64 |
| 0 | 0 | 0 | 0s | 0s | U64::reset |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package IO::Compress::Base::Common; | ||||
| 2 | |||||
| 3 | 3 | 23µs | 2 | 31µs | # spent 27µs (23+4) within IO::Compress::Base::Common::BEGIN@3 which was called
# once (23µs+4µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 3 # spent 27µs making 1 call to IO::Compress::Base::Common::BEGIN@3
# spent 4µs making 1 call to strict::import |
| 4 | 3 | 24µs | 2 | 31µs | # spent 19µs (8+12) within IO::Compress::Base::Common::BEGIN@4 which was called
# once (8µs+12µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 4 # spent 19µs making 1 call to IO::Compress::Base::Common::BEGIN@4
# spent 12µs making 1 call to warnings::import |
| 5 | 3 | 20µs | 2 | 17µs | # spent 15µs (12+2) within IO::Compress::Base::Common::BEGIN@5 which was called
# once (12µs+2µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 5 # spent 15µs making 1 call to IO::Compress::Base::Common::BEGIN@5
# spent 2µs making 1 call to bytes::import |
| 6 | |||||
| 7 | 3 | 29µs | 2 | 70µs | # spent 39µs (8+31) within IO::Compress::Base::Common::BEGIN@7 which was called
# once (8µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 7 # spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@7
# spent 31µs making 1 call to Exporter::import |
| 8 | 3 | 30µs | 2 | 103µs | # spent 58µs (13+45) within IO::Compress::Base::Common::BEGIN@8 which was called
# once (13µs+45µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 8 # spent 58µs making 1 call to IO::Compress::Base::Common::BEGIN@8
# spent 45µs making 1 call to Exporter::import |
| 9 | 3 | 205µs | 1 | 3.46ms | # spent 3.46ms (1.47+1.99) within IO::Compress::Base::Common::BEGIN@9 which was called
# once (1.47ms+1.99ms) by IO::Uncompress::RawInflate::BEGIN@9 at line 9 # spent 3.46ms making 1 call to IO::Compress::Base::Common::BEGIN@9 |
| 10 | |||||
| 11 | 1 | 800ns | require Exporter; | ||
| 12 | 1 | 800ns | our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); | ||
| 13 | 1 | 8µs | @ISA = qw(Exporter); | ||
| 14 | 1 | 300ns | $VERSION = '2.020'; | ||
| 15 | |||||
| 16 | 1 | 4µs | @EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput | ||
| 17 | isaFileGlobString cleanFileGlobString oneTarget | ||||
| 18 | setBinModeInput setBinModeOutput | ||||
| 19 | ckInOutParams | ||||
| 20 | createSelfTiedObject | ||||
| 21 | getEncoding | ||||
| 22 | |||||
| 23 | WANT_CODE | ||||
| 24 | WANT_EXT | ||||
| 25 | WANT_UNDEF | ||||
| 26 | WANT_HASH | ||||
| 27 | |||||
| 28 | STATUS_OK | ||||
| 29 | STATUS_ENDSTREAM | ||||
| 30 | STATUS_EOF | ||||
| 31 | STATUS_ERROR | ||||
| 32 | ); | ||||
| 33 | |||||
| 34 | 1 | 2µs | %EXPORT_TAGS = ( Status => [qw( STATUS_OK | ||
| 35 | STATUS_ENDSTREAM | ||||
| 36 | STATUS_EOF | ||||
| 37 | STATUS_ERROR | ||||
| 38 | )]); | ||||
| 39 | |||||
| 40 | |||||
| 41 | 3 | 30µs | 2 | 108µs | # spent 58µs (9+50) within IO::Compress::Base::Common::BEGIN@41 which was called
# once (9µs+50µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 41 # spent 58µs making 1 call to IO::Compress::Base::Common::BEGIN@41
# spent 50µs making 1 call to constant::import |
| 42 | 3 | 36µs | 2 | 74µs | # spent 43µs (11+32) within IO::Compress::Base::Common::BEGIN@42 which was called
# once (11µs+32µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 42 # spent 43µs making 1 call to IO::Compress::Base::Common::BEGIN@42
# spent 32µs making 1 call to constant::import |
| 43 | 3 | 27µs | 2 | 67µs | # spent 38µs (9+29) within IO::Compress::Base::Common::BEGIN@43 which was called
# once (9µs+29µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 43 # spent 38µs making 1 call to IO::Compress::Base::Common::BEGIN@43
# spent 29µs making 1 call to constant::import |
| 44 | 3 | 239µs | 2 | 57µs | # spent 32µs (7+25) within IO::Compress::Base::Common::BEGIN@44 which was called
# once (7µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 44 # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@44
# spent 25µs making 1 call to constant::import |
| 45 | |||||
| 46 | sub hasEncode() | ||||
| 47 | { | ||||
| 48 | if (! defined $HAS_ENCODE) { | ||||
| 49 | eval | ||||
| 50 | { | ||||
| 51 | require Encode; | ||||
| 52 | Encode->import(); | ||||
| 53 | }; | ||||
| 54 | |||||
| 55 | $HAS_ENCODE = $@ ? 0 : 1 ; | ||||
| 56 | } | ||||
| 57 | |||||
| 58 | return $HAS_ENCODE; | ||||
| 59 | } | ||||
| 60 | |||||
| 61 | sub getEncoding($$$) | ||||
| 62 | { | ||||
| 63 | my $obj = shift; | ||||
| 64 | my $class = shift ; | ||||
| 65 | my $want_encoding = shift ; | ||||
| 66 | |||||
| 67 | $obj->croakError("$class: Encode module needed to use -Encode") | ||||
| 68 | if ! hasEncode(); | ||||
| 69 | |||||
| 70 | my $encoding = Encode::find_encoding($want_encoding); | ||||
| 71 | |||||
| 72 | $obj->croakError("$class: Encoding '$want_encoding' is not available") | ||||
| 73 | if ! $encoding; | ||||
| 74 | |||||
| 75 | return $encoding; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | 1 | 0s | our ($needBinmode); | ||
| 79 | 1 | 44µs | $needBinmode = ($^O eq 'MSWin32' || | ||
| 80 | ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} ')) | ||||
| 81 | ? 1 : 1 ; | ||||
| 82 | |||||
| 83 | sub setBinModeInput($) | ||||
| 84 | { | ||||
| 85 | my $handle = shift ; | ||||
| 86 | |||||
| 87 | binmode $handle | ||||
| 88 | if $needBinmode; | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | sub setBinModeOutput($) | ||||
| 92 | { | ||||
| 93 | my $handle = shift ; | ||||
| 94 | |||||
| 95 | binmode $handle | ||||
| 96 | if $needBinmode; | ||||
| 97 | } | ||||
| 98 | |||||
| 99 | sub isaFilehandle($) | ||||
| 100 | { | ||||
| 101 | 3 | 190µs | 2 | 28µs | # spent 22µs (17+5) within IO::Compress::Base::Common::BEGIN@101 which was called
# once (17µs+5µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 101 # spent 22µs making 1 call to IO::Compress::Base::Common::BEGIN@101
# spent 6µs making 1 call to utf8::import |
| 102 | return (defined $_[0] and | ||||
| 103 | (UNIVERSAL::isa($_[0],'GLOB') or | ||||
| 104 | UNIVERSAL::isa($_[0],'IO::Handle') or | ||||
| 105 | UNIVERSAL::isa(\$_[0],'GLOB')) | ||||
| 106 | ) | ||||
| 107 | } | ||||
| 108 | |||||
| 109 | sub isaFilename($) | ||||
| 110 | { | ||||
| 111 | return (defined $_[0] and | ||||
| 112 | ! ref $_[0] and | ||||
| 113 | UNIVERSAL::isa(\$_[0], 'SCALAR')); | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | sub isaFileGlobString | ||||
| 117 | { | ||||
| 118 | return defined $_[0] && $_[0] =~ /^<.*>$/; | ||||
| 119 | } | ||||
| 120 | |||||
| 121 | sub cleanFileGlobString | ||||
| 122 | { | ||||
| 123 | my $string = shift ; | ||||
| 124 | |||||
| 125 | $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/; | ||||
| 126 | |||||
| 127 | return $string; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | 3 | 26µs | 2 | 71µs | # spent 39µs (8+31) within IO::Compress::Base::Common::BEGIN@130 which was called
# once (8µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 130 # spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@130
# spent 31µs making 1 call to constant::import |
| 131 | 3 | 33µs | 2 | 71µs | # spent 39µs (8+31) within IO::Compress::Base::Common::BEGIN@131 which was called
# once (8µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 131 # spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@131
# spent 31µs making 1 call to constant::import |
| 132 | 3 | 25µs | 2 | 66µs | # spent 37µs (7+29) within IO::Compress::Base::Common::BEGIN@132 which was called
# once (7µs+29µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 132 # spent 37µs making 1 call to IO::Compress::Base::Common::BEGIN@132
# spent 29µs making 1 call to constant::import |
| 133 | #use constant WANT_HASH => 8 ; | ||||
| 134 | 3 | 661µs | 2 | 60µs | # spent 34µs (7+27) within IO::Compress::Base::Common::BEGIN@134 which was called
# once (7µs+27µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 134 # spent 34µs making 1 call to IO::Compress::Base::Common::BEGIN@134
# spent 26µs making 1 call to constant::import |
| 135 | |||||
| 136 | sub whatIsInput($;$) | ||||
| 137 | { | ||||
| 138 | my $got = whatIs(@_); | ||||
| 139 | |||||
| 140 | if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') | ||||
| 141 | { | ||||
| 142 | #use IO::File; | ||||
| 143 | $got = 'handle'; | ||||
| 144 | $_[0] = *STDIN; | ||||
| 145 | #$_[0] = new IO::File("<-"); | ||||
| 146 | } | ||||
| 147 | |||||
| 148 | return $got; | ||||
| 149 | } | ||||
| 150 | |||||
| 151 | sub whatIsOutput($;$) | ||||
| 152 | { | ||||
| 153 | my $got = whatIs(@_); | ||||
| 154 | |||||
| 155 | if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') | ||||
| 156 | { | ||||
| 157 | $got = 'handle'; | ||||
| 158 | $_[0] = *STDOUT; | ||||
| 159 | #$_[0] = new IO::File(">-"); | ||||
| 160 | } | ||||
| 161 | |||||
| 162 | return $got; | ||||
| 163 | } | ||||
| 164 | |||||
| 165 | sub whatIs ($;$) | ||||
| 166 | { | ||||
| 167 | return 'handle' if isaFilehandle($_[0]); | ||||
| 168 | |||||
| 169 | my $wantCode = defined $_[1] && $_[1] & WANT_CODE ; | ||||
| 170 | my $extended = defined $_[1] && $_[1] & WANT_EXT ; | ||||
| 171 | my $undef = defined $_[1] && $_[1] & WANT_UNDEF ; | ||||
| 172 | my $hash = defined $_[1] && $_[1] & WANT_HASH ; | ||||
| 173 | |||||
| 174 | return 'undef' if ! defined $_[0] && $undef ; | ||||
| 175 | |||||
| 176 | if (ref $_[0]) { | ||||
| 177 | return '' if blessed($_[0]); # is an object | ||||
| 178 | #return '' if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object | ||||
| 179 | return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR'); | ||||
| 180 | return 'array' if UNIVERSAL::isa($_[0], 'ARRAY') && $extended ; | ||||
| 181 | return 'hash' if UNIVERSAL::isa($_[0], 'HASH') && $hash ; | ||||
| 182 | return 'code' if UNIVERSAL::isa($_[0], 'CODE') && $wantCode ; | ||||
| 183 | return ''; | ||||
| 184 | } | ||||
| 185 | |||||
| 186 | return 'fileglob' if $extended && isaFileGlobString($_[0]); | ||||
| 187 | return 'filename'; | ||||
| 188 | } | ||||
| 189 | |||||
| 190 | sub oneTarget | ||||
| 191 | { | ||||
| 192 | return $_[0] =~ /^(code|handle|buffer|filename)$/; | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | sub IO::Compress::Base::Validator::new | ||||
| 196 | { | ||||
| 197 | my $class = shift ; | ||||
| 198 | |||||
| 199 | my $Class = shift ; | ||||
| 200 | my $error_ref = shift ; | ||||
| 201 | my $reportClass = shift ; | ||||
| 202 | |||||
| 203 | my %data = (Class => $Class, | ||||
| 204 | Error => $error_ref, | ||||
| 205 | reportClass => $reportClass, | ||||
| 206 | ) ; | ||||
| 207 | |||||
| 208 | my $obj = bless \%data, $class ; | ||||
| 209 | |||||
| 210 | local $Carp::CarpLevel = 1; | ||||
| 211 | |||||
| 212 | my $inType = $data{inType} = whatIsInput($_[0], WANT_EXT|WANT_HASH); | ||||
| 213 | my $outType = $data{outType} = whatIsOutput($_[1], WANT_EXT|WANT_HASH); | ||||
| 214 | |||||
| 215 | my $oneInput = $data{oneInput} = oneTarget($inType); | ||||
| 216 | my $oneOutput = $data{oneOutput} = oneTarget($outType); | ||||
| 217 | |||||
| 218 | if (! $inType) | ||||
| 219 | { | ||||
| 220 | $obj->croakError("$reportClass: illegal input parameter") ; | ||||
| 221 | #return undef ; | ||||
| 222 | } | ||||
| 223 | |||||
| 224 | # if ($inType eq 'hash') | ||||
| 225 | # { | ||||
| 226 | # $obj->{Hash} = 1 ; | ||||
| 227 | # $obj->{oneInput} = 1 ; | ||||
| 228 | # return $obj->validateHash($_[0]); | ||||
| 229 | # } | ||||
| 230 | |||||
| 231 | if (! $outType) | ||||
| 232 | { | ||||
| 233 | $obj->croakError("$reportClass: illegal output parameter") ; | ||||
| 234 | #return undef ; | ||||
| 235 | } | ||||
| 236 | |||||
| 237 | |||||
| 238 | if ($inType ne 'fileglob' && $outType eq 'fileglob') | ||||
| 239 | { | ||||
| 240 | $obj->croakError("Need input fileglob for outout fileglob"); | ||||
| 241 | } | ||||
| 242 | |||||
| 243 | # if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' ) | ||||
| 244 | # { | ||||
| 245 | # $obj->croakError("input must ne filename or fileglob when output is a hash"); | ||||
| 246 | # } | ||||
| 247 | |||||
| 248 | if ($inType eq 'fileglob' && $outType eq 'fileglob') | ||||
| 249 | { | ||||
| 250 | $data{GlobMap} = 1 ; | ||||
| 251 | $data{inType} = $data{outType} = 'filename'; | ||||
| 252 | my $mapper = new File::GlobMapper($_[0], $_[1]); | ||||
| 253 | if ( ! $mapper ) | ||||
| 254 | { | ||||
| 255 | return $obj->saveErrorString($File::GlobMapper::Error) ; | ||||
| 256 | } | ||||
| 257 | $data{Pairs} = $mapper->getFileMap(); | ||||
| 258 | |||||
| 259 | return $obj; | ||||
| 260 | } | ||||
| 261 | |||||
| 262 | $obj->croakError("$reportClass: input and output $inType are identical") | ||||
| 263 | if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ; | ||||
| 264 | |||||
| 265 | if ($inType eq 'fileglob') # && $outType ne 'fileglob' | ||||
| 266 | { | ||||
| 267 | my $glob = cleanFileGlobString($_[0]); | ||||
| 268 | 3 | 592µs | 1 | 6µs | # spent 6µs within IO::Compress::Base::Common::BEGIN@268 which was called
# once (6µs+0s) by IO::Uncompress::RawInflate::BEGIN@9 at line 268 # spent 6µs making 1 call to IO::Compress::Base::Common::BEGIN@268 |
| 269 | |||||
| 270 | if (@inputs == 0) | ||||
| 271 | { | ||||
| 272 | # TODO -- legal or die? | ||||
| 273 | die "globmap matched zero file -- legal or die???" ; | ||||
| 274 | } | ||||
| 275 | elsif (@inputs == 1) | ||||
| 276 | { | ||||
| 277 | $obj->validateInputFilenames($inputs[0]) | ||||
| 278 | or return undef; | ||||
| 279 | $_[0] = $inputs[0] ; | ||||
| 280 | $data{inType} = 'filename' ; | ||||
| 281 | $data{oneInput} = 1; | ||||
| 282 | } | ||||
| 283 | else | ||||
| 284 | { | ||||
| 285 | $obj->validateInputFilenames(@inputs) | ||||
| 286 | or return undef; | ||||
| 287 | $_[0] = [ @inputs ] ; | ||||
| 288 | $data{inType} = 'filenames' ; | ||||
| 289 | } | ||||
| 290 | } | ||||
| 291 | elsif ($inType eq 'filename') | ||||
| 292 | { | ||||
| 293 | $obj->validateInputFilenames($_[0]) | ||||
| 294 | or return undef; | ||||
| 295 | } | ||||
| 296 | elsif ($inType eq 'array') | ||||
| 297 | { | ||||
| 298 | $data{inType} = 'filenames' ; | ||||
| 299 | $obj->validateInputArray($_[0]) | ||||
| 300 | or return undef ; | ||||
| 301 | } | ||||
| 302 | |||||
| 303 | return $obj->saveErrorString("$reportClass: output buffer is read-only") | ||||
| 304 | if $outType eq 'buffer' && readonly(${ $_[1] }); | ||||
| 305 | |||||
| 306 | if ($outType eq 'filename' ) | ||||
| 307 | { | ||||
| 308 | $obj->croakError("$reportClass: output filename is undef or null string") | ||||
| 309 | if ! defined $_[1] || $_[1] eq '' ; | ||||
| 310 | |||||
| 311 | if (-e $_[1]) | ||||
| 312 | { | ||||
| 313 | if (-d _ ) | ||||
| 314 | { | ||||
| 315 | return $obj->saveErrorString("output file '$_[1]' is a directory"); | ||||
| 316 | } | ||||
| 317 | } | ||||
| 318 | } | ||||
| 319 | |||||
| 320 | return $obj ; | ||||
| 321 | } | ||||
| 322 | |||||
| 323 | sub IO::Compress::Base::Validator::saveErrorString | ||||
| 324 | { | ||||
| 325 | my $self = shift ; | ||||
| 326 | ${ $self->{Error} } = shift ; | ||||
| 327 | return undef; | ||||
| 328 | |||||
| 329 | } | ||||
| 330 | |||||
| 331 | sub IO::Compress::Base::Validator::croakError | ||||
| 332 | { | ||||
| 333 | my $self = shift ; | ||||
| 334 | $self->saveErrorString($_[0]); | ||||
| 335 | croak $_[0]; | ||||
| 336 | } | ||||
| 337 | |||||
| 338 | |||||
| 339 | |||||
| 340 | sub IO::Compress::Base::Validator::validateInputFilenames | ||||
| 341 | { | ||||
| 342 | my $self = shift ; | ||||
| 343 | |||||
| 344 | foreach my $filename (@_) | ||||
| 345 | { | ||||
| 346 | $self->croakError("$self->{reportClass}: input filename is undef or null string") | ||||
| 347 | if ! defined $filename || $filename eq '' ; | ||||
| 348 | |||||
| 349 | next if $filename eq '-'; | ||||
| 350 | |||||
| 351 | if (! -e $filename ) | ||||
| 352 | { | ||||
| 353 | return $self->saveErrorString("input file '$filename' does not exist"); | ||||
| 354 | } | ||||
| 355 | |||||
| 356 | if (-d _ ) | ||||
| 357 | { | ||||
| 358 | return $self->saveErrorString("input file '$filename' is a directory"); | ||||
| 359 | } | ||||
| 360 | |||||
| 361 | if (! -r _ ) | ||||
| 362 | { | ||||
| 363 | return $self->saveErrorString("cannot open file '$filename': $!"); | ||||
| 364 | } | ||||
| 365 | } | ||||
| 366 | |||||
| 367 | return 1 ; | ||||
| 368 | } | ||||
| 369 | |||||
| 370 | sub IO::Compress::Base::Validator::validateInputArray | ||||
| 371 | { | ||||
| 372 | my $self = shift ; | ||||
| 373 | |||||
| 374 | if ( @{ $_[0] } == 0 ) | ||||
| 375 | { | ||||
| 376 | return $self->saveErrorString("empty array reference") ; | ||||
| 377 | } | ||||
| 378 | |||||
| 379 | foreach my $element ( @{ $_[0] } ) | ||||
| 380 | { | ||||
| 381 | my $inType = whatIsInput($element); | ||||
| 382 | |||||
| 383 | if (! $inType) | ||||
| 384 | { | ||||
| 385 | $self->croakError("unknown input parameter") ; | ||||
| 386 | } | ||||
| 387 | elsif($inType eq 'filename') | ||||
| 388 | { | ||||
| 389 | $self->validateInputFilenames($element) | ||||
| 390 | or return undef ; | ||||
| 391 | } | ||||
| 392 | else | ||||
| 393 | { | ||||
| 394 | $self->croakError("not a filename") ; | ||||
| 395 | } | ||||
| 396 | } | ||||
| 397 | |||||
| 398 | return 1 ; | ||||
| 399 | } | ||||
| 400 | |||||
| 401 | #sub IO::Compress::Base::Validator::validateHash | ||||
| 402 | #{ | ||||
| 403 | # my $self = shift ; | ||||
| 404 | # my $href = shift ; | ||||
| 405 | # | ||||
| 406 | # while (my($k, $v) = each %$href) | ||||
| 407 | # { | ||||
| 408 | # my $ktype = whatIsInput($k); | ||||
| 409 | # my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ; | ||||
| 410 | # | ||||
| 411 | # if ($ktype ne 'filename') | ||||
| 412 | # { | ||||
| 413 | # return $self->saveErrorString("hash key not filename") ; | ||||
| 414 | # } | ||||
| 415 | # | ||||
| 416 | # my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ; | ||||
| 417 | # if (! $valid{$vtype}) | ||||
| 418 | # { | ||||
| 419 | # return $self->saveErrorString("hash value not ok") ; | ||||
| 420 | # } | ||||
| 421 | # } | ||||
| 422 | # | ||||
| 423 | # return $self ; | ||||
| 424 | #} | ||||
| 425 | |||||
| 426 | sub createSelfTiedObject | ||||
| 427 | { | ||||
| 428 | my $class = shift || (caller)[0] ; | ||||
| 429 | my $error_ref = shift ; | ||||
| 430 | |||||
| 431 | my $obj = bless Symbol::gensym(), ref($class) || $class; | ||||
| 432 | tie *$obj, $obj if $] >= 5.005; | ||||
| 433 | *$obj->{Closed} = 1 ; | ||||
| 434 | $$error_ref = ''; | ||||
| 435 | *$obj->{Error} = $error_ref ; | ||||
| 436 | my $errno = 0 ; | ||||
| 437 | *$obj->{ErrorNo} = \$errno ; | ||||
| 438 | |||||
| 439 | return $obj; | ||||
| 440 | } | ||||
| 441 | |||||
| 442 | |||||
| 443 | |||||
| 444 | #package Parse::Parameters ; | ||||
| 445 | # | ||||
| 446 | # | ||||
| 447 | #require Exporter; | ||||
| 448 | #our ($VERSION, @ISA, @EXPORT); | ||||
| 449 | #$VERSION = '2.000_08'; | ||||
| 450 | #@ISA = qw(Exporter); | ||||
| 451 | |||||
| 452 | 1 | 3µs | $EXPORT_TAGS{Parse} = [qw( ParseParameters | ||
| 453 | Parse_any Parse_unsigned Parse_signed | ||||
| 454 | Parse_boolean Parse_custom Parse_string | ||||
| 455 | Parse_multiple Parse_writable_scalar | ||||
| 456 | ) | ||||
| 457 | ]; | ||||
| 458 | |||||
| 459 | 1 | 2µs | push @EXPORT, @{ $EXPORT_TAGS{Parse} } ; | ||
| 460 | |||||
| 461 | 3 | 28µs | 2 | 77µs | # spent 43µs (8+34) within IO::Compress::Base::Common::BEGIN@461 which was called
# once (8µs+34µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 461 # spent 43µs making 1 call to IO::Compress::Base::Common::BEGIN@461
# spent 34µs making 1 call to constant::import |
| 462 | 3 | 25µs | 2 | 60µs | # spent 34µs (7+26) within IO::Compress::Base::Common::BEGIN@462 which was called
# once (7µs+26µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 462 # spent 34µs making 1 call to IO::Compress::Base::Common::BEGIN@462
# spent 26µs making 1 call to constant::import |
| 463 | 3 | 29µs | 2 | 86µs | # spent 46µs (7+39) within IO::Compress::Base::Common::BEGIN@463 which was called
# once (7µs+39µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 463 # spent 46µs making 1 call to IO::Compress::Base::Common::BEGIN@463
# spent 39µs making 1 call to constant::import |
| 464 | 3 | 24µs | 2 | 71µs | # spent 39µs (7+32) within IO::Compress::Base::Common::BEGIN@464 which was called
# once (7µs+32µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 464 # spent 39µs making 1 call to IO::Compress::Base::Common::BEGIN@464
# spent 32µs making 1 call to constant::import |
| 465 | 3 | 22µs | 2 | 55µs | # spent 31µs (7+24) within IO::Compress::Base::Common::BEGIN@465 which was called
# once (7µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 465 # spent 31µs making 1 call to IO::Compress::Base::Common::BEGIN@465
# spent 24µs making 1 call to constant::import |
| 466 | 3 | 22µs | 2 | 54µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@466 which was called
# once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 466 # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@466
# spent 24µs making 1 call to constant::import |
| 467 | |||||
| 468 | #use constant Parse_store_ref => 0x100 ; | ||||
| 469 | 3 | 22µs | 2 | 52µs | # spent 29µs (6+23) within IO::Compress::Base::Common::BEGIN@469 which was called
# once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 469 # spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@469
# spent 23µs making 1 call to constant::import |
| 470 | 3 | 24µs | 2 | 53µs | # spent 29µs (6+23) within IO::Compress::Base::Common::BEGIN@470 which was called
# once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 470 # spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@470
# spent 23µs making 1 call to constant::import |
| 471 | 3 | 28µs | 2 | 54µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@471 which was called
# once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 471 # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@471
# spent 24µs making 1 call to constant::import |
| 472 | |||||
| 473 | 3 | 24µs | 2 | 139µs | # spent 73µs (6+66) within IO::Compress::Base::Common::BEGIN@473 which was called
# once (6µs+66µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 473 # spent 73µs making 1 call to IO::Compress::Base::Common::BEGIN@473
# spent 66µs making 1 call to constant::import |
| 474 | 3 | 22µs | 2 | 57µs | # spent 32µs (6+25) within IO::Compress::Base::Common::BEGIN@474 which was called
# once (6µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 474 # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@474
# spent 25µs making 1 call to constant::import |
| 475 | 3 | 28µs | 2 | 52µs | # spent 29µs (6+23) within IO::Compress::Base::Common::BEGIN@475 which was called
# once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 475 # spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@475
# spent 23µs making 1 call to constant::import |
| 476 | 3 | 21µs | 2 | 55µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@476 which was called
# once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 476 # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@476
# spent 24µs making 1 call to constant::import |
| 477 | 3 | 21µs | 2 | 51µs | # spent 28µs (6+23) within IO::Compress::Base::Common::BEGIN@477 which was called
# once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 477 # spent 28µs making 1 call to IO::Compress::Base::Common::BEGIN@477
# spent 23µs making 1 call to constant::import |
| 478 | 3 | 102µs | 2 | 51µs | # spent 28µs (5+23) within IO::Compress::Base::Common::BEGIN@478 which was called
# once (5µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 478 # spent 28µs making 1 call to IO::Compress::Base::Common::BEGIN@478
# spent 23µs making 1 call to constant::import |
| 479 | |||||
| 480 | |||||
| 481 | |||||
| 482 | sub ParseParameters | ||||
| 483 | { | ||||
| 484 | my $level = shift || 0 ; | ||||
| 485 | |||||
| 486 | my $sub = (caller($level + 1))[3] ; | ||||
| 487 | local $Carp::CarpLevel = 1 ; | ||||
| 488 | |||||
| 489 | return $_[1] | ||||
| 490 | if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters"); | ||||
| 491 | |||||
| 492 | my $p = new IO::Compress::Base::Parameters() ; | ||||
| 493 | $p->parse(@_) | ||||
| 494 | or croak "$sub: $p->{Error}" ; | ||||
| 495 | |||||
| 496 | return $p; | ||||
| 497 | } | ||||
| 498 | |||||
| 499 | #package IO::Compress::Base::Parameters; | ||||
| 500 | |||||
| 501 | 3 | 21µs | 2 | 19µs | # spent 14µs (10+4) within IO::Compress::Base::Common::BEGIN@501 which was called
# once (10µs+4µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 501 # spent 14µs making 1 call to IO::Compress::Base::Common::BEGIN@501
# spent 4µs making 1 call to strict::import |
| 502 | 3 | 20µs | 2 | 38µs | # spent 23µs (8+15) within IO::Compress::Base::Common::BEGIN@502 which was called
# once (8µs+15µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 502 # spent 23µs making 1 call to IO::Compress::Base::Common::BEGIN@502
# spent 15µs making 1 call to warnings::import |
| 503 | 3 | 1.05ms | 2 | 80µs | # spent 44µs (7+36) within IO::Compress::Base::Common::BEGIN@503 which was called
# once (7µs+36µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 503 # spent 44µs making 1 call to IO::Compress::Base::Common::BEGIN@503
# spent 36µs making 1 call to Exporter::import |
| 504 | |||||
| 505 | sub IO::Compress::Base::Parameters::new | ||||
| 506 | { | ||||
| 507 | my $class = shift ; | ||||
| 508 | |||||
| 509 | my $obj = { Error => '', | ||||
| 510 | Got => {}, | ||||
| 511 | } ; | ||||
| 512 | |||||
| 513 | #return bless $obj, ref($class) || $class || __PACKAGE__ ; | ||||
| 514 | return bless $obj, 'IO::Compress::Base::Parameters' ; | ||||
| 515 | } | ||||
| 516 | |||||
| 517 | sub IO::Compress::Base::Parameters::setError | ||||
| 518 | { | ||||
| 519 | my $self = shift ; | ||||
| 520 | my $error = shift ; | ||||
| 521 | my $retval = @_ ? shift : undef ; | ||||
| 522 | |||||
| 523 | $self->{Error} = $error ; | ||||
| 524 | return $retval; | ||||
| 525 | } | ||||
| 526 | |||||
| 527 | #sub getError | ||||
| 528 | #{ | ||||
| 529 | # my $self = shift ; | ||||
| 530 | # return $self->{Error} ; | ||||
| 531 | #} | ||||
| 532 | |||||
| 533 | sub IO::Compress::Base::Parameters::parse | ||||
| 534 | { | ||||
| 535 | my $self = shift ; | ||||
| 536 | |||||
| 537 | my $default = shift ; | ||||
| 538 | |||||
| 539 | my $got = $self->{Got} ; | ||||
| 540 | my $firstTime = keys %{ $got } == 0 ; | ||||
| 541 | my $other; | ||||
| 542 | |||||
| 543 | my (@Bad) ; | ||||
| 544 | my @entered = () ; | ||||
| 545 | |||||
| 546 | # Allow the options to be passed as a hash reference or | ||||
| 547 | # as the complete hash. | ||||
| 548 | if (@_ == 0) { | ||||
| 549 | @entered = () ; | ||||
| 550 | } | ||||
| 551 | elsif (@_ == 1) { | ||||
| 552 | my $href = $_[0] ; | ||||
| 553 | |||||
| 554 | return $self->setError("Expected even number of parameters, got 1") | ||||
| 555 | if ! defined $href or ! ref $href or ref $href ne "HASH" ; | ||||
| 556 | |||||
| 557 | foreach my $key (keys %$href) { | ||||
| 558 | push @entered, $key ; | ||||
| 559 | push @entered, \$href->{$key} ; | ||||
| 560 | } | ||||
| 561 | } | ||||
| 562 | else { | ||||
| 563 | my $count = @_; | ||||
| 564 | return $self->setError("Expected even number of parameters, got $count") | ||||
| 565 | if $count % 2 != 0 ; | ||||
| 566 | |||||
| 567 | for my $i (0.. $count / 2 - 1) { | ||||
| 568 | if ($_[2 * $i] eq '__xxx__') { | ||||
| 569 | $other = $_[2 * $i + 1] ; | ||||
| 570 | } | ||||
| 571 | else { | ||||
| 572 | push @entered, $_[2 * $i] ; | ||||
| 573 | push @entered, \$_[2 * $i + 1] ; | ||||
| 574 | } | ||||
| 575 | } | ||||
| 576 | } | ||||
| 577 | |||||
| 578 | |||||
| 579 | while (my ($key, $v) = each %$default) | ||||
| 580 | { | ||||
| 581 | croak "need 4 params [@$v]" | ||||
| 582 | if @$v != 4 ; | ||||
| 583 | |||||
| 584 | my ($first_only, $sticky, $type, $value) = @$v ; | ||||
| 585 | my $x ; | ||||
| 586 | $self->_checkType($key, \$value, $type, 0, \$x) | ||||
| 587 | or return undef ; | ||||
| 588 | |||||
| 589 | $key = lc $key; | ||||
| 590 | |||||
| 591 | if ($firstTime || ! $sticky) { | ||||
| 592 | $x = [ $x ] | ||||
| 593 | if $type & Parse_multiple; | ||||
| 594 | |||||
| 595 | $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ; | ||||
| 596 | } | ||||
| 597 | |||||
| 598 | $got->{$key}[OFF_PARSED] = 0 ; | ||||
| 599 | } | ||||
| 600 | |||||
| 601 | my %parsed = (); | ||||
| 602 | |||||
| 603 | if ($other) | ||||
| 604 | { | ||||
| 605 | for my $key (keys %$default) | ||||
| 606 | { | ||||
| 607 | my $canonkey = lc $key; | ||||
| 608 | if ($other->parsed($canonkey)) | ||||
| 609 | { | ||||
| 610 | my $value = $other->value($canonkey); | ||||
| 611 | #print "SET '$canonkey' to $value [$$value]\n"; | ||||
| 612 | ++ $parsed{$canonkey}; | ||||
| 613 | $got->{$canonkey}[OFF_PARSED] = 1; | ||||
| 614 | $got->{$canonkey}[OFF_DEFAULT] = $value; | ||||
| 615 | $got->{$canonkey}[OFF_FIXED] = $value; | ||||
| 616 | } | ||||
| 617 | } | ||||
| 618 | } | ||||
| 619 | |||||
| 620 | for my $i (0.. @entered / 2 - 1) { | ||||
| 621 | my $key = $entered[2* $i] ; | ||||
| 622 | my $value = $entered[2* $i+1] ; | ||||
| 623 | |||||
| 624 | #print "Key [$key] Value [$value]" ; | ||||
| 625 | #print defined $$value ? "[$$value]\n" : "[undef]\n"; | ||||
| 626 | |||||
| 627 | $key =~ s/^-// ; | ||||
| 628 | my $canonkey = lc $key; | ||||
| 629 | |||||
| 630 | if ($got->{$canonkey} && ($firstTime || | ||||
| 631 | ! $got->{$canonkey}[OFF_FIRST_ONLY] )) | ||||
| 632 | { | ||||
| 633 | my $type = $got->{$canonkey}[OFF_TYPE] ; | ||||
| 634 | my $parsed = $parsed{$canonkey}; | ||||
| 635 | ++ $parsed{$canonkey}; | ||||
| 636 | |||||
| 637 | return $self->setError("Muliple instances of '$key' found") | ||||
| 638 | if $parsed && $type & Parse_multiple == 0 ; | ||||
| 639 | |||||
| 640 | my $s ; | ||||
| 641 | $self->_checkType($key, $value, $type, 1, \$s) | ||||
| 642 | or return undef ; | ||||
| 643 | |||||
| 644 | $value = $$value ; | ||||
| 645 | if ($type & Parse_multiple) { | ||||
| 646 | $got->{$canonkey}[OFF_PARSED] = 1; | ||||
| 647 | push @{ $got->{$canonkey}[OFF_FIXED] }, $s ; | ||||
| 648 | } | ||||
| 649 | else { | ||||
| 650 | $got->{$canonkey} = [1, $type, $value, $s] ; | ||||
| 651 | } | ||||
| 652 | } | ||||
| 653 | else | ||||
| 654 | { push (@Bad, $key) } | ||||
| 655 | } | ||||
| 656 | |||||
| 657 | if (@Bad) { | ||||
| 658 | my ($bad) = join(", ", @Bad) ; | ||||
| 659 | return $self->setError("unknown key value(s) @Bad") ; | ||||
| 660 | } | ||||
| 661 | |||||
| 662 | return 1; | ||||
| 663 | } | ||||
| 664 | |||||
| 665 | sub IO::Compress::Base::Parameters::_checkType | ||||
| 666 | { | ||||
| 667 | my $self = shift ; | ||||
| 668 | |||||
| 669 | my $key = shift ; | ||||
| 670 | my $value = shift ; | ||||
| 671 | my $type = shift ; | ||||
| 672 | my $validate = shift ; | ||||
| 673 | my $output = shift; | ||||
| 674 | |||||
| 675 | #local $Carp::CarpLevel = $level ; | ||||
| 676 | #print "PARSE $type $key $value $validate $sub\n" ; | ||||
| 677 | |||||
| 678 | if ($type & Parse_writable_scalar) | ||||
| 679 | { | ||||
| 680 | return $self->setError("Parameter '$key' not writable") | ||||
| 681 | if $validate && readonly $$value ; | ||||
| 682 | |||||
| 683 | if (ref $$value) | ||||
| 684 | { | ||||
| 685 | return $self->setError("Parameter '$key' not a scalar reference") | ||||
| 686 | if $validate && ref $$value ne 'SCALAR' ; | ||||
| 687 | |||||
| 688 | $$output = $$value ; | ||||
| 689 | } | ||||
| 690 | else | ||||
| 691 | { | ||||
| 692 | return $self->setError("Parameter '$key' not a scalar") | ||||
| 693 | if $validate && ref $value ne 'SCALAR' ; | ||||
| 694 | |||||
| 695 | $$output = $value ; | ||||
| 696 | } | ||||
| 697 | |||||
| 698 | return 1; | ||||
| 699 | } | ||||
| 700 | |||||
| 701 | # if ($type & Parse_store_ref) | ||||
| 702 | # { | ||||
| 703 | # #$value = $$value | ||||
| 704 | # # if ref ${ $value } ; | ||||
| 705 | # | ||||
| 706 | # $$output = $value ; | ||||
| 707 | # return 1; | ||||
| 708 | # } | ||||
| 709 | |||||
| 710 | $value = $$value ; | ||||
| 711 | |||||
| 712 | if ($type & Parse_any) | ||||
| 713 | { | ||||
| 714 | $$output = $value ; | ||||
| 715 | return 1; | ||||
| 716 | } | ||||
| 717 | elsif ($type & Parse_unsigned) | ||||
| 718 | { | ||||
| 719 | return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'") | ||||
| 720 | if $validate && ! defined $value ; | ||||
| 721 | return $self->setError("Parameter '$key' must be an unsigned int, got '$value'") | ||||
| 722 | if $validate && $value !~ /^\d+$/; | ||||
| 723 | |||||
| 724 | $$output = defined $value ? $value : 0 ; | ||||
| 725 | return 1; | ||||
| 726 | } | ||||
| 727 | elsif ($type & Parse_signed) | ||||
| 728 | { | ||||
| 729 | return $self->setError("Parameter '$key' must be a signed int, got 'undef'") | ||||
| 730 | if $validate && ! defined $value ; | ||||
| 731 | return $self->setError("Parameter '$key' must be a signed int, got '$value'") | ||||
| 732 | if $validate && $value !~ /^-?\d+$/; | ||||
| 733 | |||||
| 734 | $$output = defined $value ? $value : 0 ; | ||||
| 735 | return 1 ; | ||||
| 736 | } | ||||
| 737 | elsif ($type & Parse_boolean) | ||||
| 738 | { | ||||
| 739 | return $self->setError("Parameter '$key' must be an int, got '$value'") | ||||
| 740 | if $validate && defined $value && $value !~ /^\d*$/; | ||||
| 741 | $$output = defined $value ? $value != 0 : 0 ; | ||||
| 742 | return 1; | ||||
| 743 | } | ||||
| 744 | elsif ($type & Parse_string) | ||||
| 745 | { | ||||
| 746 | $$output = defined $value ? $value : "" ; | ||||
| 747 | return 1; | ||||
| 748 | } | ||||
| 749 | |||||
| 750 | $$output = $value ; | ||||
| 751 | return 1; | ||||
| 752 | } | ||||
| 753 | |||||
| 754 | |||||
| 755 | |||||
| 756 | sub IO::Compress::Base::Parameters::parsed | ||||
| 757 | { | ||||
| 758 | my $self = shift ; | ||||
| 759 | my $name = shift ; | ||||
| 760 | |||||
| 761 | return $self->{Got}{lc $name}[OFF_PARSED] ; | ||||
| 762 | } | ||||
| 763 | |||||
| 764 | sub IO::Compress::Base::Parameters::value | ||||
| 765 | { | ||||
| 766 | my $self = shift ; | ||||
| 767 | my $name = shift ; | ||||
| 768 | |||||
| 769 | if (@_) | ||||
| 770 | { | ||||
| 771 | $self->{Got}{lc $name}[OFF_PARSED] = 1; | ||||
| 772 | $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ; | ||||
| 773 | $self->{Got}{lc $name}[OFF_FIXED] = $_[0] ; | ||||
| 774 | } | ||||
| 775 | |||||
| 776 | return $self->{Got}{lc $name}[OFF_FIXED] ; | ||||
| 777 | } | ||||
| 778 | |||||
| 779 | sub IO::Compress::Base::Parameters::valueOrDefault | ||||
| 780 | { | ||||
| 781 | my $self = shift ; | ||||
| 782 | my $name = shift ; | ||||
| 783 | my $default = shift ; | ||||
| 784 | |||||
| 785 | my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ; | ||||
| 786 | |||||
| 787 | return $value if defined $value ; | ||||
| 788 | return $default ; | ||||
| 789 | } | ||||
| 790 | |||||
| 791 | sub IO::Compress::Base::Parameters::wantValue | ||||
| 792 | { | ||||
| 793 | my $self = shift ; | ||||
| 794 | my $name = shift ; | ||||
| 795 | |||||
| 796 | return defined $self->{Got}{lc $name}[OFF_DEFAULT] ; | ||||
| 797 | |||||
| 798 | } | ||||
| 799 | |||||
| 800 | sub IO::Compress::Base::Parameters::clone | ||||
| 801 | { | ||||
| 802 | my $self = shift ; | ||||
| 803 | my $obj = { }; | ||||
| 804 | my %got ; | ||||
| 805 | |||||
| 806 | while (my ($k, $v) = each %{ $self->{Got} }) { | ||||
| 807 | $got{$k} = [ @$v ]; | ||||
| 808 | } | ||||
| 809 | |||||
| 810 | $obj->{Error} = $self->{Error}; | ||||
| 811 | $obj->{Got} = \%got ; | ||||
| 812 | |||||
| 813 | return bless $obj, 'IO::Compress::Base::Parameters' ; | ||||
| 814 | } | ||||
| 815 | |||||
| 816 | package U64; | ||||
| 817 | |||||
| 818 | 3 | 24µs | 2 | 66µs | # spent 37µs (8+29) within U64::BEGIN@818 which was called
# once (8µs+29µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 818 # spent 37µs making 1 call to U64::BEGIN@818
# spent 29µs making 1 call to constant::import |
| 819 | 3 | 22µs | 2 | 53µs | # spent 29µs (6+23) within U64::BEGIN@819 which was called
# once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 819 # spent 29µs making 1 call to U64::BEGIN@819
# spent 23µs making 1 call to constant::import |
| 820 | 3 | 501µs | 2 | 80µs | # spent 50µs (19+31) within U64::BEGIN@820 which was called
# once (19µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 820 # spent 50µs making 1 call to U64::BEGIN@820
# spent 31µs making 1 call to constant::import |
| 821 | |||||
| 822 | sub new | ||||
| 823 | { | ||||
| 824 | my $class = shift ; | ||||
| 825 | |||||
| 826 | my $high = 0 ; | ||||
| 827 | my $low = 0 ; | ||||
| 828 | |||||
| 829 | if (@_ == 2) { | ||||
| 830 | $high = shift ; | ||||
| 831 | $low = shift ; | ||||
| 832 | } | ||||
| 833 | elsif (@_ == 1) { | ||||
| 834 | $low = shift ; | ||||
| 835 | } | ||||
| 836 | |||||
| 837 | bless [$low, $high], $class; | ||||
| 838 | } | ||||
| 839 | |||||
| 840 | sub newUnpack_V64 | ||||
| 841 | { | ||||
| 842 | my $string = shift; | ||||
| 843 | |||||
| 844 | my ($low, $hi) = unpack "V V", $string ; | ||||
| 845 | bless [ $low, $hi ], "U64"; | ||||
| 846 | } | ||||
| 847 | |||||
| 848 | sub newUnpack_V32 | ||||
| 849 | { | ||||
| 850 | my $string = shift; | ||||
| 851 | |||||
| 852 | my $low = unpack "V", $string ; | ||||
| 853 | bless [ $low, 0 ], "U64"; | ||||
| 854 | } | ||||
| 855 | |||||
| 856 | sub reset | ||||
| 857 | { | ||||
| 858 | my $self = shift; | ||||
| 859 | $self->[HIGH] = $self->[LOW] = 0; | ||||
| 860 | } | ||||
| 861 | |||||
| 862 | sub clone | ||||
| 863 | { | ||||
| 864 | my $self = shift; | ||||
| 865 | bless [ @$self ], ref $self ; | ||||
| 866 | } | ||||
| 867 | |||||
| 868 | sub getHigh | ||||
| 869 | { | ||||
| 870 | my $self = shift; | ||||
| 871 | return $self->[HIGH]; | ||||
| 872 | } | ||||
| 873 | |||||
| 874 | sub getLow | ||||
| 875 | { | ||||
| 876 | my $self = shift; | ||||
| 877 | return $self->[LOW]; | ||||
| 878 | } | ||||
| 879 | |||||
| 880 | sub get32bit | ||||
| 881 | { | ||||
| 882 | my $self = shift; | ||||
| 883 | return $self->[LOW]; | ||||
| 884 | } | ||||
| 885 | |||||
| 886 | sub add | ||||
| 887 | { | ||||
| 888 | my $self = shift; | ||||
| 889 | my $value = shift; | ||||
| 890 | |||||
| 891 | if (ref $value eq 'U64') { | ||||
| 892 | $self->[HIGH] += $value->[HIGH] ; | ||||
| 893 | $value = $value->[LOW]; | ||||
| 894 | } | ||||
| 895 | |||||
| 896 | my $available = MAX32 - $self->[LOW] ; | ||||
| 897 | |||||
| 898 | if ($value > $available) { | ||||
| 899 | ++ $self->[HIGH] ; | ||||
| 900 | $self->[LOW] = $value - $available - 1; | ||||
| 901 | } | ||||
| 902 | else { | ||||
| 903 | $self->[LOW] += $value ; | ||||
| 904 | } | ||||
| 905 | } | ||||
| 906 | |||||
| 907 | sub equal | ||||
| 908 | { | ||||
| 909 | my $self = shift; | ||||
| 910 | my $other = shift; | ||||
| 911 | |||||
| 912 | return $self->[LOW] == $other->[LOW] && | ||||
| 913 | $self->[HIGH] == $other->[HIGH] ; | ||||
| 914 | } | ||||
| 915 | |||||
| 916 | sub getPacked_V64 | ||||
| 917 | { | ||||
| 918 | my $self = shift; | ||||
| 919 | |||||
| 920 | return pack "V V", @$self ; | ||||
| 921 | } | ||||
| 922 | |||||
| 923 | sub getPacked_V32 | ||||
| 924 | { | ||||
| 925 | my $self = shift; | ||||
| 926 | |||||
| 927 | return pack "V", $self->[LOW] ; | ||||
| 928 | } | ||||
| 929 | |||||
| 930 | sub pack_V64 | ||||
| 931 | { | ||||
| 932 | my $low = shift; | ||||
| 933 | |||||
| 934 | return pack "V V", $low, 0; | ||||
| 935 | } | ||||
| 936 | |||||
| 937 | |||||
| 938 | package IO::Compress::Base::Common; | ||||
| 939 | |||||
| 940 | 1 | 21µs | 1; |