Profile of Digest/SHA.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/5.38.2/x86_64-linux/Digest/SHA.pm
Statements | Executed 30 statements in 1.25ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 9µs | 10µs | Digest::SHA::::BEGIN@5Digest::SHA::BEGIN@5
1 | 1 | 1 | 8µs | 10µs | Digest::SHA::::BEGIN@202Digest::SHA::BEGIN@202
1 | 1 | 1 | 5µs | 19µs | Digest::SHA::::BEGIN@9Digest::SHA::BEGIN@9
1 | 1 | 1 | 5µs | 7µs | Digest::SHA::::BEGIN@10Digest::SHA::BEGIN@10
1 | 1 | 1 | 4µs | 31µs | Digest::SHA::::BEGIN@7Digest::SHA::BEGIN@7
1 | 1 | 1 | 4µs | 20µs | Digest::SHA::::BEGIN@8Digest::SHA::BEGIN@8
1 | 1 | 1 | 3µs | 3µs | Digest::SHA::::BEGIN@56Digest::SHA::BEGIN@56
1 | 1 | 1 | 3µs | 18µs | Digest::SHA::::BEGIN@6Digest::SHA::BEGIN@6
0 | 0 | 0 | 0s | 0s | Digest::SHA::::_addfileDigest::SHA::_addfile
0 | 0 | 0 | 0s | 0s | Digest::SHA::::_bailDigest::SHA::_bail
0 | 0 | 0 | 0s | 0s | Digest::SHA::::_istextDigest::SHA::_istext
0 | 0 | 0 | 0s | 0s | Digest::SHA::::add_bitsDigest::SHA::add_bits
0 | 0 | 0 | 0s | 0s | Digest::SHA::::addfileDigest::SHA::addfile
0 | 0 | 0 | 0s | 0s | Digest::SHA::::dumpDigest::SHA::dump
0 | 0 | 0 | 0s | 0s | Digest::SHA::::getstateDigest::SHA::getstate
0 | 0 | 0 | 0s | 0s | Digest::SHA::::loadDigest::SHA::load
0 | 0 | 0 | 0s | 0s | Digest::SHA::::newDigest::SHA::new
0 | 0 | 0 | 0s | 0s | Digest::SHA::::putstateDigest::SHA::putstate

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Digest::SHA;
2 |  |  |  |  |
3 | 1 | 6µs |  |  | require 5.003000;
4 |  |  |  |  |
5 | 2 | 16µs | 2 | 12µs | # spent 10µs (9+1) within Digest::SHA::BEGIN@5 which was called: # once (9µs+1µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 5 use strict; # spent 10µs making 1 call to Digest::SHA::BEGIN@5 # spent 1µs making 1 call to strict::import
6 | 2 | 22µs | 2 | 32µs | # spent 18µs (3+15) within Digest::SHA::BEGIN@6 which was called: # once (3µs+15µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 6 use warnings; # spent 18µs making 1 call to Digest::SHA::BEGIN@6 # spent 15µs making 1 call to warnings::import
7 | 2 | 16µs | 2 | 58µs | # spent 31µs (4+27) within Digest::SHA::BEGIN@7 which was called: # once (4µs+27µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 7 use vars qw($VERSION @ISA @EXPORT_OK $errmsg); # spent 31µs making 1 call to Digest::SHA::BEGIN@7 # spent 27µs making 1 call to vars::import
8 | 2 | 14µs | 2 | 36µs | # spent 20µs (4+16) within Digest::SHA::BEGIN@8 which was called: # once (4µs+16µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 8 use Fcntl qw(O_RDONLY O_RDWR); # spent 20µs making 1 call to Digest::SHA::BEGIN@8 # spent 16µs making 1 call to Exporter::import
9 | 2 | 16µs | 2 | 34µs | # spent 19µs (5+14) within Digest::SHA::BEGIN@9 which was called: # once (5µs+14µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 9 use Cwd qw(getcwd); # spent 19µs making 1 call to Digest::SHA::BEGIN@9 # spent 14µs making 1 call to Exporter::import
10 | 2 | 130µs | 2 | 9µs | # spent 7µs (5+2) within Digest::SHA::BEGIN@10 which was called: # once (5µs+2µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 10 use integer; # spent 7µs making 1 call to Digest::SHA::BEGIN@10 # spent 2µs making 1 call to integer::import
11 |  |  |  |  |
12 | 1 | 200ns |  |  | $VERSION = '6.04';
13 |  |  |  |  |
14 | 1 | 300ns |  |  | require Exporter;
15 | 1 | 5µs |  |  | @ISA = qw(Exporter);
16 | 1 | 2µs |  |  | @EXPORT_OK = qw(
17 |  |  |  |  | $errmsg
18 |  |  |  |  | hmac_sha1 hmac_sha1_base64 hmac_sha1_hex
19 |  |  |  |  | hmac_sha224 hmac_sha224_base64 hmac_sha224_hex
20 |  |  |  |  | hmac_sha256 hmac_sha256_base64 hmac_sha256_hex
21 |  |  |  |  | hmac_sha384 hmac_sha384_base64 hmac_sha384_hex
22 |  |  |  |  | hmac_sha512 hmac_sha512_base64 hmac_sha512_hex
23 |  |  |  |  | hmac_sha512224 hmac_sha512224_base64 hmac_sha512224_hex
24 |  |  |  |  | hmac_sha512256 hmac_sha512256_base64 hmac_sha512256_hex
25 |  |  |  |  | sha1 sha1_base64 sha1_hex
26 |  |  |  |  | sha224 sha224_base64 sha224_hex
27 |  |  |  |  | sha256 sha256_base64 sha256_hex
28 |  |  |  |  | sha384 sha384_base64 sha384_hex
29 |  |  |  |  | sha512 sha512_base64 sha512_hex
30 |  |  |  |  | sha512224 sha512224_base64 sha512224_hex
31 |  |  |  |  | sha512256 sha512256_base64 sha512256_hex);
32 |  |  |  |  |
33 |  |  |  |  | # Inherit from Digest::base if possible
34 |  |  |  |  |
35 | 1 | 200ns |  |  | eval {
36 | 1 | 62µs |  |  | require Digest::base;
37 | 1 | 5µs |  |  | push(@ISA, 'Digest::base');
38 |  |  |  |  | };
39 |  |  |  |  |
40 |  |  |  |  | # The following routines aren't time-critical, so they can be left in Perl
41 |  |  |  |  |
42 |  |  |  |  | sub new {
43 |  |  |  |  | my($class, $alg) = @_;
44 |  |  |  |  | $alg =~ s/\D+//g if defined $alg;
45 |  |  |  |  | if (ref($class)) { # instance method
46 |  |  |  |  | if (!defined($alg) || ($alg == $class->algorithm)) {
47 |  |  |  |  | sharewind($class);
48 |  |  |  |  | return($class);
49 |  |  |  |  | }
50 |  |  |  |  | return shainit($class, $alg) ? $class : undef;
51 |  |  |  |  | }
52 |  |  |  |  | $alg = 1 unless defined $alg;
53 |  |  |  |  | return $class->newSHA($alg);
54 |  |  |  |  | }
55 |  |  |  |  |
56 | 1 | 588µs | 1 | 3µs | # spent 3µs within Digest::SHA::BEGIN@56 which was called: # once (3µs+0s) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 56 BEGIN { *reset = \&new } # spent 3µs making 1 call to Digest::SHA::BEGIN@56
57 |  |  |  |  |
58 |  |  |  |  | sub add_bits {
59 |  |  |  |  | my($self, $data, $nbits) = @_;
60 |  |  |  |  | unless (defined $nbits) {
61 |  |  |  |  | $nbits = length($data);
62 |  |  |  |  | $data = pack("B*", $data);
63 |  |  |  |  | }
64 |  |  |  |  | $nbits = length($data) * 8 if $nbits > length($data) * 8;
65 |  |  |  |  | shawrite($data, $nbits, $self);
66 |  |  |  |  | return($self);
67 |  |  |  |  | }
68 |  |  |  |  |
69 |  |  |  |  | sub _bail {
70 |  |  |  |  | my $msg = shift;
71 |  |  |  |  |
72 |  |  |  |  | $errmsg = $!;
73 |  |  |  |  | $msg .= ": $!";
74 |  |  |  |  | require Carp;
75 |  |  |  |  | Carp::croak($msg);
76 |  |  |  |  | }
77 |  |  |  |  |
78 |  |  |  |  | {
79 | 1 | 300ns |  |  | my $_can_T_filehandle;
80 |  |  |  |  |
81 |  |  |  |  | sub _istext {
82 |  |  |  |  | local *FH = shift;
83 |  |  |  |  | my $file = shift;
84 |  |  |  |  |
85 |  |  |  |  | if (! defined $_can_T_filehandle) {
86 |  |  |  |  | local $^W = 0;
87 |  |  |  |  | my $istext = eval { -T FH };
88 |  |  |  |  | $_can_T_filehandle = $@ ? 0 : 1;
89 |  |  |  |  | return $_can_T_filehandle ? $istext : -T $file;
90 |  |  |  |  | }
91 |  |  |  |  | return $_can_T_filehandle ? -T FH : -T $file;
92 |  |  |  |  | }
93 |  |  |  |  | }
94 |  |  |  |  |
95 | 1 | 200ns |  |  | sub _addfile {
96 |  |  |  |  | my ($self, $handle) = @_;
97 |  |  |  |  |
98 |  |  |  |  | my $n;
99 |  |  |  |  | my $buf = "";
100 |  |  |  |  |
101 |  |  |  |  | while (($n = read($handle, $buf, 4096))) {
102 |  |  |  |  | $self->add($buf);
103 |  |  |  |  | }
104 |  |  |  |  | _bail("Read failed") unless defined $n;
105 |  |  |  |  |
106 |  |  |  |  | $self;
107 |  |  |  |  | }
108 |  |  |  |  |
109 |  |  |  |  | sub addfile {
110 |  |  |  |  | my ($self, $file, $mode) = @_;
111 |  |  |  |  |
112 |  |  |  |  | return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
113 |  |  |  |  |
114 |  |  |  |  | $mode = defined($mode) ? $mode : "";
115 |  |  |  |  | my ($binary, $UNIVERSAL, $BITS) =
116 |  |  |  |  | map { $_ eq $mode } ("b", "U", "0");
117 |  |  |  |  |
118 |  |  |  |  | ## Always interpret "-" to mean STDIN; otherwise use
119 |  |  |  |  | ## sysopen to handle full range of POSIX file names.
120 |  |  |  |  | ## If $file is a directory, force an EISDIR error
121 |  |  |  |  | ## by attempting to open with mode O_RDWR
122 |  |  |  |  |
123 |  |  |  |  | local *FH;
124 |  |  |  |  | if ($file eq '-') {
125 |  |  |  |  | if (-d STDIN) {
126 |  |  |  |  | sysopen(FH, getcwd(), O_RDWR)
127 |  |  |  |  | or _bail('Open failed');
128 |  |  |  |  | }
129 |  |  |  |  | open(FH, '< -')
130 |  |  |  |  | or _bail('Open failed');
131 |  |  |  |  | }
132 |  |  |  |  | else {
133 |  |  |  |  | sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY)
134 |  |  |  |  | or _bail('Open failed');
135 |  |  |  |  | }
136 |  |  |  |  |
137 |  |  |  |  | if ($BITS) {
138 |  |  |  |  | my ($n, $buf) = (0, "");
139 |  |  |  |  | while (($n = read(FH, $buf, 4096))) {
140 |  |  |  |  | $buf =~ tr/01//cd;
141 |  |  |  |  | $self->add_bits($buf);
142 |  |  |  |  | }
143 |  |  |  |  | _bail("Read failed") unless defined $n;
144 |  |  |  |  | close(FH);
145 |  |  |  |  | return($self);
146 |  |  |  |  | }
147 |  |  |  |  |
148 |  |  |  |  | binmode(FH) if $binary || $UNIVERSAL;
149 |  |  |  |  | if ($UNIVERSAL && _istext(*FH, $file)) {
150 |  |  |  |  | $self->_addfileuniv(*FH);
151 |  |  |  |  | }
152 |  |  |  |  | else { $self->_addfilebin(*FH) }
153 |  |  |  |  | close(FH);
154 |  |  |  |  |
155 |  |  |  |  | $self;
156 |  |  |  |  | }
157 |  |  |  |  |
158 |  |  |  |  | sub getstate {
159 |  |  |  |  | my $self = shift;
160 |  |  |  |  |
161 |  |  |  |  | my $alg = $self->algorithm or return;
162 |  |  |  |  | my $state = $self->_getstate or return;
163 |  |  |  |  | my $nD = $alg <= 256 ? 8 : 16;
164 |  |  |  |  | my $nH = $alg <= 256 ? 32 : 64;
165 |  |  |  |  | my $nB = $alg <= 256 ? 64 : 128;
166 |  |  |  |  | my($H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) =
167 |  |  |  |  | $state =~ /^(.{$nH})(.{$nB})(.{4})(.{4})(.{4})(.{4})(.{4})$/s;
168 |  |  |  |  | for ($alg, $H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) {
169 |  |  |  |  | return unless defined $_;
170 |  |  |  |  | }
171 |  |  |  |  |
172 |  |  |  |  | my @s = ();
173 |  |  |  |  | push(@s, "alg:" . $alg);
174 |  |  |  |  | push(@s, "H:" . join(":", unpack("H*", $H) =~ /.{$nD}/g));
175 |  |  |  |  | push(@s, "block:" . join(":", unpack("H*", $block) =~ /.{2}/g));
176 |  |  |  |  | push(@s, "blockcnt:" . unpack("N", $blockcnt));
177 |  |  |  |  | push(@s, "lenhh:" . unpack("N", $lenhh));
178 |  |  |  |  | push(@s, "lenhl:" . unpack("N", $lenhl));
179 |  |  |  |  | push(@s, "lenlh:" . unpack("N", $lenlh));
180 |  |  |  |  | push(@s, "lenll:" . unpack("N", $lenll));
181 |  |  |  |  | join("\n", @s) . "\n";
182 |  |  |  |  | }
183 |  |  |  |  |
184 |  |  |  |  | sub putstate {
185 |  |  |  |  | my($class, $state) = @_;
186 |  |  |  |  |
187 |  |  |  |  | my %s = ();
188 |  |  |  |  | for (split(/\n/, $state)) {
189 |  |  |  |  | s/^\s+//;
190 |  |  |  |  | s/\s+$//;
191 |  |  |  |  | next if (/^(#|$)/);
192 |  |  |  |  | my @f = split(/[:\s]+/);
193 |  |  |  |  | my $tag = shift(@f);
194 |  |  |  |  | $s{$tag} = join('', @f);
195 |  |  |  |  | }
196 |  |  |  |  |
197 |  |  |  |  | # H and block may contain arbitrary values, but check everything else
198 |  |  |  |  | grep { $_ == $s{'alg'} } (1,224,256,384,512,512224,512256) or return;
199 |  |  |  |  | length($s{'H'}) == ($s{'alg'} <= 256 ? 64 : 128) or return;
200 |  |  |  |  | length($s{'block'}) == ($s{'alg'} <= 256 ? 128 : 256) or return;
201 |  |  |  |  | {
202 | 2 | 208µs | 2 | 12µs | # spent 10µs (8+2) within Digest::SHA::BEGIN@202 which was called: # once (8µs+2µs) by Spreadsheet::ParseXLSX::Decryptor::BEGIN@12 at line 202 no integer; # spent 10µs making 1 call to Digest::SHA::BEGIN@202 # spent 2µs making 1 call to integer::unimport
203 |  |  |  |  | for (qw(blockcnt lenhh lenhl lenlh lenll)) {
204 |  |  |  |  | 0 <= $s{$_} or return;
205 |  |  |  |  | $s{$_} <= 4294967295 or return;
206 |  |  |  |  | }
207 |  |  |  |  | $s{'blockcnt'} < ($s{'alg'} <= 256 ? 512 : 1024) or return;
208 |  |  |  |  | }
209 |  |  |  |  |
210 |  |  |  |  | my $packed_state = (
211 |  |  |  |  | pack("H*", $s{'H'}) .
212 |  |  |  |  | pack("H*", $s{'block'}) .
213 |  |  |  |  | pack("N", $s{'blockcnt'}) .
214 |  |  |  |  | pack("N", $s{'lenhh'}) .
215 |  |  |  |  | pack("N", $s{'lenhl'}) .
216 |  |  |  |  | pack("N", $s{'lenlh'}) .
217 |  |  |  |  | pack("N", $s{'lenll'})
218 |  |  |  |  | );
219 |  |  |  |  |
220 |  |  |  |  | return $class->new($s{'alg'})->_putstate($packed_state);
221 |  |  |  |  | }
222 |  |  |  |  |
223 |  |  |  |  | sub dump {
224 |  |  |  |  | my $self = shift;
225 |  |  |  |  | my $file = shift;
226 |  |  |  |  |
227 |  |  |  |  | my $state = $self->getstate or return;
228 |  |  |  |  | $file = "-" if (!defined($file) || $file eq "");
229 |  |  |  |  |
230 |  |  |  |  | local *FH;
231 |  |  |  |  | open(FH, "> $file") or return;
232 |  |  |  |  | print FH $state;
233 |  |  |  |  | close(FH);
234 |  |  |  |  |
235 |  |  |  |  | return($self);
236 |  |  |  |  | }
237 |  |  |  |  |
238 |  |  |  |  | sub load {
239 |  |  |  |  | my $class = shift;
240 |  |  |  |  | my $file = shift;
241 |  |  |  |  |
242 |  |  |  |  | $file = "-" if (!defined($file) || $file eq "");
243 |  |  |  |  |
244 |  |  |  |  | local *FH;
245 |  |  |  |  | open(FH, "< $file") or return;
246 |  |  |  |  | my $str = join('', <FH>);
247 |  |  |  |  | close(FH);
248 |  |  |  |  |
249 |  |  |  |  | $class->putstate($str);
250 |  |  |  |  | }
251 |  |  |  |  |
252 |  |  |  |  | eval {
253 | 1 | 500ns |  |  | require XSLoader;
254 | 1 | 153µs | 1 | 148µs | XSLoader::load('Digest::SHA', $VERSION); # spent 148µs making 1 call to XSLoader::load
255 | 1 | 500ns |  |  | 1;
256 | 1 | 500ns |  |  | } or do {
257 |  |  |  |  | require DynaLoader;
258 |  |  |  |  | push @ISA, 'DynaLoader';
259 |  |  |  |  | Digest::SHA->bootstrap($VERSION);
260 |  |  |  |  | };
261 |  |  |  |  |
262 | 1 | 7µs |  |  | 1;
263 |  |  |  |  | __END__