← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:14 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/darwin-2level/Storable.pm
StatementsExecuted 41 statements in 657ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111650ms650msStorable::::pretrieveStorable::pretrieve (xsub)
111103µs103µsStorable::::CORE:openStorable::CORE:open (opcode)
11183µs650msStorable::::_retrieveStorable::_retrieve
11171µs71µsStorable::::BEGIN@27Storable::BEGIN@27
11129µs117µsStorable::::BEGIN@23Storable::BEGIN@23
11120µs20µsStorable::::CORE:closeStorable::CORE:close (opcode)
11115µs328µsStorable::::BEGIN@59Storable::BEGIN@59
11112µs650msStorable::::retrieveStorable::retrieve
1113µs3µsStorable::::CORE:binmodeStorable::CORE:binmode (opcode)
1112µs2µsStorable::::CORE:substStorable::CORE:subst (opcode)
0000s0sStorable::::BIN_VERSION_NVStorable::BIN_VERSION_NV
0000s0sStorable::::BIN_WRITE_VERSION_NVStorable::BIN_WRITE_VERSION_NV
0000s0sStorable::::CAN_FLOCKStorable::CAN_FLOCK
0000s0sStorable::::CLONEStorable::CLONE
0000s0sStorable::::__ANON__[:45]Storable::__ANON__[:45]
0000s0sStorable::::__ANON__[:51]Storable::__ANON__[:51]
0000s0sStorable::::_freezeStorable::_freeze
0000s0sStorable::::_storeStorable::_store
0000s0sStorable::::_store_fdStorable::_store_fd
0000s0sStorable::::fd_retrieveStorable::fd_retrieve
0000s0sStorable::::file_magicStorable::file_magic
0000s0sStorable::::freezeStorable::freeze
0000s0sStorable::::lock_nstoreStorable::lock_nstore
0000s0sStorable::::lock_retrieveStorable::lock_retrieve
0000s0sStorable::::lock_storeStorable::lock_store
0000s0sStorable::::nfreezeStorable::nfreeze
0000s0sStorable::::nstoreStorable::nstore
0000s0sStorable::::nstore_fdStorable::nstore_fd
0000s0sStorable::::read_magicStorable::read_magic
0000s0sStorable::::retrieve_fdStorable::retrieve_fd
0000s0sStorable::::show_file_magicStorable::show_file_magic
0000s0sStorable::::storeStorable::store
0000s0sStorable::::store_fdStorable::store_fd
0000s0sStorable::::thawStorable::thaw
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#
2# Copyright (c) 1995-2001, Raphael Manfredi
3# Copyright (c) 2002-2014 by the Perl 5 Porters
4#
5# You may redistribute only under the same terms as Perl 5, as specified
6# in the README file that comes with the distribution.
7#
8
911µsrequire XSLoader;
1011µsrequire Exporter;
11113µspackage Storable; @ISA = qw(Exporter);
12
1311µs@EXPORT = qw(store retrieve);
1411µs@EXPORT_OK = qw(
15 nstore store_fd nstore_fd fd_retrieve
16 freeze nfreeze thaw
17 dclone
18 retrieve_fd
19 lock_store lock_nstore lock_retrieve
20 file_magic read_magic
21);
22
232292µs2205µs
# spent 117µs (29+88) within Storable::BEGIN@23 which was called: # once (29µs+88µs) by CPAN::has_inst at line 23
use vars qw($canonical $forgive_me $VERSION);
# spent 117µs making 1 call to Storable::BEGIN@23 # spent 88µs making 1 call to vars::import
24
2510s$VERSION = '2.62';
26
27
# spent 71µs within Storable::BEGIN@27 which was called: # once (71µs+0s) by CPAN::has_inst at line 53
BEGIN {
2810s if (eval {
2915µs local $SIG{__DIE__};
3015µs local @INC = @INC;
3111µs pop @INC if $INC[-1] eq '.';
32143µs require Log::Agent;
33 1;
34 }) {
35 Log::Agent->import;
36 }
37 #
38 # Use of Log::Agent is optional. If it hasn't imported these subs then
39 # provide a fallback implementation.
40 #
4113µs unless ($Storable::{logcroak} && *{$Storable::{logcroak}}{CODE}) {
4211µs require Carp;
43 *logcroak = sub {
44 Carp::croak(@_);
4513µs };
46 }
4717µs unless ($Storable::{logcarp} && *{$Storable::{logcarp}}{CODE}) {
4810s require Carp;
49 *logcarp = sub {
50 Carp::carp(@_);
5111µs };
52 }
53185µs171µs}
# spent 71µs making 1 call to Storable::BEGIN@27
54
55#
56# They might miss :flock in Fcntl
57#
58
59
# spent 328µs (15+313) within Storable::BEGIN@59 which was called: # once (15µs+313µs) by CPAN::has_inst at line 68
BEGIN {
60315µs1313µs if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
# spent 313µs making 1 call to Exporter::import
61 Fcntl->import(':flock');
62 } else {
63 eval q{
64 sub LOCK_SH () {1}
65 sub LOCK_EX () {2}
66 };
67 }
6814.59ms1328µs}
# spent 328µs making 1 call to Storable::BEGIN@59
69
70sub CLONE {
71 # clone context under threads
72 Storable::init_perinterp();
73}
74
75# By default restricted hashes are downgraded on earlier perls.
76
7710s$Storable::downgrade_restricted = 1;
7810s$Storable::accept_future_minor = 1;
79
8011.65ms11.64msXSLoader::load('Storable', $Storable::VERSION);
# spent 1.64ms making 1 call to XSLoader::load
81
82#
83# Determine whether locking is possible, but only when needed.
84#
85
8610ssub CAN_FLOCK; my $CAN_FLOCK; sub CAN_FLOCK {
87 return $CAN_FLOCK if defined $CAN_FLOCK;
88 require Config; import Config;
89 return $CAN_FLOCK =
90 $Config{'d_flock'} ||
91 $Config{'d_fcntl_can_lock'} ||
92 $Config{'d_lockf'};
93}
94
95sub show_file_magic {
96 print <<EOM;
97#
98# To recognize the data files of the Perl module Storable,
99# the following lines need to be added to the local magic(5) file,
100# usually either /usr/share/misc/magic or /etc/magic.
101#
1020 string perl-store perl Storable(v0.6) data
103>4 byte >0 (net-order %d)
104>>4 byte &01 (network-ordered)
105>>4 byte =3 (major 1)
106>>4 byte =2 (major 1)
107
1080 string pst0 perl Storable(v0.7) data
109>4 byte >0
110>>4 byte &01 (network-ordered)
111>>4 byte =5 (major 2)
112>>4 byte =4 (major 2)
113>>5 byte >0 (minor %d)
114EOM
115}
116
117sub file_magic {
118 require IO::File;
119
120 my $file = shift;
121 my $fh = IO::File->new;
122 open($fh, "<", $file) || die "Can't open '$file': $!";
123 binmode($fh);
124 defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!";
125 close($fh);
126
127 $file = "./$file" unless $file; # ensure TRUE value
128
129 return read_magic($buf, $file);
130}
131
132sub read_magic {
133 my($buf, $file) = @_;
134 my %info;
135
136 my $buflen = length($buf);
137 my $magic;
138 if ($buf =~ s/^(pst0|perl-store)//) {
139 $magic = $1;
140 $info{file} = $file || 1;
141 }
142 else {
143 return undef if $file;
144 $magic = "";
145 }
146
147 return undef unless length($buf);
148
149 my $net_order;
150 if ($magic eq "perl-store" && ord(substr($buf, 0, 1)) > 1) {
151 $info{version} = -1;
152 $net_order = 0;
153 }
154 else {
155 $buf =~ s/(.)//s;
156 my $major = (ord $1) >> 1;
157 return undef if $major > 4; # sanity (assuming we never go that high)
158 $info{major} = $major;
159 $net_order = (ord $1) & 0x01;
160 if ($major > 1) {
161 return undef unless $buf =~ s/(.)//s;
162 my $minor = ord $1;
163 $info{minor} = $minor;
164 $info{version} = "$major.$minor";
165 $info{version_nv} = sprintf "%d.%03d", $major, $minor;
166 }
167 else {
168 $info{version} = $major;
169 }
170 }
171 $info{version_nv} ||= $info{version};
172 $info{netorder} = $net_order;
173
174 unless ($net_order) {
175 return undef unless $buf =~ s/(.)//s;
176 my $len = ord $1;
177 return undef unless length($buf) >= $len;
178 return undef unless $len == 4 || $len == 8; # sanity
179 @info{qw(byteorder intsize longsize ptrsize)}
180 = unpack "a${len}CCC", $buf;
181 (substr $buf, 0, $len + 3) = '';
182 if ($info{version_nv} >= 2.002) {
183 return undef unless $buf =~ s/(.)//s;
184 $info{nvsize} = ord $1;
185 }
186 }
187 $info{hdrsize} = $buflen - length($buf);
188
189 return \%info;
190}
191
192sub BIN_VERSION_NV {
193 sprintf "%d.%03d", BIN_MAJOR(), BIN_MINOR();
194}
195
196sub BIN_WRITE_VERSION_NV {
197 sprintf "%d.%03d", BIN_MAJOR(), BIN_WRITE_MINOR();
198}
199
200#
201# store
202#
203# Store target object hierarchy, identified by a reference to its root.
204# The stored object tree may later be retrieved to memory via retrieve.
205# Returns undef if an I/O error occurred, in which case the file is
206# removed.
207#
208sub store {
209 return _store(\&pstore, @_, 0);
210}
211
212#
213# nstore
214#
215# Same as store, but in network order.
216#
217sub nstore {
218 return _store(\&net_pstore, @_, 0);
219}
220
221#
222# lock_store
223#
224# Same as store, but flock the file first (advisory locking).
225#
226sub lock_store {
227 return _store(\&pstore, @_, 1);
228}
229
230#
231# lock_nstore
232#
233# Same as nstore, but flock the file first (advisory locking).
234#
235sub lock_nstore {
236 return _store(\&net_pstore, @_, 1);
237}
238
239# Internal store to file routine
240sub _store {
241 my $xsptr = shift;
242 my $self = shift;
243 my ($file, $use_locking) = @_;
244 logcroak "not a reference" unless ref($self);
245 logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist
246 local *FILE;
247 if ($use_locking) {
248 open(FILE, '>>', $file) || logcroak "can't write into $file: $!";
249 unless (&CAN_FLOCK) {
250 logcarp
251 "Storable::lock_store: fcntl/flock emulation broken on $^O";
252 return undef;
253 }
254 flock(FILE, LOCK_EX) ||
255 logcroak "can't get exclusive lock on $file: $!";
256 truncate FILE, 0;
257 # Unlocking will happen when FILE is closed
258 } else {
259 open(FILE, '>', $file) || logcroak "can't create $file: $!";
260 }
261 binmode FILE; # Archaic systems...
262 my $da = $@; # Don't mess if called from exception handler
263 my $ret;
264 # Call C routine nstore or pstore, depending on network order
265 eval { $ret = &$xsptr(*FILE, $self) };
266 # close will return true on success, so the or short-circuits, the ()
267 # expression is true, and for that case the block will only be entered
268 # if $@ is true (ie eval failed)
269 # if close fails, it returns false, $ret is altered, *that* is (also)
270 # false, so the () expression is false, !() is true, and the block is
271 # entered.
272 if (!(close(FILE) or undef $ret) || $@) {
273 unlink($file) or warn "Can't unlink $file: $!\n";
274 }
275 logcroak $@ if $@ =~ s/\.?\n$/,/;
276 $@ = $da;
277 return $ret;
278}
279
280#
281# store_fd
282#
283# Same as store, but perform on an already opened file descriptor instead.
284# Returns undef if an I/O error occurred.
285#
286sub store_fd {
287 return _store_fd(\&pstore, @_);
288}
289
290#
291# nstore_fd
292#
293# Same as store_fd, but in network order.
294#
295sub nstore_fd {
296 my ($self, $file) = @_;
297 return _store_fd(\&net_pstore, @_);
298}
299
300# Internal store routine on opened file descriptor
301sub _store_fd {
302 my $xsptr = shift;
303 my $self = shift;
304 my ($file) = @_;
305 logcroak "not a reference" unless ref($self);
306 logcroak "too many arguments" unless @_ == 1; # No @foo in arglist
307 my $fd = fileno($file);
308 logcroak "not a valid file descriptor" unless defined $fd;
309 my $da = $@; # Don't mess if called from exception handler
310 my $ret;
311 # Call C routine nstore or pstore, depending on network order
312 eval { $ret = &$xsptr($file, $self) };
313 logcroak $@ if $@ =~ s/\.?\n$/,/;
314 local $\; print $file ''; # Autoflush the file if wanted
315 $@ = $da;
316 return $ret;
317}
318
319#
320# freeze
321#
322# Store object and its hierarchy in memory and return a scalar
323# containing the result.
324#
325sub freeze {
326 _freeze(\&mstore, @_);
327}
328
329#
330# nfreeze
331#
332# Same as freeze but in network order.
333#
334sub nfreeze {
335 _freeze(\&net_mstore, @_);
336}
337
338# Internal freeze routine
339sub _freeze {
340 my $xsptr = shift;
341 my $self = shift;
342 logcroak "not a reference" unless ref($self);
343 logcroak "too many arguments" unless @_ == 0; # No @foo in arglist
344 my $da = $@; # Don't mess if called from exception handler
345 my $ret;
346 # Call C routine mstore or net_mstore, depending on network order
347 eval { $ret = &$xsptr($self) };
348 logcroak $@ if $@ =~ s/\.?\n$/,/;
349 $@ = $da;
350 return $ret ? $ret : undef;
351}
352
353#
354# retrieve
355#
356# Retrieve object hierarchy from disk, returning a reference to the root
357# object of that tree.
358#
359
# spent 650ms (12µs+650) within Storable::retrieve which was called: # once (12µs+650ms) by CPAN::Index::read_metadata_cache at line 575 of CPAN/Index.pm
sub retrieve {
36017µs1650ms _retrieve($_[0], 0);
# spent 650ms making 1 call to Storable::_retrieve
361}
362
363#
364# lock_retrieve
365#
366# Same as retrieve, but with advisory locking.
367#
368sub lock_retrieve {
369 _retrieve($_[0], 1);
370}
371
372# Internal retrieve routine
373
# spent 650ms (83µs+650) within Storable::_retrieve which was called: # once (83µs+650ms) by Storable::retrieve at line 360
sub _retrieve {
37411µs my ($file, $use_locking) = @_;
37512µs local *FILE;
3761118µs1103µs open(FILE, '<', $file) || logcroak "can't open $file: $!";
# spent 103µs making 1 call to Storable::CORE:open
377111µs13µs binmode FILE; # Archaic systems...
# spent 3µs making 1 call to Storable::CORE:binmode
37810s my $self;
37911µs my $da = $@; # Could be from exception handler
38010s if ($use_locking) {
381 unless (&CAN_FLOCK) {
382 logcarp
383 "Storable::lock_store: fcntl/flock emulation broken on $^O";
384 return undef;
385 }
386 flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
387 # Unlocking will happen when FILE is closed
388 }
3892650ms1650ms eval { $self = pretrieve(*FILE) }; # Call C routine
# spent 650ms making 1 call to Storable::pretrieve
390133µs120µs close(FILE);
# spent 20µs making 1 call to Storable::CORE:close
39118µs12µs logcroak $@ if $@ =~ s/\.?\n$/,/;
# spent 2µs making 1 call to Storable::CORE:subst
39211µs $@ = $da;
393115µs return $self;
394}
395
396#
397# fd_retrieve
398#
399# Same as retrieve, but perform from an already opened file descriptor instead.
400#
401sub fd_retrieve {
402 my ($file) = @_;
403 my $fd = fileno($file);
404 logcroak "not a valid file descriptor" unless defined $fd;
405 my $self;
406 my $da = $@; # Could be from exception handler
407 eval { $self = pretrieve($file) }; # Call C routine
408 logcroak $@ if $@ =~ s/\.?\n$/,/;
409 $@ = $da;
410 return $self;
411}
412
413sub retrieve_fd { &fd_retrieve } # Backward compatibility
414
415#
416# thaw
417#
418# Recreate objects in memory from an existing frozen image created
419# by freeze. If the frozen image passed is undef, return undef.
420#
421sub thaw {
422 my ($frozen) = @_;
423 return undef unless defined $frozen;
424 my $self;
425 my $da = $@; # Could be from exception handler
426 eval { $self = mretrieve($frozen) }; # Call C routine
427 logcroak $@ if $@ =~ s/\.?\n$/,/;
428 $@ = $da;
429 return $self;
430}
431
432116µs1;
433__END__
 
# spent 3µs within Storable::CORE:binmode which was called: # once (3µs+0s) by Storable::_retrieve at line 377
sub Storable::CORE:binmode; # opcode
# spent 20µs within Storable::CORE:close which was called: # once (20µs+0s) by Storable::_retrieve at line 390
sub Storable::CORE:close; # opcode
# spent 103µs within Storable::CORE:open which was called: # once (103µs+0s) by Storable::_retrieve at line 376
sub Storable::CORE:open; # opcode
# spent 2µs within Storable::CORE:subst which was called: # once (2µs+0s) by Storable::_retrieve at line 391
sub Storable::CORE:subst; # opcode
# spent 650ms within Storable::pretrieve which was called: # once (650ms+0s) by Storable::_retrieve at line 389
sub Storable::pretrieve; # xsub
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.