Profile of /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Compress/Base/Common.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File | /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Compress/Base/Common.pm
Statements Executed | 122
Statement Execution Time | 4.03ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.39ms | 3.02ms | IO::Compress::Base::Common::::BEGIN@9 IO::Compress::Base::Common::BEGIN@9
1 | 1 | 1 | 18µs | 24µs | IO::Compress::Base::Common::::BEGIN@3 IO::Compress::Base::Common::BEGIN@3
1 | 1 | 1 | 16µs | 46µs | IO::Compress::Base::Common::::BEGIN@8 IO::Compress::Base::Common::BEGIN@8
1 | 1 | 1 | 16µs | 47µs | IO::Compress::Base::Common::::BEGIN@466 IO::Compress::Base::Common::BEGIN@466
1 | 1 | 1 | 15µs | 38µs | IO::Compress::Base::Common::::BEGIN@475 IO::Compress::Base::Common::BEGIN@475
1 | 1 | 1 | 13µs | 17µs | IO::Compress::Base::Common::::BEGIN@101 IO::Compress::Base::Common::BEGIN@101
1 | 1 | 1 | 10µs | 34µs | IO::Compress::Base::Common::::BEGIN@134 IO::Compress::Base::Common::BEGIN@134
1 | 1 | 1 | 10µs | 41µs | U64::::BEGIN@820 U64::BEGIN@820
1 | 1 | 1 | 10µs | 12µs | IO::Compress::Base::Common::::BEGIN@501 IO::Compress::Base::Common::BEGIN@501
1 | 1 | 1 | 8µs | 42µs | IO::Compress::Base::Common::::BEGIN@7 IO::Compress::Base::Common::BEGIN@7
1 | 1 | 1 | 8µs | 24µs | IO::Compress::Base::Common::::BEGIN@4 IO::Compress::Base::Common::BEGIN@4
1 | 1 | 1 | 8µs | 40µs | U64::::BEGIN@818 U64::BEGIN@818
1 | 1 | 1 | 8µs | 50µs | IO::Compress::Base::Common::::BEGIN@41 IO::Compress::Base::Common::BEGIN@41
1 | 1 | 1 | 8µs | 11µs | IO::Compress::Base::Common::::BEGIN@5 IO::Compress::Base::Common::BEGIN@5
1 | 1 | 1 | 8µs | 20µs | IO::Compress::Base::Common::::BEGIN@502 IO::Compress::Base::Common::BEGIN@502
1 | 1 | 1 | 8µs | 41µs | IO::Compress::Base::Common::::BEGIN@461 IO::Compress::Base::Common::BEGIN@461
1 | 1 | 1 | 8µs | 33µs | IO::Compress::Base::Common::::BEGIN@470 IO::Compress::Base::Common::BEGIN@470
1 | 1 | 1 | 8µs | 35µs | IO::Compress::Base::Common::::BEGIN@476 IO::Compress::Base::Common::BEGIN@476
1 | 1 | 1 | 7µs | 40µs | IO::Compress::Base::Common::::BEGIN@464 IO::Compress::Base::Common::BEGIN@464
1 | 1 | 1 | 7µs | 36µs | IO::Compress::Base::Common::::BEGIN@130 IO::Compress::Base::Common::BEGIN@130
1 | 1 | 1 | 7µs | 38µs | IO::Compress::Base::Common::::BEGIN@503 IO::Compress::Base::Common::BEGIN@503
1 | 1 | 1 | 7µs | 34µs | IO::Compress::Base::Common::::BEGIN@462 IO::Compress::Base::Common::BEGIN@462
1 | 1 | 1 | 7µs | 37µs | IO::Compress::Base::Common::::BEGIN@131 IO::Compress::Base::Common::BEGIN@131
1 | 1 | 1 | 7µs | 32µs | IO::Compress::Base::Common::::BEGIN@463 IO::Compress::Base::Common::BEGIN@463
1 | 1 | 1 | 6µs | 32µs | U64::::BEGIN@819 U64::BEGIN@819
1 | 1 | 1 | 6µs | 31µs | IO::Compress::Base::Common::::BEGIN@473 IO::Compress::Base::Common::BEGIN@473
1 | 1 | 1 | 6µs | 29µs | IO::Compress::Base::Common::::BEGIN@44 IO::Compress::Base::Common::BEGIN@44
1 | 1 | 1 | 6µs | 32µs | IO::Compress::Base::Common::::BEGIN@465 IO::Compress::Base::Common::BEGIN@465
1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::::BEGIN@474 IO::Compress::Base::Common::BEGIN@474
1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::::BEGIN@132 IO::Compress::Base::Common::BEGIN@132
1 | 1 | 1 | 6µs | 34µs | IO::Compress::Base::Common::::BEGIN@477 IO::Compress::Base::Common::BEGIN@477
1 | 1 | 1 | 6µs | 32µs | IO::Compress::Base::Common::::BEGIN@469 IO::Compress::Base::Common::BEGIN@469
1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::::BEGIN@43 IO::Compress::Base::Common::BEGIN@43
1 | 1 | 1 | 6µs | 29µs | IO::Compress::Base::Common::::BEGIN@478 IO::Compress::Base::Common::BEGIN@478
1 | 1 | 1 | 6µs | 32µs | IO::Compress::Base::Common::::BEGIN@471 IO::Compress::Base::Common::BEGIN@471
1 | 1 | 1 | 6µs | 30µs | IO::Compress::Base::Common::::BEGIN@42 IO::Compress::Base::Common::BEGIN@42
1 | 1 | 1 | 5µs | 5µs | IO::Compress::Base::Common::::BEGIN@268 IO::Compress::Base::Common::BEGIN@268
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::ParseParameters IO::Compress::Base::Common::ParseParameters
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::cleanFileGlobString IO::Compress::Base::Common::cleanFileGlobString
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::createSelfTiedObject IO::Compress::Base::Common::createSelfTiedObject
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::getEncoding IO::Compress::Base::Common::getEncoding
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::hasEncode IO::Compress::Base::Common::hasEncode
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::isaFileGlobString IO::Compress::Base::Common::isaFileGlobString
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::isaFilehandle IO::Compress::Base::Common::isaFilehandle
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::isaFilename IO::Compress::Base::Common::isaFilename
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::oneTarget IO::Compress::Base::Common::oneTarget
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::setBinModeInput IO::Compress::Base::Common::setBinModeInput
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::setBinModeOutput IO::Compress::Base::Common::setBinModeOutput
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::whatIs IO::Compress::Base::Common::whatIs
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::whatIsInput IO::Compress::Base::Common::whatIsInput
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Common::::whatIsOutput IO::Compress::Base::Common::whatIsOutput
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::_checkTypeIO::Compress::Base::Parameters::_checkType
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::cloneIO::Compress::Base::Parameters::clone
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::newIO::Compress::Base::Parameters::new
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::parseIO::Compress::Base::Parameters::parse
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::parsedIO::Compress::Base::Parameters::parsed
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::setErrorIO::Compress::Base::Parameters::setError
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::valueIO::Compress::Base::Parameters::value
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::valueOrDefaultIO::Compress::Base::Parameters::valueOrDefault
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Parameters::::wantValueIO::Compress::Base::Parameters::wantValue
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::::croakError IO::Compress::Base::Validator::croakError
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::::new IO::Compress::Base::Validator::new
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::::saveErrorString IO::Compress::Base::Validator::saveErrorString
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::::validateInputArray IO::Compress::Base::Validator::validateInputArray
0 | 0 | 0 | 0s | 0s | IO::Compress::Base::Validator::::validateInputFilenames IO::Compress::Base::Validator::validateInputFilenames
0 | 0 | 0 | 0s | 0s | U64::::add U64::add
0 | 0 | 0 | 0s | 0s | U64::::clone U64::clone
0 | 0 | 0 | 0s | 0s | U64::::equal U64::equal
0 | 0 | 0 | 0s | 0s | U64::::get32bit U64::get32bit
0 | 0 | 0 | 0s | 0s | U64::::getHigh U64::getHigh
0 | 0 | 0 | 0s | 0s | U64::::getLow U64::getLow
0 | 0 | 0 | 0s | 0s | U64::::getPacked_V32 U64::getPacked_V32
0 | 0 | 0 | 0s | 0s | U64::::getPacked_V64 U64::getPacked_V64
0 | 0 | 0 | 0s | 0s | U64::::new U64::new
0 | 0 | 0 | 0s | 0s | U64::::newUnpack_V32 U64::newUnpack_V32
0 | 0 | 0 | 0s | 0s | U64::::newUnpack_V64 U64::newUnpack_V64
0 | 0 | 0 | 0s | 0s | U64::::pack_V64 U64::pack_V64
0 | 0 | 0 | 0s | 0s | U64::::reset U64::reset

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package IO::Compress::Base::Common;
2 |  |  |  |  |
3 | 3 | 23µs | 2 | 29µs | # spent 24µs (18+6) within IO::Compress::Base::Common::BEGIN@3 which was called # once (18µs+6µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 3 use strict ; # spent 24µs making 1 call to IO::Compress::Base::Common::BEGIN@3 # spent 6µs making 1 call to strict::import
4 | 3 | 22µs | 2 | 40µs | # spent 24µs (8+16) within IO::Compress::Base::Common::BEGIN@4 which was called # once (8µs+16µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 4 use warnings; # spent 24µs making 1 call to IO::Compress::Base::Common::BEGIN@4 # spent 16µs making 1 call to warnings::import
5 | 3 | 20µs | 2 | 13µs | # spent 11µs (8+3) within IO::Compress::Base::Common::BEGIN@5 which was called # once (8µs+3µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 5 use bytes; # spent 11µs making 1 call to IO::Compress::Base::Common::BEGIN@5 # spent 3µs making 1 call to bytes::import
6 |  |  |  |  |
7 | 3 | 28µs | 2 | 76µs | # spent 42µs (8+34) within IO::Compress::Base::Common::BEGIN@7 which was called # once (8µs+34µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 7 use Carp; # spent 42µs making 1 call to IO::Compress::Base::Common::BEGIN@7 # spent 34µs making 1 call to Exporter::import
8 | 3 | 27µs | 2 | 76µs | # spent 46µs (16+30) within IO::Compress::Base::Common::BEGIN@8 which was called # once (16µs+30µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 8 use Scalar::Util qw(blessed readonly); # spent 46µs making 1 call to IO::Compress::Base::Common::BEGIN@8 # spent 30µs making 1 call to Exporter::import
9 | 3 | 174µs | 1 | 3.02ms | # spent 3.02ms (1.39+1.64) within IO::Compress::Base::Common::BEGIN@9 which was called # once (1.39ms+1.64ms) by IO::Uncompress::RawInflate::BEGIN@9 at line 9 use File::GlobMapper; # spent 3.02ms making 1 call to IO::Compress::Base::Common::BEGIN@9
10 |  |  |  |  |
11 | 1 | 500ns |  |  | require Exporter;
12 | 1 | 600ns |  |  | our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
13 | 1 | 8µs |  |  | @ISA = qw(Exporter);
14 | 1 | 300ns |  |  | $VERSION = '2.020';
15 |  |  |  |  |
16 | 1 | 3µ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 | 26µs | 2 | 92µs | # spent 50µs (8+42) within IO::Compress::Base::Common::BEGIN@41 which was called # once (8µs+42µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 41 use constant STATUS_OK => 0; # spent 50µs making 1 call to IO::Compress::Base::Common::BEGIN@41 # spent 42µs making 1 call to constant::import
42 | 3 | 22µs | 2 | 55µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@42 which was called # once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 42 use constant STATUS_ENDSTREAM => 1; # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@42 # spent 24µs making 1 call to constant::import
43 | 3 | 23µs | 2 | 53µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@43 which was called # once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 43 use constant STATUS_EOF => 2; # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@43 # spent 24µs making 1 call to constant::import
44 | 3 | 194µs | 2 | 52µs | # spent 29µs (6+23) within IO::Compress::Base::Common::BEGIN@44 which was called # once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 44 use constant STATUS_ERROR => -1; # spent 29µs making 1 call to IO::Compress::Base::Common::BEGIN@44 # spent 23µ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 | 34µ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 | 160µs | 2 | 22µs | # spent 17µs (13+5) within IO::Compress::Base::Common::BEGIN@101 which was called # once (13µs+5µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 101 use utf8; # Pragma needed to keep Perl 5.6.0 happy # spent 17µs making 1 call to IO::Compress::Base::Common::BEGIN@101 # spent 5µ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 | 33µs | 2 | 64µs | # spent 36µs (7+29) within IO::Compress::Base::Common::BEGIN@130 which was called # once (7µs+29µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 130 use constant WANT_CODE => 1 ; # spent 36µs making 1 call to IO::Compress::Base::Common::BEGIN@130 # spent 29µs making 1 call to constant::import
131 | 3 | 23µs | 2 | 66µs | # spent 37µs (7+30) within IO::Compress::Base::Common::BEGIN@131 which was called # once (7µs+30µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 131 use constant WANT_EXT => 2 ; # spent 37µs making 1 call to IO::Compress::Base::Common::BEGIN@131 # spent 30µs making 1 call to constant::import
132 | 3 | 23µs | 2 | 53µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@132 which was called # once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 132 use constant WANT_UNDEF => 4 ; # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@132 # spent 24µs making 1 call to constant::import
133 |  |  |  |  | #use constant WANT_HASH => 8 ;
134 | 3 | 480µs | 2 | 57µs | # spent 34µs (10+24) within IO::Compress::Base::Common::BEGIN@134 which was called # once (10µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 134 use constant WANT_HASH => 0 ; # spent 34µs making 1 call to IO::Compress::Base::Common::BEGIN@134 # spent 24µ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 | 586µs | 1 | 5µs | # spent 5µs within IO::Compress::Base::Common::BEGIN@268 which was called # once (5µs+0s) by IO::Uncompress::RawInflate::BEGIN@9 at line 268 my @inputs = glob($glob); # spent 5µ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 | 2µ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 | 27µs | 2 | 75µs | # spent 41µs (8+33) within IO::Compress::Base::Common::BEGIN@461 which was called # once (8µs+33µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 461 use constant Parse_any => 0x01; # spent 41µs making 1 call to IO::Compress::Base::Common::BEGIN@461 # spent 33µs making 1 call to constant::import
462 | 3 | 25µs | 2 | 60µs | # spent 34µs (7+27) within IO::Compress::Base::Common::BEGIN@462 which was called # once (7µs+27µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 462 use constant Parse_unsigned => 0x02; # spent 34µs making 1 call to IO::Compress::Base::Common::BEGIN@462 # spent 27µs making 1 call to constant::import
463 | 3 | 24µs | 2 | 57µs | # spent 32µs (7+25) within IO::Compress::Base::Common::BEGIN@463 which was called # once (7µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 463 use constant Parse_signed => 0x04; # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@463 # spent 25µs making 1 call to constant::import
464 | 3 | 24µs | 2 | 72µs | # spent 40µs (7+33) within IO::Compress::Base::Common::BEGIN@464 which was called # once (7µs+33µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 464 use constant Parse_boolean => 0x08; # spent 40µs making 1 call to IO::Compress::Base::Common::BEGIN@464 # spent 33µs making 1 call to constant::import
465 | 3 | 33µs | 2 | 57µs | # spent 32µs (6+25) within IO::Compress::Base::Common::BEGIN@465 which was called # once (6µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 465 use constant Parse_string => 0x10; # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@465 # spent 25µs making 1 call to constant::import
466 | 3 | 26µs | 2 | 79µs | # spent 47µs (16+32) within IO::Compress::Base::Common::BEGIN@466 which was called # once (16µs+32µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 466 use constant Parse_custom => 0x12; # spent 47µs making 1 call to IO::Compress::Base::Common::BEGIN@466 # spent 32µs making 1 call to constant::import
467 |  |  |  |  |
468 |  |  |  |  | #use constant Parse_store_ref => 0x100 ;
469 | 3 | 25µs | 2 | 58µs | # spent 32µs (6+26) within IO::Compress::Base::Common::BEGIN@469 which was called # once (6µs+26µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 469 use constant Parse_multiple => 0x100 ; # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@469 # spent 26µs making 1 call to constant::import
470 | 3 | 26µs | 2 | 58µs | # spent 33µs (8+25) within IO::Compress::Base::Common::BEGIN@470 which was called # once (8µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 470 use constant Parse_writable => 0x200 ; # spent 33µs making 1 call to IO::Compress::Base::Common::BEGIN@470 # spent 25µs making 1 call to constant::import
471 | 3 | 23µs | 2 | 58µs | # spent 32µs (6+26) within IO::Compress::Base::Common::BEGIN@471 which was called # once (6µs+26µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 471 use constant Parse_writable_scalar => 0x400 | Parse_writable ; # spent 32µs making 1 call to IO::Compress::Base::Common::BEGIN@471 # spent 26µs making 1 call to constant::import
472 |  |  |  |  |
473 | 3 | 23µs | 2 | 56µs | # spent 31µs (6+25) within IO::Compress::Base::Common::BEGIN@473 which was called # once (6µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 473 use constant OFF_PARSED => 0 ; # spent 31µs making 1 call to IO::Compress::Base::Common::BEGIN@473 # spent 25µs making 1 call to constant::import
474 | 3 | 22µs | 2 | 55µs | # spent 30µs (6+24) within IO::Compress::Base::Common::BEGIN@474 which was called # once (6µs+24µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 474 use constant OFF_TYPE => 1 ; # spent 30µs making 1 call to IO::Compress::Base::Common::BEGIN@474 # spent 24µs making 1 call to constant::import
475 | 3 | 37µs | 2 | 61µs | # spent 38µs (15+23) within IO::Compress::Base::Common::BEGIN@475 which was called # once (15µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 475 use constant OFF_DEFAULT => 2 ; # spent 38µs making 1 call to IO::Compress::Base::Common::BEGIN@475 # spent 23µs making 1 call to constant::import
476 | 3 | 24µs | 2 | 62µs | # spent 35µs (8+27) within IO::Compress::Base::Common::BEGIN@476 which was called # once (8µs+27µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 476 use constant OFF_FIXED => 3 ; # spent 35µs making 1 call to IO::Compress::Base::Common::BEGIN@476 # spent 27µs making 1 call to constant::import
477 | 3 | 21µs | 2 | 63µs | # spent 34µs (6+28) within IO::Compress::Base::Common::BEGIN@477 which was called # once (6µs+28µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 477 use constant OFF_FIRST_ONLY => 4 ; # spent 34µs making 1 call to IO::Compress::Base::Common::BEGIN@477 # spent 28µs making 1 call to constant::import
478 | 3 | 103µs | 2 | 53µs | # spent 29µs (6+23) within IO::Compress::Base::Common::BEGIN@478 which was called # once (6µs+23µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 478 use constant OFF_STICKY => 5 ; # spent 29µ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 | 15µs | # spent 12µs (10+3) within IO::Compress::Base::Common::BEGIN@501 which was called # once (10µs+3µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 501 use strict; # spent 12µs making 1 call to IO::Compress::Base::Common::BEGIN@501 # spent 3µs making 1 call to strict::import
502 | 3 | 19µs | 2 | 31µs | # spent 20µs (8+12) within IO::Compress::Base::Common::BEGIN@502 which was called # once (8µs+12µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 502 use warnings; # spent 20µs making 1 call to IO::Compress::Base::Common::BEGIN@502 # spent 12µs making 1 call to warnings::import
503 | 3 | 1.15ms | 2 | 69µs | # spent 38µs (7+31) within IO::Compress::Base::Common::BEGIN@503 which was called # once (7µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 503 use Carp; # spent 38µs making 1 call to IO::Compress::Base::Common::BEGIN@503 # spent 31µ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 | 26µs | 2 | 72µs | # spent 40µs (8+32) within U64::BEGIN@818 which was called # once (8µs+32µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 818 use constant MAX32 => 0xFFFFFFFF ; # spent 40µs making 1 call to U64::BEGIN@818 # spent 32µs making 1 call to constant::import
819 | 3 | 23µs | 2 | 57µs | # spent 32µs (6+25) within U64::BEGIN@819 which was called # once (6µs+25µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 819 use constant LOW => 0 ; # spent 32µs making 1 call to U64::BEGIN@819 # spent 25µs making 1 call to constant::import
820 | 3 | 386µs | 2 | 71µs | # spent 41µs (10+31) within U64::BEGIN@820 which was called # once (10µs+31µs) by IO::Uncompress::RawInflate::BEGIN@9 at line 820 use constant HIGH => 1; # spent 41µ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;