← 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/File/stat.pm
StatementsExecuted 79 statements in 2.32ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.72ms2.15msFile::stat::::BEGIN@174File::stat::BEGIN@174
11188µs166µsFile::stat::::BEGIN@32File::stat::BEGIN@32
11119µs19µsFile::stat::::BEGIN@2File::stat::BEGIN@2
11116µs16µsFile::stat::::BEGIN@16File::stat::BEGIN@16
11114µs49µsFile::stat::::BEGIN@148File::stat::BEGIN@148
11111µs83µsFile::stat::::BEGIN@6File::stat::BEGIN@6
11110µs66µsFile::stat::::BEGIN@144File::stat::BEGIN@144
11110µs26µsFile::stat::::BEGIN@5File::stat::BEGIN@5
1119µs42µsFile::stat::::BEGIN@30File::stat::BEGIN@30
1118µs16µsFile::stat::::BEGIN@201File::stat::BEGIN@201
1117µs34µsFile::stat::::BEGIN@7File::stat::BEGIN@7
1116µs17µsFile::stat::::BEGIN@35File::stat::BEGIN@35
1116µs133µsFile::stat::::BEGIN@28File::stat::BEGIN@28
1116µs7µsFile::stat::::BEGIN@4File::stat::BEGIN@4
1114µs4µsFile::stat::::BEGIN@9File::stat::BEGIN@9
1114µs4µsFile::stat::::BEGIN@17File::stat::BEGIN@17
1112µs2µsFile::stat::::importFile::stat::import
0000s0sFile::stat::::__ANON__[:106]File::stat::__ANON__[:106]
0000s0sFile::stat::::__ANON__[:113]File::stat::__ANON__[:113]
0000s0sFile::stat::::__ANON__[:114]File::stat::__ANON__[:114]
0000s0sFile::stat::::__ANON__[:115]File::stat::__ANON__[:115]
0000s0sFile::stat::::__ANON__[:116]File::stat::__ANON__[:116]
0000s0sFile::stat::::__ANON__[:118]File::stat::__ANON__[:118]
0000s0sFile::stat::::__ANON__[:119]File::stat::__ANON__[:119]
0000s0sFile::stat::::__ANON__[:120]File::stat::__ANON__[:120]
0000s0sFile::stat::::__ANON__[:121]File::stat::__ANON__[:121]
0000s0sFile::stat::::__ANON__[:123]File::stat::__ANON__[:123]
0000s0sFile::stat::::__ANON__[:124]File::stat::__ANON__[:124]
0000s0sFile::stat::::__ANON__[:125]File::stat::__ANON__[:125]
0000s0sFile::stat::::__ANON__[:127]File::stat::__ANON__[:127]
0000s0sFile::stat::::__ANON__[:128]File::stat::__ANON__[:128]
0000s0sFile::stat::::__ANON__[:129]File::stat::__ANON__[:129]
0000s0sFile::stat::::__ANON__[:130]File::stat::__ANON__[:130]
0000s0sFile::stat::::__ANON__[:131]File::stat::__ANON__[:131]
0000s0sFile::stat::::__ANON__[:132]File::stat::__ANON__[:132]
0000s0sFile::stat::::__ANON__[:133]File::stat::__ANON__[:133]
0000s0sFile::stat::::__ANON__[:135]File::stat::__ANON__[:135]
0000s0sFile::stat::::__ANON__[:136]File::stat::__ANON__[:136]
0000s0sFile::stat::::__ANON__[:137]File::stat::__ANON__[:137]
0000s0sFile::stat::::__ANON__[:139]File::stat::__ANON__[:139]
0000s0sFile::stat::::__ANON__[:140]File::stat::__ANON__[:140]
0000s0sFile::stat::::__ANON__[:141]File::stat::__ANON__[:141]
0000s0sFile::stat::::__ANON__[:169]File::stat::__ANON__[:169]
0000s0sFile::stat::::__ANON__[:38]File::stat::__ANON__[:38]
0000s0sFile::stat::::__ANON__[:42]File::stat::__ANON__[:42]
0000s0sFile::stat::::__ANON__[:81]File::stat::__ANON__[:81]
0000s0sFile::stat::::_ingroupFile::stat::_ingroup
0000s0sFile::stat::::lstatFile::stat::lstat
0000s0sFile::stat::::populateFile::stat::populate
0000s0sFile::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
1package File::stat;
2328µs119µ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
4316µs29µ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
5319µs243µ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
6322µs2156µ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
7326µs262µ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
9148µs14µ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
111600nsour(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
12
131700nsour $VERSION = '1.02';
14
151200nsmy @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 {
17367µs14µ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
181900ns @EXPORT = qw(stat lstat);
1917µs @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 );
2512µs @EXPORT_OK = ( @fields, "stat_cando" );
2617µs %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] );
27117µs116µs}
# spent 16µs making 1 call to File::stat::BEGIN@16
28321µs2260µ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
30325µs274µ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.
353124µs228µ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
361700ns for (qw(suid sgid svtx)) {
37630µs312µ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
38312µs *{"_$_"} = defined $val ? sub { $_[0] & $val ? 1 : "" } : sub { "" };
39 }
4013µs for (qw(SOCK CHR BLK REG DIR FIFO LNK)) {
41756µs766µ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
42724µs ? \&{"Fcntl::S_IS$_"} : sub { "" };
43 }
441702µs1166µs}
# spent 166µs making 1 call to File::stat::BEGIN@32
45
46# from doio.c
47sub _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
7813µsif (grep $^O eq $_, qw/os2 MSWin32 dos/) {
79
80 # from doio.c
81 *cando = sub { ($_[0][2] & $_[1]) ? 1 : "" };
82}
83else {
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 "";
10614µs };
107}
108
109# alias for those who don't like objects
1101800ns*stat_cando = \&cando;
111
112my %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 },
142146µs);
143
1443112µs2122µ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
147use 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 }
169342µs284µ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
17216µs128µ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
1743731µs22.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
175struct 'File::stat' => [
176113µs1798µ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
182sub 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
192sub lstat ($) { populate(CORE::lstat(shift)) }
193
194sub stat ($) {
195 my $arg = shift;
196 my $st = populate(CORE::stat $arg);
197 return $st if defined $st;
198 my $fh;
199 {
200 local $!;
201390µs225µ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
209117µs1;
210__END__