← Index
NYTProf Performance Profile   « line view »
For flows_to_es.pl
  Run on Mon May 9 23:27:59 2016
Reported on Mon May 9 23:28:08 2016

Filename/usr/lib/perl/5.18/Storable.pm
StatementsExecuted 45 statements in 34.8ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11132.2ms32.2msStorable::::pretrieveStorable::pretrieve (xsub)
11183µs35.5msStorable::::_retrieveStorable::_retrieve
11154µs54µsStorable::::BEGIN@26Storable::BEGIN@26
11133µs3.11msStorable::::CAN_FLOCKStorable::CAN_FLOCK
11129µs29µsStorable::::CORE:openStorable::CORE:open (opcode)
11117µs35.5msStorable::::lock_retrieveStorable::lock_retrieve
11116µs16µsStorable::::CORE:closeStorable::CORE:close (opcode)
11114µs57µsStorable::::BEGIN@22Storable::BEGIN@22
11114µs14µsStorable::::CORE:flockStorable::CORE:flock (opcode)
1119µs126µsStorable::::BEGIN@52Storable::BEGIN@52
1114µs4µsStorable::::CORE:substStorable::CORE:subst (opcode)
1112µs2µsStorable::::CORE:binmodeStorable::CORE:binmode (opcode)
0000s0sStorable::::BIN_VERSION_NVStorable::BIN_VERSION_NV
0000s0sStorable::::BIN_WRITE_VERSION_NVStorable::BIN_WRITE_VERSION_NV
0000s0sStorable::::CLONEStorable::CLONE
0000s0sStorable::::__ANON__[:38]Storable::__ANON__[:38]
0000s0sStorable::::__ANON__[:44]Storable::__ANON__[:44]
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_storeStorable::lock_store
0000s0sStorable::::nfreezeStorable::nfreeze
0000s0sStorable::::nstoreStorable::nstore
0000s0sStorable::::nstore_fdStorable::nstore_fd
0000s0sStorable::::read_magicStorable::read_magic
0000s0sStorable::::retrieveStorable::retrieve
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-2000, Raphael Manfredi
3#
4# You may redistribute only under the same terms as Perl 5, as specified
5# in the README file that comes with the distribution.
6#
7
81700nsrequire XSLoader;
91200nsrequire Exporter;
1016µspackage Storable; @ISA = qw(Exporter);
11
121700ns@EXPORT = qw(store retrieve);
1312µs@EXPORT_OK = qw(
14 nstore store_fd nstore_fd fd_retrieve
15 freeze nfreeze thaw
16 dclone
17 retrieve_fd
18 lock_store lock_nstore lock_retrieve
19 file_magic read_magic
20);
21
222167µs2100µs
# spent 57µs (14+43) within Storable::BEGIN@22 which was called: # once (14µs+43µs) by main::BEGIN@123 at line 22
use vars qw($canonical $forgive_me $VERSION);
# spent 57µs making 1 call to Storable::BEGIN@22 # spent 43µs making 1 call to vars::import
23
241200ns$VERSION = '2.41';
25
26
# spent 54µs within Storable::BEGIN@26 which was called: # once (54µs+0s) by main::BEGIN@123 at line 46
BEGIN {
27343µs if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
28 Log::Agent->import;
29 }
30 #
31 # Use of Log::Agent is optional. If it hasn't imported these subs then
32 # provide a fallback implementation.
33 #
341800ns if (!exists &logcroak) {
351200ns require Carp;
36 *logcroak = sub {
37 Carp::croak(@_);
3814µs };
39 }
4016µs if (!exists &logcarp) {
411100ns require Carp;
42 *logcarp = sub {
43 Carp::carp(@_);
4412µs };
45 }
46164µs154µs}
# spent 54µs making 1 call to Storable::BEGIN@26
47
48#
49# They might miss :flock in Fcntl
50#
51
52
# spent 126µs (9+117) within Storable::BEGIN@52 which was called: # once (9µs+117µs) by main::BEGIN@123 at line 61
BEGIN {
5336µs1117µs if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
# spent 117µs making 1 call to Exporter::import
54 Fcntl->import(':flock');
55 } else {
56 eval q{
57 sub LOCK_SH () {1}
58 sub LOCK_EX () {2}
59 };
60 }
6111.93ms1126µs}
# spent 126µs making 1 call to Storable::BEGIN@52
62
63sub CLONE {
64 # clone context under threads
65 Storable::init_perinterp();
66}
67
68# By default restricted hashes are downgraded on earlier perls.
69
701200ns$Storable::downgrade_restricted = 1;
711100ns$Storable::accept_future_minor = 1;
72
731160µs1152µsXSLoader::load('Storable', $Storable::VERSION);
# spent 152µs making 1 call to XSLoader::load
74
75#
76# Determine whether locking is possible, but only when needed.
77#
78
791200ns
# spent 3.11ms (33µs+3.07) within Storable::CAN_FLOCK which was called: # once (33µs+3.07ms) by Storable::_retrieve at line 373
sub CAN_FLOCK; my $CAN_FLOCK; sub CAN_FLOCK {
801500ns return $CAN_FLOCK if defined $CAN_FLOCK;
81212µs128µs require Config; import Config;
# spent 28µs making 1 call to Config::import
82118µs13.04ms return $CAN_FLOCK =
# spent 3.04ms making 1 call to Config::FETCH
83 $Config{'d_flock'} ||
84 $Config{'d_fcntl_can_lock'} ||
85 $Config{'d_lockf'};
86}
87
88sub show_file_magic {
89 print <<EOM;
90#
91# To recognize the data files of the Perl module Storable,
92# the following lines need to be added to the local magic(5) file,
93# usually either /usr/share/misc/magic or /etc/magic.
94#
950 string perl-store perl Storable(v0.6) data
96>4 byte >0 (net-order %d)
97>>4 byte &01 (network-ordered)
98>>4 byte =3 (major 1)
99>>4 byte =2 (major 1)
100
1010 string pst0 perl Storable(v0.7) data
102>4 byte >0
103>>4 byte &01 (network-ordered)
104>>4 byte =5 (major 2)
105>>4 byte =4 (major 2)
106>>5 byte >0 (minor %d)
107EOM
108}
109
110sub file_magic {
111 require IO::File;
112
113 my $file = shift;
114 my $fh = IO::File->new;
115 open($fh, "<". $file) || die "Can't open '$file': $!";
116 binmode($fh);
117 defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!";
118 close($fh);
119
120 $file = "./$file" unless $file; # ensure TRUE value
121
122 return read_magic($buf, $file);
123}
124
125sub read_magic {
126 my($buf, $file) = @_;
127 my %info;
128
129 my $buflen = length($buf);
130 my $magic;
131 if ($buf =~ s/^(pst0|perl-store)//) {
132 $magic = $1;
133 $info{file} = $file || 1;
134 }
135 else {
136 return undef if $file;
137 $magic = "";
138 }
139
140 return undef unless length($buf);
141
142 my $net_order;
143 if ($magic eq "perl-store" && ord(substr($buf, 0, 1)) > 1) {
144 $info{version} = -1;
145 $net_order = 0;
146 }
147 else {
148 $buf =~ s/(.)//s;
149 my $major = (ord $1) >> 1;
150 return undef if $major > 4; # sanity (assuming we never go that high)
151 $info{major} = $major;
152 $net_order = (ord $1) & 0x01;
153 if ($major > 1) {
154 return undef unless $buf =~ s/(.)//s;
155 my $minor = ord $1;
156 $info{minor} = $minor;
157 $info{version} = "$major.$minor";
158 $info{version_nv} = sprintf "%d.%03d", $major, $minor;
159 }
160 else {
161 $info{version} = $major;
162 }
163 }
164 $info{version_nv} ||= $info{version};
165 $info{netorder} = $net_order;
166
167 unless ($net_order) {
168 return undef unless $buf =~ s/(.)//s;
169 my $len = ord $1;
170 return undef unless length($buf) >= $len;
171 return undef unless $len == 4 || $len == 8; # sanity
172 @info{qw(byteorder intsize longsize ptrsize)}
173 = unpack "a${len}CCC", $buf;
174 (substr $buf, 0, $len + 3) = '';
175 if ($info{version_nv} >= 2.002) {
176 return undef unless $buf =~ s/(.)//s;
177 $info{nvsize} = ord $1;
178 }
179 }
180 $info{hdrsize} = $buflen - length($buf);
181
182 return \%info;
183}
184
185sub BIN_VERSION_NV {
186 sprintf "%d.%03d", BIN_MAJOR(), BIN_MINOR();
187}
188
189sub BIN_WRITE_VERSION_NV {
190 sprintf "%d.%03d", BIN_MAJOR(), BIN_WRITE_MINOR();
191}
192
193#
194# store
195#
196# Store target object hierarchy, identified by a reference to its root.
197# The stored object tree may later be retrieved to memory via retrieve.
198# Returns undef if an I/O error occurred, in which case the file is
199# removed.
200#
201sub store {
202 return _store(\&pstore, @_, 0);
203}
204
205#
206# nstore
207#
208# Same as store, but in network order.
209#
210sub nstore {
211 return _store(\&net_pstore, @_, 0);
212}
213
214#
215# lock_store
216#
217# Same as store, but flock the file first (advisory locking).
218#
219sub lock_store {
220 return _store(\&pstore, @_, 1);
221}
222
223#
224# lock_nstore
225#
226# Same as nstore, but flock the file first (advisory locking).
227#
228sub lock_nstore {
229 return _store(\&net_pstore, @_, 1);
230}
231
232# Internal store to file routine
233sub _store {
234 my $xsptr = shift;
235 my $self = shift;
236 my ($file, $use_locking) = @_;
237 logcroak "not a reference" unless ref($self);
238 logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist
239 local *FILE;
240 if ($use_locking) {
241 open(FILE, ">>$file") || logcroak "can't write into $file: $!";
242 unless (&CAN_FLOCK) {
243 logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
244 return undef;
245 }
246 flock(FILE, LOCK_EX) ||
247 logcroak "can't get exclusive lock on $file: $!";
248 truncate FILE, 0;
249 # Unlocking will happen when FILE is closed
250 } else {
251 open(FILE, ">$file") || logcroak "can't create $file: $!";
252 }
253 binmode FILE; # Archaic systems...
254 my $da = $@; # Don't mess if called from exception handler
255 my $ret;
256 # Call C routine nstore or pstore, depending on network order
257 eval { $ret = &$xsptr(*FILE, $self) };
258 # close will return true on success, so the or short-circuits, the ()
259 # expression is true, and for that case the block will only be entered
260 # if $@ is true (ie eval failed)
261 # if close fails, it returns false, $ret is altered, *that* is (also)
262 # false, so the () expression is false, !() is true, and the block is
263 # entered.
264 if (!(close(FILE) or undef $ret) || $@) {
265 unlink($file) or warn "Can't unlink $file: $!\n";
266 }
267 logcroak $@ if $@ =~ s/\.?\n$/,/;
268 $@ = $da;
269 return $ret;
270}
271
272#
273# store_fd
274#
275# Same as store, but perform on an already opened file descriptor instead.
276# Returns undef if an I/O error occurred.
277#
278sub store_fd {
279 return _store_fd(\&pstore, @_);
280}
281
282#
283# nstore_fd
284#
285# Same as store_fd, but in network order.
286#
287sub nstore_fd {
288 my ($self, $file) = @_;
289 return _store_fd(\&net_pstore, @_);
290}
291
292# Internal store routine on opened file descriptor
293sub _store_fd {
294 my $xsptr = shift;
295 my $self = shift;
296 my ($file) = @_;
297 logcroak "not a reference" unless ref($self);
298 logcroak "too many arguments" unless @_ == 1; # No @foo in arglist
299 my $fd = fileno($file);
300 logcroak "not a valid file descriptor" unless defined $fd;
301 my $da = $@; # Don't mess if called from exception handler
302 my $ret;
303 # Call C routine nstore or pstore, depending on network order
304 eval { $ret = &$xsptr($file, $self) };
305 logcroak $@ if $@ =~ s/\.?\n$/,/;
306 local $\; print $file ''; # Autoflush the file if wanted
307 $@ = $da;
308 return $ret;
309}
310
311#
312# freeze
313#
314# Store oject and its hierarchy in memory and return a scalar
315# containing the result.
316#
317sub freeze {
318 _freeze(\&mstore, @_);
319}
320
321#
322# nfreeze
323#
324# Same as freeze but in network order.
325#
326sub nfreeze {
327 _freeze(\&net_mstore, @_);
328}
329
330# Internal freeze routine
331sub _freeze {
332 my $xsptr = shift;
333 my $self = shift;
334 logcroak "not a reference" unless ref($self);
335 logcroak "too many arguments" unless @_ == 0; # No @foo in arglist
336 my $da = $@; # Don't mess if called from exception handler
337 my $ret;
338 # Call C routine mstore or net_mstore, depending on network order
339 eval { $ret = &$xsptr($self) };
340 logcroak $@ if $@ =~ s/\.?\n$/,/;
341 $@ = $da;
342 return $ret ? $ret : undef;
343}
344
345#
346# retrieve
347#
348# Retrieve object hierarchy from disk, returning a reference to the root
349# object of that tree.
350#
351sub retrieve {
352 _retrieve($_[0], 0);
353}
354
355#
356# lock_retrieve
357#
358# Same as retrieve, but with advisory locking.
359#
360
# spent 35.5ms (17µs+35.5) within Storable::lock_retrieve which was called: # once (17µs+35.5ms) by main::load_storable_file at line 132 of flows_to_es.pl
sub lock_retrieve {
361110µs135.5ms _retrieve($_[0], 1);
# spent 35.5ms making 1 call to Storable::_retrieve
362}
363
364# Internal retrieve routine
365
# spent 35.5ms (83µs+35.4) within Storable::_retrieve which was called: # once (83µs+35.4ms) by Storable::lock_retrieve at line 361
sub _retrieve {
36612µs my ($file, $use_locking) = @_;
36713µs local *FILE;
368138µs129µs open(FILE, $file) || logcroak "can't open $file: $!";
# spent 29µs making 1 call to Storable::CORE:open
369111µs12µs binmode FILE; # Archaic systems...
# spent 2µs making 1 call to Storable::CORE:binmode
3701300ns my $self;
3711600ns my $da = $@; # Could be from exception handler
3721500ns if ($use_locking) {
37314µs13.11ms unless (&CAN_FLOCK) {
# spent 3.11ms making 1 call to Storable::CAN_FLOCK
374 logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
375 return undef;
376 }
377120µs114µs flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
# spent 14µs making 1 call to Storable::CORE:flock
378 # Unlocking will happen when FILE is closed
379 }
380232.2ms132.2ms eval { $self = pretrieve(*FILE) }; # Call C routine
# spent 32.2ms making 1 call to Storable::pretrieve
381123µs116µs close(FILE);
# spent 16µs making 1 call to Storable::CORE:close
38219µs14µs logcroak $@ if $@ =~ s/\.?\n$/,/;
# spent 4µs making 1 call to Storable::CORE:subst
3831800ns $@ = $da;
384112µs return $self;
385}
386
387#
388# fd_retrieve
389#
390# Same as retrieve, but perform from an already opened file descriptor instead.
391#
392sub fd_retrieve {
393 my ($file) = @_;
394 my $fd = fileno($file);
395 logcroak "not a valid file descriptor" unless defined $fd;
396 my $self;
397 my $da = $@; # Could be from exception handler
398 eval { $self = pretrieve($file) }; # Call C routine
399 logcroak $@ if $@ =~ s/\.?\n$/,/;
400 $@ = $da;
401 return $self;
402}
403
404sub retrieve_fd { &fd_retrieve } # Backward compatibility
405
406#
407# thaw
408#
409# Recreate objects in memory from an existing frozen image created
410# by freeze. If the frozen image passed is undef, return undef.
411#
412sub thaw {
413 my ($frozen) = @_;
414 return undef unless defined $frozen;
415 my $self;
416 my $da = $@; # Could be from exception handler
417 eval { $self = mretrieve($frozen) }; # Call C routine
418 logcroak $@ if $@ =~ s/\.?\n$/,/;
419 $@ = $da;
420 return $self;
421}
422
42318µs1;
424__END__
 
# spent 2µs within Storable::CORE:binmode which was called: # once (2µs+0s) by Storable::_retrieve at line 369
sub Storable::CORE:binmode; # opcode
# spent 16µs within Storable::CORE:close which was called: # once (16µs+0s) by Storable::_retrieve at line 381
sub Storable::CORE:close; # opcode
# spent 14µs within Storable::CORE:flock which was called: # once (14µs+0s) by Storable::_retrieve at line 377
sub Storable::CORE:flock; # opcode
# spent 29µs within Storable::CORE:open which was called: # once (29µs+0s) by Storable::_retrieve at line 368
sub Storable::CORE:open; # opcode
# spent 4µs within Storable::CORE:subst which was called: # once (4µs+0s) by Storable::_retrieve at line 382
sub Storable::CORE:subst; # opcode
# spent 32.2ms within Storable::pretrieve which was called: # once (32.2ms+0s) by Storable::_retrieve at line 380
sub Storable::pretrieve; # xsub
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.