Profile of File/stat.pm

← 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:22:37 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/File/stat.pm
Statements | Executed 79 statements in 2.32ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.72ms | 2.15ms | File::stat::::BEGIN@174File::stat::BEGIN@174
1 | 1 | 1 | 88µs | 166µs | File::stat::::BEGIN@32File::stat::BEGIN@32
1 | 1 | 1 | 19µs | 19µs | File::stat::::BEGIN@2File::stat::BEGIN@2
1 | 1 | 1 | 16µs | 16µs | File::stat::::BEGIN@16File::stat::BEGIN@16
1 | 1 | 1 | 14µs | 49µs | File::stat::::BEGIN@148File::stat::BEGIN@148
1 | 1 | 1 | 11µs | 83µs | File::stat::::BEGIN@6File::stat::BEGIN@6
1 | 1 | 1 | 10µs | 66µs | File::stat::::BEGIN@144File::stat::BEGIN@144
1 | 1 | 1 | 10µs | 26µs | File::stat::::BEGIN@5File::stat::BEGIN@5
1 | 1 | 1 | 9µs | 42µs | File::stat::::BEGIN@30File::stat::BEGIN@30
1 | 1 | 1 | 8µs | 16µs | File::stat::::BEGIN@201File::stat::BEGIN@201
1 | 1 | 1 | 7µs | 34µs | File::stat::::BEGIN@7File::stat::BEGIN@7
1 | 1 | 1 | 6µs | 17µs | File::stat::::BEGIN@35File::stat::BEGIN@35
1 | 1 | 1 | 6µs | 133µs | File::stat::::BEGIN@28File::stat::BEGIN@28
1 | 1 | 1 | 6µs | 7µs | File::stat::::BEGIN@4File::stat::BEGIN@4
1 | 1 | 1 | 4µs | 4µs | File::stat::::BEGIN@9File::stat::BEGIN@9
1 | 1 | 1 | 4µs | 4µs | File::stat::::BEGIN@17File::stat::BEGIN@17
1 | 1 | 1 | 2µs | 2µs | File::stat::::importFile::stat::import
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:106]File::stat::__ANON__[:106]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:113]File::stat::__ANON__[:113]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:114]File::stat::__ANON__[:114]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:115]File::stat::__ANON__[:115]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:116]File::stat::__ANON__[:116]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:118]File::stat::__ANON__[:118]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:119]File::stat::__ANON__[:119]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:120]File::stat::__ANON__[:120]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:121]File::stat::__ANON__[:121]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:123]File::stat::__ANON__[:123]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:124]File::stat::__ANON__[:124]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:125]File::stat::__ANON__[:125]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:127]File::stat::__ANON__[:127]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:128]File::stat::__ANON__[:128]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:129]File::stat::__ANON__[:129]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:130]File::stat::__ANON__[:130]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:131]File::stat::__ANON__[:131]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:132]File::stat::__ANON__[:132]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:133]File::stat::__ANON__[:133]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:135]File::stat::__ANON__[:135]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:136]File::stat::__ANON__[:136]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:137]File::stat::__ANON__[:137]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:139]File::stat::__ANON__[:139]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:140]File::stat::__ANON__[:140]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:141]File::stat::__ANON__[:141]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:169]File::stat::__ANON__[:169]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:38]File::stat::__ANON__[:38]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:42]File::stat::__ANON__[:42]
0 | 0 | 0 | 0s | 0s | File::stat::::__ANON__[:81]File::stat::__ANON__[:81]
0 | 0 | 0 | 0s | 0s | File::stat::::_ingroupFile::stat::_ingroup
0 | 0 | 0 | 0s | 0s | File::stat::::lstatFile::stat::lstat
0 | 0 | 0 | 0s | 0s | File::stat::::populateFile::stat::populate
0 | 0 | 0 | 0s | 0s | File::stat::::statFile::stat::stat

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package File::stat;
2 | 3 | 28µs | 1 | 19µs | # spent 19µs within File::stat::BEGIN@2 which was called: # once (19µs+0s) by IO::Dir::BEGIN@18 at line 2 use 5.006; # spent 19µs making 1 call to File::stat::BEGIN@2
3 |  |  |  |  |
4 | 3 | 16µs | 2 | 9µs | # spent 7µs (6+2) within File::stat::BEGIN@4 which was called: # once (6µs+2µs) by IO::Dir::BEGIN@18 at line 4 use strict; # spent 7µs making 1 call to File::stat::BEGIN@4 # spent 2µs making 1 call to strict::import
5 | 3 | 19µs | 2 | 43µs | # spent 26µs (10+17) within File::stat::BEGIN@5 which was called: # once (10µs+17µs) by IO::Dir::BEGIN@18 at line 5 use warnings; # spent 26µs making 1 call to File::stat::BEGIN@5 # spent 17µs making 1 call to warnings::import
6 | 3 | 22µs | 2 | 156µs | # spent 83µs (11+73) within File::stat::BEGIN@6 which was called: # once (11µs+73µs) by IO::Dir::BEGIN@18 at line 6 use warnings::register; # spent 83µs making 1 call to File::stat::BEGIN@6 # spent 73µs making 1 call to warnings::register::import
7 | 3 | 26µs | 2 | 62µs | # spent 34µs (7+28) within File::stat::BEGIN@7 which was called: # once (7µs+28µs) by IO::Dir::BEGIN@18 at line 7 use Carp; # spent 34µs making 1 call to File::stat::BEGIN@7 # spent 28µs making 1 call to Exporter::import
8 |  |  |  |  |
9 | 1 | 48µs | 1 | 4µs | # spent 4µs within File::stat::BEGIN@9 which was called: # once (4µs+0s) by IO::Dir::BEGIN@18 at line 9 BEGIN { *warnif = \&warnings::warnif } # spent 4µs making 1 call to File::stat::BEGIN@9
10 |  |  |  |  |
11 | 1 | 600ns |  |  | our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
12 |  |  |  |  |
13 | 1 | 700ns |  |  | our $VERSION = '1.02';
14 |  |  |  |  |
15 | 1 | 200ns |  |  | my @fields;
16 |  |  |  |  | # spent 16µs within File::stat::BEGIN@16 which was called: # once (16µs+0s) by IO::Dir::BEGIN@18 at line 27 BEGIN {
17 | 3 | 67µs | 1 | 4µs | # spent 4µs within File::stat::BEGIN@17 which was called: # once (4µs+0s) by IO::Dir::BEGIN@18 at line 17 use Exporter (); # spent 4µs making 1 call to File::stat::BEGIN@17
18 | 4 | 16µs |  |  | @EXPORT = qw(stat lstat);
19 |  |  |  |  | @fields = qw( $st_dev $st_ino $st_mode
20 |  |  |  |  | $st_nlink $st_uid $st_gid
21 |  |  |  |  | $st_rdev $st_size
22 |  |  |  |  | $st_atime $st_mtime $st_ctime
23 |  |  |  |  | $st_blksize $st_blocks
24 |  |  |  |  | );
25 |  |  |  |  | @EXPORT_OK = ( @fields, "stat_cando" );
26 |  |  |  |  | %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] );
27 | 1 | 17µs | 1 | 16µs | } # spent 16µs making 1 call to File::stat::BEGIN@16
28 | 3 | 21µs | 2 | 260µs | # spent 133µs (6+127) within File::stat::BEGIN@28 which was called: # once (6µs+127µs) by IO::Dir::BEGIN@18 at line 28 use vars @fields; # spent 133µs making 1 call to File::stat::BEGIN@28 # spent 127µs making 1 call to vars::import
29 |  |  |  |  |
30 | 3 | 25µs | 2 | 74µs | # spent 42µs (9+33) within File::stat::BEGIN@30 which was called: # once (9µs+33µs) by IO::Dir::BEGIN@18 at line 30 use Fcntl qw(S_IRUSR S_IWUSR S_IXUSR); # spent 42µs making 1 call to File::stat::BEGIN@30 # spent 33µs making 1 call to Exporter::import
31 |  |  |  |  |
32 |  |  |  |  | # spent 166µs (88+78) within File::stat::BEGIN@32 which was called: # once (88µs+78µs) by IO::Dir::BEGIN@18 at line 44 BEGIN {
33 |  |  |  |  | # These constants will croak on use if the platform doesn't define
34 |  |  |  |  | # them. It's important to avoid inflicting that on the user.
35 | 3 | 124µs | 2 | 28µs | # spent 17µs (6+11) within File::stat::BEGIN@35 which was called: # once (6µs+11µs) by IO::Dir::BEGIN@18 at line 35 no strict 'refs'; # spent 17µs making 1 call to File::stat::BEGIN@35 # spent 11µs making 1 call to strict::unimport
36 | 25 | 126µs |  |  | for (qw(suid sgid svtx)) {
37 |  |  | 3 | 12µs | my $val = eval { &{"Fcntl::S_I\U$_"} }; # spent 6µs making 1 call to Fcntl::S_ISUID # spent 3µs making 1 call to Fcntl::S_ISGID # spent 3µs making 1 call to Fcntl::S_ISVTX
38 |  |  |  |  | *{"_$_"} = defined $val ? sub { $_[0] & $val ? 1 : "" } : sub { "" };
39 |  |  |  |  | }
40 |  |  |  |  | for (qw(SOCK CHR BLK REG DIR FIFO LNK)) {
41 |  |  | 7 | 66µs | *{"S_IS$_"} = defined eval { &{"Fcntl::S_IF$_"} } # spent 40µs making 1 call to Fcntl::AUTOLOAD # spent 8µs making 1 call to Fcntl::S_IFSOCK # spent 6µs making 1 call to Fcntl::S_IFREG # spent 3µs making 1 call to Fcntl::S_IFCHR # spent 3µs making 1 call to Fcntl::S_IFLNK # spent 3µs making 1 call to Fcntl::S_IFDIR # spent 3µs making 1 call to Fcntl::S_IFBLK
42 |  |  |  |  | ? \&{"Fcntl::S_IS$_"} : sub { "" };
43 |  |  |  |  | }
44 | 1 | 702µs | 1 | 166µs | } # spent 166µs making 1 call to File::stat::BEGIN@32
45 |  |  |  |  |
46 |  |  |  |  | # from doio.c
47 |  |  |  |  | sub _ingroup {
48 |  |  |  |  |
49 |  |  |  |  | $^O eq "MacOS" and return 1;
50 |  |  |  |  |
51 |  |  |  |  | my ($gid, $eff) = @_;
52 |  |  |  |  |
53 |  |  |  |  | # I am assuming that since VMS doesn't have getgroups(2), $) will
54 |  |  |  |  | # always only contain a single entry.
55 |  |  |  |  | $^O eq "VMS" and return $_[0] == $);
56 |  |  |  |  |
57 |  |  |  |  | my ($egid, @supp) = split " ", $);
58 |  |  |  |  | my ($rgid) = split " ", $(;
59 |  |  |  |  |
60 |  |  |  |  | $gid == ($eff ? $egid : $rgid) and return 1;
61 |  |  |  |  | grep $gid == $_, @supp and return 1;
62 |  |  |  |  |
63 |  |  |  |  | return "";
64 |  |  |  |  | }
65 |  |  |  |  |
66 |  |  |  |  | # VMS uses the Unix version of the routine, even though this is very
67 |  |  |  |  | # suboptimal. VMS has a permissions structure that doesn't really fit
68 |  |  |  |  | # into struct stat, and unlike on Win32 the normal -X operators respect
69 |  |  |  |  | # that, but unfortunately by the time we get here we've already lost the
70 |  |  |  |  | # information we need. It looks to me as though if we were to preserve
71 |  |  |  |  | # the st_devnam entry of vmsish.h's fake struct stat (which actually
72 |  |  |  |  | # holds the filename) it might be possible to do this right, but both
73 |  |  |  |  | # getting that value out of the struct (perl's stat doesn't return it)
74 |  |  |  |  | # and interpreting it later would require this module to have an XS
75 |  |  |  |  | # component (at which point we might as well just call Perl_cando and
76 |  |  |  |  | # have done with it).
77 |  |  |  |  |
78 | 1 | 3µs |  |  | if (grep $^O eq $_, qw/os2 MSWin32 dos/) {
79 |  |  |  |  |
80 |  |  |  |  | # from doio.c
81 |  |  |  |  | *cando = sub { ($_[0][2] & $_[1]) ? 1 : "" };
82 |  |  |  |  | }
83 |  |  |  |  | else {
84 |  |  |  |  |
85 |  |  |  |  | # from doio.c
86 |  |  |  |  | *cando = sub {
87 |  |  |  |  | my ($s, $mode, $eff) = @_;
88 |  |  |  |  | my $uid = $eff ? $> : $<;
89 |  |  |  |  |
90 |  |  |  |  | $^O ne "VMS" and $uid == 0 and return 1;
91 |  |  |  |  |
92 |  |  |  |  | my ($stmode, $stuid, $stgid) = @$s[2,4,5];
93 |  |  |  |  |
94 |  |  |  |  | # This code basically assumes that the rwx bits of the mode are
95 |  |  |  |  | # the 0777 bits, but so does Perl_cando.
96 |  |  |  |  | if ($stuid == $uid) {
97 |  |  |  |  | $stmode & $mode and return 1;
98 |  |  |  |  | }
99 |  |  |  |  | elsif (_ingroup($stgid, $eff)) {
100 |  |  |  |  | $stmode & ($mode >> 3) and return 1;
101 |  |  |  |  | }
102 |  |  |  |  | else {
103 |  |  |  |  | $stmode & ($mode >> 6) and return 1;
104 |  |  |  |  | }
105 |  |  |  |  | return "";
106 | 1 | 4µs |  |  | };
107 |  |  |  |  | }
108 |  |  |  |  |
109 |  |  |  |  | # alias for those who don't like objects
110 | 1 | 800ns |  |  | *stat_cando = \&cando;
111 |  |  |  |  |
112 |  |  |  |  | my %op = (
113 |  |  |  |  | r => sub { cando($_[0], S_IRUSR, 1) },
114 |  |  |  |  | w => sub { cando($_[0], S_IWUSR, 1) },
115 |  |  |  |  | x => sub { cando($_[0], S_IXUSR, 1) },
116 |  |  |  |  | o => sub { $_[0][4] == $> },
117 |  |  |  |  |
118 |  |  |  |  | R => sub { cando($_[0], S_IRUSR, 0) },
119 |  |  |  |  | W => sub { cando($_[0], S_IWUSR, 0) },
120 |  |  |  |  | X => sub { cando($_[0], S_IXUSR, 0) },
121 |  |  |  |  | O => sub { $_[0][4] == $< },
122 |  |  |  |  |
123 |  |  |  |  | e => sub { 1 },
124 |  |  |  |  | z => sub { $_[0][7] == 0 },
125 |  |  |  |  | s => sub { $_[0][7] },
126 |  |  |  |  |
127 |  |  |  |  | f => sub { S_ISREG ($_[0][2]) },
128 |  |  |  |  | d => sub { S_ISDIR ($_[0][2]) },
129 |  |  |  |  | l => sub { S_ISLNK ($_[0][2]) },
130 |  |  |  |  | p => sub { S_ISFIFO($_[0][2]) },
131 |  |  |  |  | S => sub { S_ISSOCK($_[0][2]) },
132 |  |  |  |  | b => sub { S_ISBLK ($_[0][2]) },
133 |  |  |  |  | c => sub { S_ISCHR ($_[0][2]) },
134 |  |  |  |  |
135 |  |  |  |  | u => sub { _suid($_[0][2]) },
136 |  |  |  |  | g => sub { _sgid($_[0][2]) },
137 |  |  |  |  | k => sub { _svtx($_[0][2]) },
138 |  |  |  |  |
139 |  |  |  |  | M => sub { ($^T - $_[0][9] ) / 86400 },
140 |  |  |  |  | C => sub { ($^T - $_[0][10]) / 86400 },
141 |  |  |  |  | A => sub { ($^T - $_[0][8] ) / 86400 },
142 | 1 | 46µs |  |  | );
143 |  |  |  |  |
144 | 3 | 112µs | 2 | 122µs | # spent 66µs (10+56) within File::stat::BEGIN@144 which was called: # once (10µs+56µs) by IO::Dir::BEGIN@18 at line 144 use constant HINT_FILETEST_ACCESS => 0x00400000; # spent 66µs making 1 call to File::stat::BEGIN@144 # spent 56µs making 1 call to constant::import
145 |  |  |  |  |
146 |  |  |  |  | # we need fallback=>1 or stringifying breaks
147 |  |  |  |  | use overload
148 |  |  |  |  | # spent 49µs (14+35) within File::stat::BEGIN@148 which was called: # once (14µs+35µs) by IO::Dir::BEGIN@18 at line 169 fallback => 1,
149 |  |  |  |  | -X => sub {
150 |  |  |  |  | my ($s, $op) = @_;
151 |  |  |  |  |
152 |  |  |  |  | if (index "rwxRWX", $op) {
153 |  |  |  |  | (caller 0)[8] & HINT_FILETEST_ACCESS
154 |  |  |  |  | and warnif("File::stat ignores use filetest 'access'");
155 |  |  |  |  |
156 |  |  |  |  | $^O eq "VMS" and warnif("File::stat ignores VMS ACLs");
157 |  |  |  |  |
158 |  |  |  |  | # It would be nice to have a warning about using -l on a
159 |  |  |  |  | # non-lstat, but that would require an extra member in the
160 |  |  |  |  | # object.
161 |  |  |  |  | }
162 |  |  |  |  |
163 |  |  |  |  | if ($op{$op}) {
164 |  |  |  |  | return $op{$op}->($_[0]);
165 |  |  |  |  | }
166 |  |  |  |  | else {
167 |  |  |  |  | croak "-$op is not implemented on a File::stat object";
168 |  |  |  |  | }
169 | 3 | 42µs | 2 | 84µs | }; # spent 49µs making 1 call to File::stat::BEGIN@148 # spent 35µs making 1 call to overload::import
170 |  |  |  |  |
171 |  |  |  |  | # Class::Struct forbids use of @ISA
172 | 1 | 6µs | 1 | 28µs | # spent 2µs within File::stat::import which was called: # once (2µs+0s) by IO::Dir::BEGIN@18 at line 18 of IO/Dir.pm sub import { goto &Exporter::import } # spent 28µs making 1 call to Exporter::import
173 |  |  |  |  |
174 | 3 | 731µs | 2 | 2.29ms | # spent 2.15ms (1.72+432µs) within File::stat::BEGIN@174 which was called: # once (1.72ms+432µs) by IO::Dir::BEGIN@18 at line 174 use Class::Struct qw(struct); # spent 2.15ms making 1 call to File::stat::BEGIN@174 # spent 143µs making 1 call to Class::Struct::import
175 |  |  |  |  | struct 'File::stat' => [
176 | 1 | 13µs | 1 | 798µs | map { $_ => '$' } qw{ # spent 798µs making 1 call to Class::Struct::struct
177 |  |  |  |  | dev ino mode nlink uid gid rdev size
178 |  |  |  |  | atime mtime ctime blksize blocks
179 |  |  |  |  | }
180 |  |  |  |  | ];
181 |  |  |  |  |
182 |  |  |  |  | sub populate (@) {
183 |  |  |  |  | return unless @_;
184 |  |  |  |  | my $stob = new();
185 |  |  |  |  | @$stob = (
186 |  |  |  |  | $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
187 |  |  |  |  | $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks )
188 |  |  |  |  | = @_;
189 |  |  |  |  | return $stob;
190 |  |  |  |  | }
191 |  |  |  |  |
192 |  |  |  |  | sub lstat ($) { populate(CORE::lstat(shift)) }
193 |  |  |  |  |
194 |  |  |  |  | sub stat ($) {
195 |  |  |  |  | my $arg = shift;
196 |  |  |  |  | my $st = populate(CORE::stat $arg);
197 |  |  |  |  | return $st if defined $st;
198 |  |  |  |  | my $fh;
199 |  |  |  |  | {
200 |  |  |  |  | local $!;
201 | 3 | 90µs | 2 | 25µs | # spent 16µs (8+9) within File::stat::BEGIN@201 which was called: # once (8µs+9µs) by IO::Dir::BEGIN@18 at line 201 no strict 'refs'; # spent 16µs making 1 call to File::stat::BEGIN@201 # spent 9µs making 1 call to strict::unimport
202 |  |  |  |  | require Symbol;
203 |  |  |  |  | $fh = \*{ Symbol::qualify( $arg, caller() )};
204 |  |  |  |  | return unless defined fileno $fh;
205 |  |  |  |  | }
206 |  |  |  |  | return populate(CORE::stat $fh);
207 |  |  |  |  | }
208 |  |  |  |  |
209 | 1 | 17µs |  |  | 1;
210 |  |  |  |  | __END__