← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:01 2022

Filename/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/darwin-2level/Digest/SHA.pm
StatementsExecuted 28 statements in 5.87ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111920µs1.06msDigest::SHA::::BEGIN@7Digest::SHA::BEGIN@7
111703µs705µsDigest::SHA::::BEGIN@9Digest::SHA::BEGIN@9
11120µs23µsDigest::SHA::::BEGIN@5Digest::SHA::BEGIN@5
1117µs31µsDigest::SHA::::BEGIN@8Digest::SHA::BEGIN@8
1115µs8µsDigest::SHA::::BEGIN@192Digest::SHA::BEGIN@192
1115µs33µsDigest::SHA::::BEGIN@6Digest::SHA::BEGIN@6
1114µs4µsDigest::SHA::::BEGIN@55Digest::SHA::BEGIN@55
0000s0sDigest::SHA::::_addfileDigest::SHA::_addfile
0000s0sDigest::SHA::::_bailDigest::SHA::_bail
0000s0sDigest::SHA::::_istextDigest::SHA::_istext
0000s0sDigest::SHA::::add_bitsDigest::SHA::add_bits
0000s0sDigest::SHA::::addfileDigest::SHA::addfile
0000s0sDigest::SHA::::dumpDigest::SHA::dump
0000s0sDigest::SHA::::getstateDigest::SHA::getstate
0000s0sDigest::SHA::::loadDigest::SHA::load
0000s0sDigest::SHA::::newDigest::SHA::new
0000s0sDigest::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
1package Digest::SHA;
2
317µsrequire 5.003000;
4
5227µs226µs
# spent 23µs (20+3) within Digest::SHA::BEGIN@5 which was called: # once (20µs+3µs) by Mojo::Util::BEGIN@7 at line 5
use strict;
# spent 23µs making 1 call to Digest::SHA::BEGIN@5 # spent 3µs making 1 call to strict::import
6222µs261µs
# spent 33µs (5+28) within Digest::SHA::BEGIN@6 which was called: # once (5µs+28µs) by Mojo::Util::BEGIN@7 at line 6
use warnings;
# spent 33µs making 1 call to Digest::SHA::BEGIN@6 # spent 28µs making 1 call to warnings::import
72612µs21.14ms
# spent 1.06ms (920µs+143µs) within Digest::SHA::BEGIN@7 which was called: # once (920µs+143µs) by Mojo::Util::BEGIN@7 at line 7
use vars qw($VERSION @ISA @EXPORT_OK $errmsg);
# spent 1.06ms making 1 call to Digest::SHA::BEGIN@7 # spent 76µs making 1 call to vars::import
8217µs255µs
# spent 31µs (7+24) within Digest::SHA::BEGIN@8 which was called: # once (7µs+24µs) by Mojo::Util::BEGIN@7 at line 8
use Fcntl qw(O_RDONLY O_RDWR);
# spent 31µs making 1 call to Digest::SHA::BEGIN@8 # spent 24µs making 1 call to Exporter::import
92832µs2707µs
# spent 705µs (703+2) within Digest::SHA::BEGIN@9 which was called: # once (703µs+2µs) by Mojo::Util::BEGIN@7 at line 9
use integer;
# spent 705µs making 1 call to Digest::SHA::BEGIN@9 # spent 2µs making 1 call to integer::import
10
1111µs$VERSION = '6.02';
12
1310srequire Exporter;
1417µs@ISA = qw(Exporter);
1512µs@EXPORT_OK = qw(
16 $errmsg
17 hmac_sha1 hmac_sha1_base64 hmac_sha1_hex
18 hmac_sha224 hmac_sha224_base64 hmac_sha224_hex
19 hmac_sha256 hmac_sha256_base64 hmac_sha256_hex
20 hmac_sha384 hmac_sha384_base64 hmac_sha384_hex
21 hmac_sha512 hmac_sha512_base64 hmac_sha512_hex
22 hmac_sha512224 hmac_sha512224_base64 hmac_sha512224_hex
23 hmac_sha512256 hmac_sha512256_base64 hmac_sha512256_hex
24 sha1 sha1_base64 sha1_hex
25 sha224 sha224_base64 sha224_hex
26 sha256 sha256_base64 sha256_hex
27 sha384 sha384_base64 sha384_hex
28 sha512 sha512_base64 sha512_hex
29 sha512224 sha512224_base64 sha512224_hex
30 sha512256 sha512256_base64 sha512256_hex);
31
32# Inherit from Digest::base if possible
33
3411µseval {
3510s require Digest::base;
3614µs push(@ISA, 'Digest::base');
37};
38
39# The following routines aren't time-critical, so they can be left in Perl
40
41sub new {
42 my($class, $alg) = @_;
43 $alg =~ s/\D+//g if defined $alg;
44 if (ref($class)) { # instance method
45 if (!defined($alg) || ($alg == $class->algorithm)) {
46 sharewind($class);
47 return($class);
48 }
49 return shainit($class, $alg) ? $class : undef;
50 }
51 $alg = 1 unless defined $alg;
52 return $class->newSHA($alg);
53}
54
551525µs14µs
# spent 4µs within Digest::SHA::BEGIN@55 which was called: # once (4µs+0s) by Mojo::Util::BEGIN@7 at line 55
BEGIN { *reset = \&new }
# spent 4µs making 1 call to Digest::SHA::BEGIN@55
56
57sub add_bits {
58 my($self, $data, $nbits) = @_;
59 unless (defined $nbits) {
60 $nbits = length($data);
61 $data = pack("B*", $data);
62 }
63 $nbits = length($data) * 8 if $nbits > length($data) * 8;
64 shawrite($data, $nbits, $self);
65 return($self);
66}
67
68sub _bail {
69 my $msg = shift;
70
71 $errmsg = $!;
72 $msg .= ": $!";
73 require Carp;
74 Carp::croak($msg);
75}
76
77{
7810s my $_can_T_filehandle;
79
80 sub _istext {
81 local *FH = shift;
82 my $file = shift;
83
84 if (! defined $_can_T_filehandle) {
85 local $^W = 0;
86 my $istext = eval { -T FH };
87 $_can_T_filehandle = $@ ? 0 : 1;
88 return $_can_T_filehandle ? $istext : -T $file;
89 }
90 return $_can_T_filehandle ? -T FH : -T $file;
91 }
92}
93
9411µssub _addfile {
95 my ($self, $handle) = @_;
96
97 my $n;
98 my $buf = "";
99
100 while (($n = read($handle, $buf, 4096))) {
101 $self->add($buf);
102 }
103 _bail("Read failed") unless defined $n;
104
105 $self;
106}
107
108sub addfile {
109 my ($self, $file, $mode) = @_;
110
111 return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
112
113 $mode = defined($mode) ? $mode : "";
114 my ($binary, $UNIVERSAL, $BITS) =
115 map { $_ eq $mode } ("b", "U", "0");
116
117 ## Always interpret "-" to mean STDIN; otherwise use
118 ## sysopen to handle full range of POSIX file names.
119 ## If $file is a directory, force an EISDIR error
120 ## by attempting to open with mode O_RDWR
121
122 local *FH;
123 $file eq '-' and open(FH, '< -')
124 or sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY)
125 or _bail('Open failed');
126
127 if ($BITS) {
128 my ($n, $buf) = (0, "");
129 while (($n = read(FH, $buf, 4096))) {
130 $buf =~ tr/01//cd;
131 $self->add_bits($buf);
132 }
133 _bail("Read failed") unless defined $n;
134 close(FH);
135 return($self);
136 }
137
138 binmode(FH) if $binary || $UNIVERSAL;
139 if ($UNIVERSAL && _istext(*FH, $file)) {
140 $self->_addfileuniv(*FH);
141 }
142 else { $self->_addfilebin(*FH) }
143 close(FH);
144
145 $self;
146}
147
148sub getstate {
149 my $self = shift;
150
151 my $alg = $self->algorithm or return;
152 my $state = $self->_getstate or return;
153 my $nD = $alg <= 256 ? 8 : 16;
154 my $nH = $alg <= 256 ? 32 : 64;
155 my $nB = $alg <= 256 ? 64 : 128;
156 my($H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) =
157 $state =~ /^(.{$nH})(.{$nB})(.{4})(.{4})(.{4})(.{4})(.{4})$/s;
158 for ($alg, $H, $block, $blockcnt, $lenhh, $lenhl, $lenlh, $lenll) {
159 return unless defined $_;
160 }
161
162 my @s = ();
163 push(@s, "alg:" . $alg);
164 push(@s, "H:" . join(":", unpack("H*", $H) =~ /.{$nD}/g));
165 push(@s, "block:" . join(":", unpack("H*", $block) =~ /.{2}/g));
166 push(@s, "blockcnt:" . unpack("N", $blockcnt));
167 push(@s, "lenhh:" . unpack("N", $lenhh));
168 push(@s, "lenhl:" . unpack("N", $lenhl));
169 push(@s, "lenlh:" . unpack("N", $lenlh));
170 push(@s, "lenll:" . unpack("N", $lenll));
171 join("\n", @s) . "\n";
172}
173
174sub putstate {
175 my($class, $state) = @_;
176
177 my %s = ();
178 for (split(/\n/, $state)) {
179 s/^\s+//;
180 s/\s+$//;
181 next if (/^(#|$)/);
182 my @f = split(/[:\s]+/);
183 my $tag = shift(@f);
184 $s{$tag} = join('', @f);
185 }
186
187 # H and block may contain arbitrary values, but check everything else
188 grep { $_ == $s{'alg'} } (1,224,256,384,512,512224,512256) or return;
189 length($s{'H'}) == ($s{'alg'} <= 256 ? 64 : 128) or return;
190 length($s{'block'}) == ($s{'alg'} <= 256 ? 128 : 256) or return;
191 {
1922237µs211µs
# spent 8µs (5+3) within Digest::SHA::BEGIN@192 which was called: # once (5µs+3µs) by Mojo::Util::BEGIN@7 at line 192
no integer;
# spent 8µs making 1 call to Digest::SHA::BEGIN@192 # spent 3µs making 1 call to integer::unimport
193 for (qw(blockcnt lenhh lenhl lenlh lenll)) {
194 0 <= $s{$_} or return;
195 $s{$_} <= 4294967295 or return;
196 }
197 $s{'blockcnt'} < ($s{'alg'} <= 256 ? 512 : 1024) or return;
198 }
199
200 my $packed_state = (
201 pack("H*", $s{'H'}) .
202 pack("H*", $s{'block'}) .
203 pack("N", $s{'blockcnt'}) .
204 pack("N", $s{'lenhh'}) .
205 pack("N", $s{'lenhl'}) .
206 pack("N", $s{'lenlh'}) .
207 pack("N", $s{'lenll'})
208 );
209
210 return $class->new($s{'alg'})->_putstate($packed_state);
211}
212
213sub dump {
214 my $self = shift;
215 my $file = shift;
216
217 my $state = $self->getstate or return;
218 $file = "-" if (!defined($file) || $file eq "");
219
220 local *FH;
221 open(FH, "> $file") or return;
222 print FH $state;
223 close(FH);
224
225 return($self);
226}
227
228sub load {
229 my $class = shift;
230 my $file = shift;
231
232 $file = "-" if (!defined($file) || $file eq "");
233
234 local *FH;
235 open(FH, "< $file") or return;
236 my $str = join('', <FH>);
237 close(FH);
238
239 $class->putstate($str);
240}
241
242eval {
24310s require XSLoader;
24413.56ms13.55ms XSLoader::load('Digest::SHA', $VERSION);
# spent 3.55ms making 1 call to XSLoader::load
24511µs 1;
24611µs} or do {
247 require DynaLoader;
248 push @ISA, 'DynaLoader';
249 Digest::SHA->bootstrap($VERSION);
250};
251
252111µs1;
253__END__