← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:04 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/IO/Dir.pm
StatementsExecuted 36 statements in 895µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.59ms5.25msIO::Dir::::BEGIN@18IO::Dir::BEGIN@18
11133µs33µsIO::Dir::::BEGIN@9IO::Dir::BEGIN@9
11116µs32µsIO::Dir::::BEGIN@42IO::Dir::BEGIN@42
11111µs166µsIO::Dir::::BEGIN@15IO::Dir::BEGIN@15
1119µs43µsIO::Dir::::BEGIN@13IO::Dir::BEGIN@13
1118µs8µsIO::Dir::::BEGIN@17IO::Dir::BEGIN@17
1117µs18µsIO::Dir::::BEGIN@14IO::Dir::BEGIN@14
1117µs38µsIO::Dir::::BEGIN@12IO::Dir::BEGIN@12
1117µs7µsIO::Dir::::BEGIN@19IO::Dir::BEGIN@19
1116µs8µsIO::Dir::::BEGIN@11IO::Dir::BEGIN@11
0000s0sIO::Dir::::DELETEIO::Dir::DELETE
0000s0sIO::Dir::::DESTROYIO::Dir::DESTROY
0000s0sIO::Dir::::EXISTSIO::Dir::EXISTS
0000s0sIO::Dir::::FETCHIO::Dir::FETCH
0000s0sIO::Dir::::FIRSTKEYIO::Dir::FIRSTKEY
0000s0sIO::Dir::::NEXTKEYIO::Dir::NEXTKEY
0000s0sIO::Dir::::STOREIO::Dir::STORE
0000s0sIO::Dir::::TIEHASHIO::Dir::TIEHASH
0000s0sIO::Dir::::closeIO::Dir::close
0000s0sIO::Dir::::newIO::Dir::new
0000s0sIO::Dir::::openIO::Dir::open
0000s0sIO::Dir::::readIO::Dir::read
0000s0sIO::Dir::::rewindIO::Dir::rewind
0000s0sIO::Dir::::seekIO::Dir::seek
0000s0sIO::Dir::::tellIO::Dir::tell
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# IO::Dir.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6
7package IO::Dir;
8
9342µs133µs
# spent 33µs within IO::Dir::BEGIN@9 which was called: # once (33µs+0s) by SQL::Translator::BEGIN@37 at line 9
use 5.006;
# spent 33µs making 1 call to IO::Dir::BEGIN@9
10
11316µs29µs
# spent 8µs (6+2) within IO::Dir::BEGIN@11 which was called: # once (6µs+2µs) by SQL::Translator::BEGIN@37 at line 11
use strict;
# spent 8µs making 1 call to IO::Dir::BEGIN@11 # spent 2µs making 1 call to strict::import
12316µs268µs
# spent 38µs (7+31) within IO::Dir::BEGIN@12 which was called: # once (7µs+31µs) by SQL::Translator::BEGIN@37 at line 12
use Carp;
# spent 38µs making 1 call to IO::Dir::BEGIN@12 # spent 31µs making 1 call to Exporter::import
13319µs276µs
# spent 43µs (9+33) within IO::Dir::BEGIN@13 which was called: # once (9µs+33µs) by SQL::Translator::BEGIN@37 at line 13
use Symbol;
# spent 43µs making 1 call to IO::Dir::BEGIN@13 # spent 33µs making 1 call to Exporter::import
14316µs228µs
# spent 18µs (7+10) within IO::Dir::BEGIN@14 which was called: # once (7µs+10µs) by SQL::Translator::BEGIN@37 at line 14
use Exporter;
# spent 18µs making 1 call to IO::Dir::BEGIN@14 # spent 10µs making 1 call to Exporter::import
15333µs2321µs
# spent 166µs (11+155) within IO::Dir::BEGIN@15 which was called: # once (11µs+155µs) by SQL::Translator::BEGIN@37 at line 15
use IO::File;
# spent 166µs making 1 call to IO::Dir::BEGIN@15 # spent 155µs making 1 call to Exporter::import
161400nsour(@ISA, $VERSION, @EXPORT_OK);
17320µs18µs
# spent 8µs within IO::Dir::BEGIN@17 which was called: # once (8µs+0s) by SQL::Translator::BEGIN@37 at line 17
use Tie::Hash;
# spent 8µs making 1 call to IO::Dir::BEGIN@17
18387µs25.25ms
# spent 5.25ms (1.59+3.66) within IO::Dir::BEGIN@18 which was called: # once (1.59ms+3.66ms) by SQL::Translator::BEGIN@37 at line 18
use File::stat;
# spent 5.25ms making 1 call to IO::Dir::BEGIN@18 # spent 2µs making 1 call to File::stat::import
193119µs17µs
# spent 7µs within IO::Dir::BEGIN@19 which was called: # once (7µs+0s) by SQL::Translator::BEGIN@37 at line 19
use File::Spec;
# spent 7µs making 1 call to IO::Dir::BEGIN@19
20
21134µs@ISA = qw(Tie::Hash Exporter);
221600ns$VERSION = "1.07";
23120µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
241800ns@EXPORT_OK = qw(DIR_UNLINK);
25
26sub DIR_UNLINK () { 1 }
27
28sub new {
29 @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [DIRNAME]';
30 my $class = shift;
31 my $dh = gensym;
32 if (@_) {
33 IO::Dir::open($dh, $_[0])
34 or return undef;
35 }
36 bless $dh, $class;
37}
38
39sub DESTROY {
40 my ($dh) = @_;
41 local($., $@, $!, $^E, $?);
423468µs248µs
# spent 32µs (16+16) within IO::Dir::BEGIN@42 which was called: # once (16µs+16µs) by SQL::Translator::BEGIN@37 at line 42
no warnings 'io';
# spent 32µs making 1 call to IO::Dir::BEGIN@42 # spent 16µs making 1 call to warnings::unimport
43 closedir($dh);
44}
45
46sub open {
47 @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
48 my ($dh, $dirname) = @_;
49 return undef
50 unless opendir($dh, $dirname);
51 # a dir name should always have a ":" in it; assume dirname is
52 # in current directory
53 $dirname = ':' . $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) );
54 ${*$dh}{io_dir_path} = $dirname;
55 1;
56}
57
58sub close {
59 @_ == 1 or croak 'usage: $dh->close()';
60 my ($dh) = @_;
61 closedir($dh);
62}
63
64sub read {
65 @_ == 1 or croak 'usage: $dh->read()';
66 my ($dh) = @_;
67 readdir($dh);
68}
69
70sub seek {
71 @_ == 2 or croak 'usage: $dh->seek(POS)';
72 my ($dh,$pos) = @_;
73 seekdir($dh,$pos);
74}
75
76sub tell {
77 @_ == 1 or croak 'usage: $dh->tell()';
78 my ($dh) = @_;
79 telldir($dh);
80}
81
82sub rewind {
83 @_ == 1 or croak 'usage: $dh->rewind()';
84 my ($dh) = @_;
85 rewinddir($dh);
86}
87
88sub TIEHASH {
89 my($class,$dir,$options) = @_;
90
91 my $dh = $class->new($dir)
92 or return undef;
93
94 $options ||= 0;
95
96 ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK;
97 $dh;
98}
99
100sub FIRSTKEY {
101 my($dh) = @_;
102 $dh->rewind;
103 scalar $dh->read;
104}
105
106sub NEXTKEY {
107 my($dh) = @_;
108 scalar $dh->read;
109}
110
111sub EXISTS {
112 my($dh,$key) = @_;
113 -e File::Spec->catfile(${*$dh}{io_dir_path}, $key);
114}
115
116sub FETCH {
117 my($dh,$key) = @_;
118 &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key));
119}
120
121sub STORE {
122 my($dh,$key,$data) = @_;
123 my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
124 my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
125 unless(-e $file) {
126 my $io = IO::File->new($file,O_CREAT | O_RDWR);
127 $io->close if $io;
128 }
129 utime($atime,$mtime, $file);
130}
131
132sub DELETE {
133 my($dh,$key) = @_;
134
135 # Only unlink if unlink-ing is enabled
136 return 0
137 unless ${*$dh}{io_dir_unlink};
138
139 my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
140
141 -d $file
142 ? rmdir($file)
143 : unlink($file);
144}
145
14614µs1;
147
148__END__