← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 20:36:06 2020
Reported on Wed Feb 12 21:42:25 2020

Filename/usr/share/perl/5.28/File/Copy.pm
StatementsExecuted 1789 statements in 639ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
29411423ms423msFile::Copy::::CORE:syswriteFile::Copy::CORE:syswrite (opcode)
30011206ms206msFile::Copy::::CORE:sysreadFile::Copy::CORE:sysread (opcode)
6116.84ms637msFile::Copy::::copyFile::Copy::copy
1221448µs448µsFile::Copy::::CORE:openFile::Copy::CORE:open (opcode)
611105µs121µsFile::Copy::::_eqFile::Copy::_eq
122186µs86µsFile::Copy::::CORE:closeFile::Copy::CORE:close (opcode)
11149µs1.28msFile::Copy::::BEGIN@20File::Copy::BEGIN@20
122125µs25µsFile::Copy::::CORE:statFile::Copy::CORE:stat (opcode)
11114µs14µsFile::Copy::::BEGIN@10File::Copy::BEGIN@10
11111µs11µsFile::Copy::::BEGIN@13File::Copy::BEGIN@13
61111µs11µsFile::Copy::::CORE:ftsizeFile::Copy::CORE:ftsize (opcode)
61110µs10µsFile::Copy::::CORE:ftdirFile::Copy::CORE:ftdir (opcode)
1119µs23µsFile::Copy::::BEGIN@14File::Copy::BEGIN@14
1118µs30µsFile::Copy::::BEGIN@12.6File::Copy::BEGIN@12.6
12218µs8µsFile::Copy::::CORE:binmodeFile::Copy::CORE:binmode (opcode)
1118µs41µsFile::Copy::::BEGIN@12File::Copy::BEGIN@12
1117µs11µsFile::Copy::::BEGIN@11File::Copy::BEGIN@11
111600ns600nsFile::Copy::::__ANON__File::Copy::__ANON__ (xsub)
0000s0sFile::Copy::::__ANON__[:326]File::Copy::__ANON__[:326]
0000s0sFile::Copy::::_catnameFile::Copy::_catname
0000s0sFile::Copy::::_moveFile::Copy::_move
0000s0sFile::Copy::::carpFile::Copy::carp
0000s0sFile::Copy::::cpFile::Copy::cp
0000s0sFile::Copy::::croakFile::Copy::croak
0000s0sFile::Copy::::moveFile::Copy::move
0000s0sFile::Copy::::mvFile::Copy::mv
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
2# source code has been placed in the public domain by the author.
3# Please be kind and preserve the documentation.
4#
5# Additions copyright 1996 by Charles Bailey. Permission is granted
6# to distribute the revised code under the same terms as Perl itself.
7
8package File::Copy;
9
10239µs114µs
# spent 14µs within File::Copy::BEGIN@10 which was called: # once (14µs+0s) by RBM::BEGIN@14 at line 10
use 5.006;
# spent 14µs making 1 call to File::Copy::BEGIN@10
11275µs214µs
# spent 11µs (7+3) within File::Copy::BEGIN@11 which was called: # once (7µs+3µs) by RBM::BEGIN@14 at line 11
use strict;
# spent 11µs making 1 call to File::Copy::BEGIN@11 # spent 3µs making 1 call to strict::import
12444µs4125µs
# spent 41µs (8+33) within File::Copy::BEGIN@12 which was called: # once (8µs+33µs) by RBM::BEGIN@14 at line 12 # spent 30µs (8+21) within File::Copy::BEGIN@12.6 which was called: # once (8µs+21µs) by RBM::BEGIN@14 at line 12
use warnings; no warnings 'newline';
# spent 41µs making 1 call to File::Copy::BEGIN@12 # spent 33µs making 1 call to warnings::import # spent 30µs making 1 call to File::Copy::BEGIN@12.6 # spent 21µs making 1 call to warnings::unimport
13223µs212µs
# spent 11µs (11+600ns) within File::Copy::BEGIN@13 which was called: # once (11µs+600ns) by RBM::BEGIN@14 at line 13
use File::Spec;
# spent 11µs making 1 call to File::Copy::BEGIN@13 # spent 600ns making 1 call to File::Copy::__ANON__
14235µs238µs
# spent 23µs (9+15) within File::Copy::BEGIN@14 which was called: # once (9µs+15µs) by RBM::BEGIN@14 at line 14
use Config;
# spent 23µs making 1 call to File::Copy::BEGIN@14 # spent 15µs making 1 call to Config::import
15# During perl build, we need File::Copy but Scalar::Util might not be built yet
16# And then we need these games to avoid loading overload, as that will
17# confuse miniperl during the bootstrap of perl.
18119µsmy $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 };
# spent 5µs executing statements in string eval
19# We want HiRes stat and utime if available
2011.77ms11.28ms
# spent 1.28ms (49µs+1.23) within File::Copy::BEGIN@20 which was called: # once (49µs+1.23ms) by RBM::BEGIN@14 at line 20
BEGIN { eval q{ use Time::HiRes qw( stat utime ) } };
# spent 1.28ms making 1 call to File::Copy::BEGIN@20
# spent 89µs executing statements in string eval
# includes 628µs spent executing 1 call to 1 sub defined therein.
21our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy);
22sub copy;
23sub syscopy;
24sub cp;
25sub mv;
26
271200ns$VERSION = '2.33';
28
291700nsrequire Exporter;
3017µs@ISA = qw(Exporter);
311700ns@EXPORT = qw(copy move);
321400ns@EXPORT_OK = qw(cp mv);
33
341100ns$Too_Big = 1024 * 1024 * 2;
35
36sub croak {
37 require Carp;
38 goto &Carp::croak;
39}
40
41sub carp {
42 require Carp;
43 goto &Carp::carp;
44}
45
46sub _catname {
47 my($from, $to) = @_;
48 if (not defined &basename) {
49 require File::Basename;
50 import File::Basename 'basename';
51 }
52
53 return File::Spec->catfile($to, basename($from));
54}
55
56# _eq($from, $to) tells whether $from and $to are identical
57
# spent 121µs (105+16) within File::Copy::_eq which was called 6 times, avg 20µs/call: # 6 times (105µs+16µs) by File::Copy::copy at line 93, avg 20µs/call
sub _eq {
58 my ($from, $to) = map {
591887µs1216µs $Scalar_Util_loaded && Scalar::Util::blessed($_)
# spent 16µs making 12 calls to Scalar::Util::blessed, avg 1µs/call
60 && overload::Method($_, q{""})
61 ? "$_"
62 : $_
63 } (@_);
6467µs return '' if ( (ref $from) xor (ref $to) );
6565µs return $from == $to if ref $from;
66634µs return $from eq $to;
67}
68
69
# spent 637ms (6.84+630) within File::Copy::copy which was called 6 times, avg 106ms/call: # 6 times (6.84ms+630ms) by File::Copy::Recursive::fcopy at line 175 of File/Copy/Recursive.pm, avg 106ms/call
sub copy {
7068µs croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ")
71 unless(@_ == 2 || @_ == 3);
72
7364µs my $from = shift;
7463µs my $to = shift;
75
7661µs my $size;
7763µs if (@_) {
78 $size = shift(@_) + 0;
79 croak("Bad buffer size for copy: $size\n") unless ($size > 0);
80 }
81
82617µs my $from_a_handle = (ref($from)
83 ? (ref($from) eq 'GLOB'
84 || UNIVERSAL::isa($from, 'GLOB')
85 || UNIVERSAL::isa($from, 'IO::Handle'))
86 : (ref(\$from) eq 'GLOB'));
87613µs my $to_a_handle = (ref($to)
88 ? (ref($to) eq 'GLOB'
89 || UNIVERSAL::isa($to, 'GLOB')
90 || UNIVERSAL::isa($to, 'IO::Handle'))
91 : (ref(\$to) eq 'GLOB'));
92
93623µs6121µs if (_eq($from, $to)) { # works for references, too
# spent 121µs making 6 calls to File::Copy::_eq, avg 20µs/call
94 carp("'$from' and '$to' are identical (not copied)");
95 return 0;
96 }
97
98634µs610µs if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) {
# spent 10µs making 6 calls to File::Copy::CORE:ftdir, avg 2µs/call
99 $to = _catname($from, $to);
100 }
101
1026111µs1256µs if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) &&
# spent 56µs making 12 calls to Config::FETCH, avg 5µs/call
103 !($^O eq 'MSWin32' || $^O eq 'os2')) {
1046258µs12239µs my @fs = stat($from);
# spent 221µs making 6 calls to Time::HiRes::stat, avg 37µs/call # spent 18µs making 6 calls to File::Copy::CORE:stat, avg 3µs/call
10568µs if (@fs) {
106648µs1233µs my @ts = stat($to);
# spent 25µs making 6 calls to Time::HiRes::stat, avg 4µs/call # spent 7µs making 6 calls to File::Copy::CORE:stat, avg 1µs/call
10763µs if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) {
108 carp("'$from' and '$to' are identical (not copied)");
109 return 0;
110 }
111 }
112 }
113 elsif (_eq($from, $to)) {
114 carp("'$from' and '$to' are identical (not copied)");
115 return 0;
116 }
117
11868µs if (defined &syscopy && !$Syscopy_is_copy
119 && !$to_a_handle
120 && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles
121 && !($from_a_handle && $^O eq 'MSWin32')
122 && !($from_a_handle && $^O eq 'NetWare')
123 )
124 {
125 if ($^O eq 'VMS' && -e $from
126 && ! -d $to && ! -d $from) {
127
128 # VMS natively inherits path components from the source of a
129 # copy, but we want the Unixy behavior of inheriting from
130 # the current working directory. Also, default in a trailing
131 # dot for null file types.
132
133 $to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.');
134
135 # Get rid of the old versions to be like UNIX
136 1 while unlink $to;
137 }
138
139 return syscopy($from, $to) || 0;
140 }
141
142610µs my $closefrom = 0;
14363µs my $closeto = 0;
14462µs my ($status, $r, $buf);
145695µs local($\) = '';
146
14762µs my $from_h;
14864µs if ($from_a_handle) {
149 $from_h = $from;
150 } else {
1516380µs6201µs open $from_h, "<", $from or goto fail_open1;
# spent 201µs making 6 calls to File::Copy::CORE:open, avg 34µs/call
152636µs66µs binmode $from_h or die "($!,$^E)";
# spent 6µs making 6 calls to File::Copy::CORE:binmode, avg 1µs/call
15363µs $closefrom = 1;
154 }
155
156 # Seems most logical to do this here, in case future changes would want to
157 # make this croak for some reason.
15864µs unless (defined $size) {
159645µs611µs $size = tied(*$from_h) ? 0 : -s $from_h || 0;
# spent 11µs making 6 calls to File::Copy::CORE:ftsize, avg 2µs/call
16064µs $size = 1024 if ($size < 512);
16164µs $size = $Too_Big if ($size > $Too_Big);
162 }
163
16462µs my $to_h;
16565µs if ($to_a_handle) {
166 $to_h = $to;
167 } else {
1681224µs $to_h = \do { local *FH }; # XXX is this line obsolete?
1696275µs6246µs open $to_h, ">", $to or goto fail_open2;
# spent 246µs making 6 calls to File::Copy::CORE:open, avg 41µs/call
170620µs62µs binmode $to_h or die "($!,$^E)";
# spent 2µs making 6 calls to File::Copy::CORE:binmode, avg 300ns/call
17163µs $closeto = 1;
172 }
173
174622µs $! = 0;
17562µs for (;;) {
17630071µs my ($r, $w, $t);
177300208ms300206ms defined($r = sysread($from_h, $buf, $size))
# spent 206ms making 300 calls to File::Copy::CORE:sysread, avg 686µs/call
178 or goto fail_inner;
17930045µs last unless $r;
180294958µs for ($w = 0; $w < $r; $w += $t) {
181294426ms294423ms $t = syswrite($to_h, $buf, $r - $w, $w)
# spent 423ms making 294 calls to File::Copy::CORE:syswrite, avg 1.44ms/call
182 or goto fail_inner;
183 }
184 }
185
1866117µs680µs close($to_h) || goto fail_open2 if $closeto;
# spent 80µs making 6 calls to File::Copy::CORE:close, avg 13µs/call
187622µs66µs close($from_h) || goto fail_open1 if $closefrom;
# spent 6µs making 6 calls to File::Copy::CORE:close, avg 1µs/call
188
189 # Use this idiom to avoid uninitialized value warning.
190697µs return 1;
191
192 # All of these contortions try to preserve error messages...
193 fail_inner:
194 if ($closeto) {
195 $status = $!;
196 $! = 0;
197 close $to_h;
198 $! = $status unless $!;
199 }
200 fail_open2:
201 if ($closefrom) {
202 $status = $!;
203 $! = 0;
204 close $from_h;
205 $! = $status unless $!;
206 }
207 fail_open1:
208 return 0;
209}
210
211sub cp {
212 my($from,$to) = @_;
213 my(@fromstat) = stat $from;
214 my(@tostat) = stat $to;
215 my $perm;
216
217 return 0 unless copy(@_) and @fromstat;
218
219 if (@tostat) {
220 $perm = $tostat[2];
221 } else {
222 $perm = $fromstat[2] & ~(umask || 0);
223 @tostat = stat $to;
224 }
225 # Might be more robust to look for S_I* in Fcntl, but we're
226 # trying to avoid dependence on any XS-containing modules,
227 # since File::Copy is used during the Perl build.
228 $perm &= 07777;
229 if ($perm & 06000) {
230 croak("Unable to check setuid/setgid permissions for $to: $!")
231 unless @tostat;
232
233 if ($perm & 04000 and # setuid
234 $fromstat[4] != $tostat[4]) { # owner must match
235 $perm &= ~06000;
236 }
237
238 if ($perm & 02000 && $> != 0) { # if not root, setgid
239 my $ok = $fromstat[5] == $tostat[5]; # group must match
240 if ($ok) { # and we must be in group
241 $ok = grep { $_ == $fromstat[5] } split /\s+/, $)
242 }
243 $perm &= ~06000 unless $ok;
244 }
245 }
246 return 0 unless @tostat;
247 return 1 if $perm == ($tostat[2] & 07777);
248 return eval { chmod $perm, $to; } ? 1 : 0;
249}
250
251sub _move {
252 croak("Usage: move(FROM, TO) ") unless @_ == 3;
253
254 my($from,$to,$fallback) = @_;
255
256 my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts);
257
258 if (-d $to && ! -d $from) {
259 $to = _catname($from, $to);
260 }
261
262 ($tosz1,$tomt1) = (stat($to))[7,9];
263 $fromsz = -s $from;
264 if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) {
265 # will not rename with overwrite
266 unlink $to;
267 }
268
269 if ($^O eq 'VMS' && -e $from
270 && ! -d $to && ! -d $from) {
271
272 # VMS natively inherits path components from the source of a
273 # copy, but we want the Unixy behavior of inheriting from
274 # the current working directory. Also, default in a trailing
275 # dot for null file types.
276
277 $to = VMS::Filespec::rmsexpand(VMS::Filespec::vmsify($to), '.');
278
279 # Get rid of the old versions to be like UNIX
280 1 while unlink $to;
281 }
282
283 return 1 if rename $from, $to;
284
285 # Did rename return an error even though it succeeded, because $to
286 # is on a remote NFS file system, and NFS lost the server's ack?
287 return 1 if defined($fromsz) && !-e $from && # $from disappeared
288 (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there
289 ((!defined $tosz1) || # not before or
290 ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed
291 $tosz2 == $fromsz; # it's all there
292
293 ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something
294
295 {
296 local $@;
297 eval {
298 local $SIG{__DIE__};
299 $fallback->($from,$to) or die;
300 my($atime, $mtime) = (stat($from))[8,9];
301 utime($atime, $mtime, $to);
302 unlink($from) or die;
303 };
304 return 1 unless $@;
305 }
306 ($sts,$ossts) = ($! + 0, $^E + 0);
307
308 ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1;
309 unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2;
310 ($!,$^E) = ($sts,$ossts);
311 return 0;
312}
313
314sub move { _move(@_,\&copy); }
315sub mv { _move(@_,\&cp); }
316
317# &syscopy is an XSUB under OS/2
3181600nsunless (defined &syscopy) {
31912µs if ($^O eq 'VMS') {
320 *syscopy = \&rmscopy;
321 } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) {
322 # Win32::CopyFile() fill only work if we can load Win32.xs
323 *syscopy = sub {
324 return 0 unless @_ == 2;
325 return Win32::CopyFile(@_, 1);
326 };
327 } else {
3281100ns $Syscopy_is_copy = 1;
32912µs *syscopy = \&copy;
330 }
331}
332
333112µs1;
334
335__END__
 
# spent 8µs within File::Copy::CORE:binmode which was called 12 times, avg 692ns/call: # 6 times (6µs+0s) by File::Copy::copy at line 152, avg 1µs/call # 6 times (2µs+0s) by File::Copy::copy at line 170, avg 300ns/call
sub File::Copy::CORE:binmode; # opcode
# spent 86µs within File::Copy::CORE:close which was called 12 times, avg 7µs/call: # 6 times (80µs+0s) by File::Copy::copy at line 186, avg 13µs/call # 6 times (6µs+0s) by File::Copy::copy at line 187, avg 1µs/call
sub File::Copy::CORE:close; # opcode
# spent 10µs within File::Copy::CORE:ftdir which was called 6 times, avg 2µs/call: # 6 times (10µs+0s) by File::Copy::copy at line 98, avg 2µs/call
sub File::Copy::CORE:ftdir; # opcode
# spent 11µs within File::Copy::CORE:ftsize which was called 6 times, avg 2µs/call: # 6 times (11µs+0s) by File::Copy::copy at line 159, avg 2µs/call
sub File::Copy::CORE:ftsize; # opcode
# spent 448µs within File::Copy::CORE:open which was called 12 times, avg 37µs/call: # 6 times (246µs+0s) by File::Copy::copy at line 169, avg 41µs/call # 6 times (201µs+0s) by File::Copy::copy at line 151, avg 34µs/call
sub File::Copy::CORE:open; # opcode
# spent 25µs within File::Copy::CORE:stat which was called 12 times, avg 2µs/call: # 6 times (18µs+0s) by Time::HiRes::stat at line 104, avg 3µs/call # 6 times (7µs+0s) by Time::HiRes::stat at line 106, avg 1µs/call
sub File::Copy::CORE:stat; # opcode
# spent 206ms within File::Copy::CORE:sysread which was called 300 times, avg 686µs/call: # 300 times (206ms+0s) by File::Copy::copy at line 177, avg 686µs/call
sub File::Copy::CORE:sysread; # opcode
# spent 423ms within File::Copy::CORE:syswrite which was called 294 times, avg 1.44ms/call: # 294 times (423ms+0s) by File::Copy::copy at line 181, avg 1.44ms/call
sub File::Copy::CORE:syswrite; # opcode
# spent 600ns within File::Copy::__ANON__ which was called: # once (600ns+0s) by File::Copy::BEGIN@13 at line 13
sub File::Copy::__ANON__; # xsub
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.