Filename | /usr/lib/perl5/5.14/File/Copy.pm |
Statements | Executed 427494 statements in 17.3s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
15806 | 2 | 1 | 5.57s | 5.57s | CORE:open (opcode) | File::Copy::
15808 | 3 | 1 | 2.82s | 2.82s | CORE:stat (opcode) | File::Copy::
15943 | 1 | 1 | 2.69s | 2.69s | CORE:sysread (opcode) | File::Copy::
8040 | 1 | 1 | 1.88s | 1.88s | CORE:syswrite (opcode) | File::Copy::
7905 | 2 | 1 | 1.27s | 1.27s | CORE:ftdir (opcode) | File::Copy::
7903 | 1 | 1 | 1.24s | 17.2s | copy | File::Copy::
15806 | 2 | 1 | 792ms | 792ms | CORE:close (opcode) | File::Copy::
7905 | 2 | 1 | 648ms | 648ms | CORE:ftsize (opcode) | File::Copy::
2 | 1 | 1 | 225ms | 225ms | CORE:rename (opcode) | File::Copy::
7903 | 1 | 1 | 140ms | 166ms | _eq | File::Copy::
15806 | 2 | 1 | 33.7ms | 33.7ms | CORE:binmode (opcode) | File::Copy::
1 | 1 | 1 | 12.5ms | 13.5ms | BEGIN@13 | File::Copy::
1 | 1 | 1 | 277µs | 277µs | BEGIN@10 | File::Copy::
2 | 1 | 1 | 161µs | 226ms | _move | File::Copy::
2 | 2 | 1 | 35µs | 226ms | move | File::Copy::
1 | 1 | 1 | 21µs | 44µs | BEGIN@14 | File::Copy::
1 | 1 | 1 | 17µs | 24µs | BEGIN@11 | File::Copy::
1 | 1 | 1 | 15µs | 35µs | BEGIN@12 | File::Copy::
1 | 1 | 1 | 9µs | 9µs | BEGIN@47 | File::Copy::
0 | 0 | 0 | 0s | 0s | __ANON__[:419] | File::Copy::
0 | 0 | 0 | 0s | 0s | __ANON__[:425] | File::Copy::
0 | 0 | 0 | 0s | 0s | _catname | File::Copy::
0 | 0 | 0 | 0s | 0s | _vms_efs | File::Copy::
0 | 0 | 0 | 0s | 0s | _vms_unix_rpt | File::Copy::
0 | 0 | 0 | 0s | 0s | carp | File::Copy::
0 | 0 | 0 | 0s | 0s | cp | File::Copy::
0 | 0 | 0 | 0s | 0s | croak | File::Copy::
0 | 0 | 0 | 0s | 0s | mv | File::Copy::
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 | |||||
8 | package File::Copy; | ||||
9 | |||||
10 | 2 | 190µs | 1 | 277µs | # spent 277µs within File::Copy::BEGIN@10 which was called:
# once (277µs+0s) by installer::BEGIN@34 at line 10 # spent 277µs making 1 call to File::Copy::BEGIN@10 |
11 | 2 | 53µs | 2 | 31µs | # spent 24µs (17+7) within File::Copy::BEGIN@11 which was called:
# once (17µs+7µs) by installer::BEGIN@34 at line 11 # spent 24µs making 1 call to File::Copy::BEGIN@11
# spent 7µs making 1 call to strict::import |
12 | 2 | 50µs | 2 | 55µs | # spent 35µs (15+20) within File::Copy::BEGIN@12 which was called:
# once (15µs+20µs) by installer::BEGIN@34 at line 12 # spent 35µs making 1 call to File::Copy::BEGIN@12
# spent 20µs making 1 call to warnings::import |
13 | 2 | 2.43ms | 1 | 13.5ms | # spent 13.5ms (12.5+1.04) within File::Copy::BEGIN@13 which was called:
# once (12.5ms+1.04ms) by installer::BEGIN@34 at line 13 # spent 13.5ms making 1 call to File::Copy::BEGIN@13 |
14 | 2 | 381µs | 2 | 67µs | # spent 44µs (21+23) within File::Copy::BEGIN@14 which was called:
# once (21µs+23µs) by installer::BEGIN@34 at line 14 # spent 44µs making 1 call to File::Copy::BEGIN@14
# spent 23µ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. | ||||
18 | 1 | 39µs | my $Scalar_Util_loaded = eval q{ require Scalar::Util; require overload; 1 }; # spent 2.43ms executing statements in string eval | ||
19 | 1 | 3µs | our(@ISA, @EXPORT, @EXPORT_OK, $VERSION, $Too_Big, $Syscopy_is_copy); | ||
20 | sub copy; | ||||
21 | sub syscopy; | ||||
22 | sub cp; | ||||
23 | sub mv; | ||||
24 | |||||
25 | 1 | 2µs | $VERSION = '2.21'; | ||
26 | |||||
27 | 1 | 2µs | require Exporter; | ||
28 | 1 | 9µs | @ISA = qw(Exporter); | ||
29 | 1 | 3µs | @EXPORT = qw(copy move); | ||
30 | 1 | 3µs | @EXPORT_OK = qw(cp mv); | ||
31 | |||||
32 | 1 | 500ns | $Too_Big = 1024 * 1024 * 2; | ||
33 | |||||
34 | sub croak { | ||||
35 | require Carp; | ||||
36 | goto &Carp::croak; | ||||
37 | } | ||||
38 | |||||
39 | sub carp { | ||||
40 | require Carp; | ||||
41 | goto &Carp::carp; | ||||
42 | } | ||||
43 | |||||
44 | # Look up the feature settings on VMS using VMS::Feature when available. | ||||
45 | |||||
46 | 1 | 1µs | my $use_vms_feature = 0; | ||
47 | # spent 9µs within File::Copy::BEGIN@47 which was called:
# once (9µs+0s) by installer::BEGIN@34 at line 53 | ||||
48 | 1 | 9µs | if ($^O eq 'VMS') { | ||
49 | if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { | ||||
50 | $use_vms_feature = 1; | ||||
51 | } | ||||
52 | } | ||||
53 | 1 | 3.54ms | 1 | 9µs | } # spent 9µs making 1 call to File::Copy::BEGIN@47 |
54 | |||||
55 | # Need to look up the UNIX report mode. This may become a dynamic mode | ||||
56 | # in the future. | ||||
57 | sub _vms_unix_rpt { | ||||
58 | my $unix_rpt; | ||||
59 | if ($use_vms_feature) { | ||||
60 | $unix_rpt = VMS::Feature::current("filename_unix_report"); | ||||
61 | } else { | ||||
62 | my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; | ||||
63 | $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; | ||||
64 | } | ||||
65 | return $unix_rpt; | ||||
66 | } | ||||
67 | |||||
68 | # Need to look up the EFS character set mode. This may become a dynamic | ||||
69 | # mode in the future. | ||||
70 | sub _vms_efs { | ||||
71 | my $efs; | ||||
72 | if ($use_vms_feature) { | ||||
73 | $efs = VMS::Feature::current("efs_charset"); | ||||
74 | } else { | ||||
75 | my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; | ||||
76 | $efs = $env_efs =~ /^[ET1]/i; | ||||
77 | } | ||||
78 | return $efs; | ||||
79 | } | ||||
80 | |||||
81 | |||||
82 | sub _catname { | ||||
83 | my($from, $to) = @_; | ||||
84 | if (not defined &basename) { | ||||
85 | require File::Basename; | ||||
86 | import File::Basename 'basename'; | ||||
87 | } | ||||
88 | |||||
89 | return File::Spec->catfile($to, basename($from)); | ||||
90 | } | ||||
91 | |||||
92 | # _eq($from, $to) tells whether $from and $to are identical | ||||
93 | # spent 166ms (140+25.7) within File::Copy::_eq which was called 7903 times, avg 21µs/call:
# 7903 times (140ms+25.7ms) by File::Copy::copy at line 129, avg 21µs/call | ||||
94 | 15806 | 98.5ms | 15806 | 25.7ms | my ($from, $to) = map { # spent 25.7ms making 15806 calls to Scalar::Util::blessed, avg 2µs/call |
95 | 7903 | 33.9ms | $Scalar_Util_loaded && Scalar::Util::blessed($_) | ||
96 | && overload::Method($_, q{""}) | ||||
97 | ? "$_" | ||||
98 | : $_ | ||||
99 | } (@_); | ||||
100 | 7903 | 5.49ms | return '' if ( (ref $from) xor (ref $to) ); | ||
101 | 7903 | 3.11ms | return $from == $to if ref $from; | ||
102 | 7903 | 35.0ms | return $from eq $to; | ||
103 | } | ||||
104 | |||||
105 | # spent 17.2s (1.24+15.9) within File::Copy::copy which was called 7903 times, avg 2.17ms/call:
# 7903 times (1.24s+15.9s) by installer::systemactions::copy_one_file at line 298 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/systemactions.pm, avg 2.17ms/call | ||||
106 | 7903 | 7.81ms | croak("Usage: copy(FROM, TO [, BUFFERSIZE]) ") | ||
107 | unless(@_ == 2 || @_ == 3); | ||||
108 | |||||
109 | 7903 | 6.01ms | my $from = shift; | ||
110 | 7903 | 4.05ms | my $to = shift; | ||
111 | |||||
112 | 7903 | 2.82ms | my $size; | ||
113 | 7903 | 3.59ms | if (@_) { | ||
114 | $size = shift(@_) + 0; | ||||
115 | croak("Bad buffer size for copy: $size\n") unless ($size > 0); | ||||
116 | } | ||||
117 | |||||
118 | 7903 | 16.9ms | my $from_a_handle = (ref($from) | ||
119 | ? (ref($from) eq 'GLOB' | ||||
120 | || UNIVERSAL::isa($from, 'GLOB') | ||||
121 | || UNIVERSAL::isa($from, 'IO::Handle')) | ||||
122 | : (ref(\$from) eq 'GLOB')); | ||||
123 | 7903 | 7.64ms | my $to_a_handle = (ref($to) | ||
124 | ? (ref($to) eq 'GLOB' | ||||
125 | || UNIVERSAL::isa($to, 'GLOB') | ||||
126 | || UNIVERSAL::isa($to, 'IO::Handle')) | ||||
127 | : (ref(\$to) eq 'GLOB')); | ||||
128 | |||||
129 | 7903 | 22.6ms | 7903 | 166ms | if (_eq($from, $to)) { # works for references, too # spent 166ms making 7903 calls to File::Copy::_eq, avg 21µs/call |
130 | carp("'$from' and '$to' are identical (not copied)"); | ||||
131 | # The "copy" was a success as the source and destination contain | ||||
132 | # the same data. | ||||
133 | return 1; | ||||
134 | } | ||||
135 | |||||
136 | 7903 | 160ms | 15806 | 75.0ms | if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) && # spent 75.0ms making 15806 calls to Config::FETCH, avg 5µs/call |
137 | !($^O eq 'MSWin32' || $^O eq 'os2')) { | ||||
138 | 7903 | 1.45s | 7903 | 1.39s | my @fs = stat($from); # spent 1.39s making 7903 calls to File::Copy::CORE:stat, avg 176µs/call |
139 | 7903 | 15.3ms | if (@fs) { | ||
140 | 7903 | 1.47s | 7903 | 1.43s | my @ts = stat($to); # spent 1.43s making 7903 calls to File::Copy::CORE:stat, avg 181µs/call |
141 | 7903 | 10.4ms | if (@ts && $fs[0] == $ts[0] && $fs[1] == $ts[1] && !-p $from) { | ||
142 | carp("'$from' and '$to' are identical (not copied)"); | ||||
143 | return 0; | ||||
144 | } | ||||
145 | } | ||||
146 | } | ||||
147 | |||||
148 | 7903 | 1.32s | 7903 | 1.27s | if (!$from_a_handle && !$to_a_handle && -d $to && ! -d $from) { # spent 1.27s making 7903 calls to File::Copy::CORE:ftdir, avg 161µs/call |
149 | $to = _catname($from, $to); | ||||
150 | } | ||||
151 | |||||
152 | 7903 | 11.4ms | if (defined &syscopy && !$Syscopy_is_copy | ||
153 | && !$to_a_handle | ||||
154 | && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles | ||||
155 | && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. | ||||
156 | && !($from_a_handle && $^O eq 'MSWin32') | ||||
157 | && !($from_a_handle && $^O eq 'NetWare') | ||||
158 | ) | ||||
159 | { | ||||
160 | my $copy_to = $to; | ||||
161 | |||||
162 | if ($^O eq 'VMS' && -e $from) { | ||||
163 | |||||
164 | if (! -d $to && ! -d $from) { | ||||
165 | |||||
166 | my $vms_efs = _vms_efs(); | ||||
167 | my $unix_rpt = _vms_unix_rpt(); | ||||
168 | my $unix_mode = 0; | ||||
169 | my $from_unix = 0; | ||||
170 | $from_unix = 1 if ($from =~ /^\.\.?$/); | ||||
171 | my $from_vms = 0; | ||||
172 | $from_vms = 1 if ($from =~ m#[\[<\]]#); | ||||
173 | |||||
174 | # Need to know if we are in Unix mode. | ||||
175 | if ($from_vms == $from_unix) { | ||||
176 | $unix_mode = $unix_rpt; | ||||
177 | } else { | ||||
178 | $unix_mode = $from_unix; | ||||
179 | } | ||||
180 | |||||
181 | # VMS has sticky defaults on extensions, which means that | ||||
182 | # if there is a null extension on the destination file, it | ||||
183 | # will inherit the extension of the source file | ||||
184 | # So add a '.' for a null extension. | ||||
185 | |||||
186 | # In unix_rpt mode, the trailing dot should not be added. | ||||
187 | |||||
188 | if ($vms_efs) { | ||||
189 | $copy_to = $to; | ||||
190 | } else { | ||||
191 | $copy_to = VMS::Filespec::vmsify($to); | ||||
192 | } | ||||
193 | my ($vol, $dirs, $file) = File::Spec->splitpath($copy_to); | ||||
194 | $file = $file . '.' | ||||
195 | unless (($file =~ /(?<!\^)\./) || $unix_rpt); | ||||
196 | $copy_to = File::Spec->catpath($vol, $dirs, $file); | ||||
197 | |||||
198 | # Get rid of the old versions to be like UNIX | ||||
199 | 1 while unlink $copy_to; | ||||
200 | } | ||||
201 | } | ||||
202 | |||||
203 | return syscopy($from, $copy_to) || 0; | ||||
204 | } | ||||
205 | |||||
206 | 7903 | 5.25ms | my $closefrom = 0; | ||
207 | 7903 | 3.07ms | my $closeto = 0; | ||
208 | 7903 | 4.09ms | my ($status, $r, $buf); | ||
209 | 7903 | 35.2ms | local($\) = ''; | ||
210 | |||||
211 | 7903 | 3.31ms | my $from_h; | ||
212 | 7903 | 7.98ms | if ($from_a_handle) { | ||
213 | $from_h = $from; | ||||
214 | } else { | ||||
215 | 7903 | 1.81s | 7903 | 1.73s | open $from_h, "<", $from or goto fail_open1; # spent 1.73s making 7903 calls to File::Copy::CORE:open, avg 219µs/call |
216 | 7903 | 44.5ms | 7903 | 17.5ms | binmode $from_h or die "($!,$^E)"; # spent 17.5ms making 7903 calls to File::Copy::CORE:binmode, avg 2µs/call |
217 | 7903 | 14.8ms | $closefrom = 1; | ||
218 | } | ||||
219 | |||||
220 | # Seems most logical to do this here, in case future changes would want to | ||||
221 | # make this croak for some reason. | ||||
222 | 7903 | 8.19ms | unless (defined $size) { | ||
223 | 7903 | 689ms | 7903 | 648ms | $size = tied(*$from_h) ? 0 : -s $from_h || 0; # spent 648ms making 7903 calls to File::Copy::CORE:ftsize, avg 82µs/call |
224 | 7903 | 5.36ms | $size = 1024 if ($size < 512); | ||
225 | 7903 | 8.61ms | $size = $Too_Big if ($size > $Too_Big); | ||
226 | } | ||||
227 | |||||
228 | 7903 | 3.49ms | my $to_h; | ||
229 | 7903 | 8.00ms | if ($to_a_handle) { | ||
230 | $to_h = $to; | ||||
231 | } else { | ||||
232 | 15806 | 37.1ms | $to_h = \do { local *FH }; # XXX is this line obsolete? | ||
233 | 7903 | 3.89s | 7903 | 3.84s | open $to_h, ">", $to or goto fail_open2; # spent 3.84s making 7903 calls to File::Copy::CORE:open, avg 486µs/call |
234 | 7903 | 55.4ms | 7903 | 16.1ms | binmode $to_h or die "($!,$^E)"; # spent 16.1ms making 7903 calls to File::Copy::CORE:binmode, avg 2µs/call |
235 | 7903 | 16.0ms | $closeto = 1; | ||
236 | } | ||||
237 | |||||
238 | 7903 | 9.57ms | $! = 0; | ||
239 | 7903 | 4.28ms | for (;;) { | ||
240 | 15943 | 9.84ms | my ($r, $w, $t); | ||
241 | 15943 | 2.76s | 15943 | 2.69s | defined($r = sysread($from_h, $buf, $size)) # spent 2.69s making 15943 calls to File::Copy::CORE:sysread, avg 169µs/call |
242 | or goto fail_inner; | ||||
243 | 15943 | 11.8ms | last unless $r; | ||
244 | 8040 | 43.9ms | for ($w = 0; $w < $r; $w += $t) { | ||
245 | 8040 | 1.94s | 8040 | 1.88s | $t = syswrite($to_h, $buf, $r - $w, $w) # spent 1.88s making 8040 calls to File::Copy::CORE:syswrite, avg 234µs/call |
246 | or goto fail_inner; | ||||
247 | } | ||||
248 | } | ||||
249 | |||||
250 | 7903 | 635ms | 7903 | 583ms | close($to_h) || goto fail_open2 if $closeto; # spent 583ms making 7903 calls to File::Copy::CORE:close, avg 74µs/call |
251 | 7903 | 242ms | 7903 | 209ms | close($from_h) || goto fail_open1 if $closefrom; # spent 209ms making 7903 calls to File::Copy::CORE:close, avg 26µs/call |
252 | |||||
253 | # Use this idiom to avoid uninitialized value warning. | ||||
254 | 7903 | 89.6ms | return 1; | ||
255 | |||||
256 | # All of these contortions try to preserve error messages... | ||||
257 | fail_inner: | ||||
258 | if ($closeto) { | ||||
259 | $status = $!; | ||||
260 | $! = 0; | ||||
261 | close $to_h; | ||||
262 | $! = $status unless $!; | ||||
263 | } | ||||
264 | fail_open2: | ||||
265 | if ($closefrom) { | ||||
266 | $status = $!; | ||||
267 | $! = 0; | ||||
268 | close $from_h; | ||||
269 | $! = $status unless $!; | ||||
270 | } | ||||
271 | fail_open1: | ||||
272 | return 0; | ||||
273 | } | ||||
274 | |||||
275 | sub cp { | ||||
276 | my($from,$to) = @_; | ||||
277 | my(@fromstat) = stat $from; | ||||
278 | my(@tostat) = stat $to; | ||||
279 | my $perm; | ||||
280 | |||||
281 | return 0 unless copy(@_) and @fromstat; | ||||
282 | |||||
283 | if (@tostat) { | ||||
284 | $perm = $tostat[2]; | ||||
285 | } else { | ||||
286 | $perm = $fromstat[2] & ~(umask || 0); | ||||
287 | @tostat = stat $to; | ||||
288 | } | ||||
289 | # Might be more robust to look for S_I* in Fcntl, but we're | ||||
290 | # trying to avoid dependence on any XS-containing modules, | ||||
291 | # since File::Copy is used during the Perl build. | ||||
292 | $perm &= 07777; | ||||
293 | if ($perm & 06000) { | ||||
294 | croak("Unable to check setuid/setgid permissions for $to: $!") | ||||
295 | unless @tostat; | ||||
296 | |||||
297 | if ($perm & 04000 and # setuid | ||||
298 | $fromstat[4] != $tostat[4]) { # owner must match | ||||
299 | $perm &= ~06000; | ||||
300 | } | ||||
301 | |||||
302 | if ($perm & 02000 && $> != 0) { # if not root, setgid | ||||
303 | my $ok = $fromstat[5] == $tostat[5]; # group must match | ||||
304 | if ($ok) { # and we must be in group | ||||
305 | $ok = grep { $_ == $fromstat[5] } split /\s+/, $) | ||||
306 | } | ||||
307 | $perm &= ~06000 unless $ok; | ||||
308 | } | ||||
309 | } | ||||
310 | return 0 unless @tostat; | ||||
311 | return 1 if $perm == ($tostat[2] & 07777); | ||||
312 | return eval { chmod $perm, $to; } ? 1 : 0; | ||||
313 | } | ||||
314 | |||||
315 | # spent 226ms (161µs+226) within File::Copy::_move which was called 2 times, avg 113ms/call:
# 2 times (161µs+226ms) by File::Copy::move at line 406, avg 113ms/call | ||||
316 | 2 | 3µs | croak("Usage: move(FROM, TO) ") unless @_ == 3; | ||
317 | |||||
318 | 2 | 6µs | my($from,$to,$fallback) = @_; | ||
319 | |||||
320 | 2 | 2µs | my($fromsz,$tosz1,$tomt1,$tosz2,$tomt2,$sts,$ossts); | ||
321 | |||||
322 | 2 | 339µs | 2 | 322µs | if (-d $to && ! -d $from) { # spent 322µs making 2 calls to File::Copy::CORE:ftdir, avg 161µs/call |
323 | $to = _catname($from, $to); | ||||
324 | } | ||||
325 | |||||
326 | 2 | 328µs | 2 | 310µs | ($tosz1,$tomt1) = (stat($to))[7,9]; # spent 310µs making 2 calls to File::Copy::CORE:stat, avg 155µs/call |
327 | 2 | 169µs | 2 | 155µs | $fromsz = -s $from; # spent 155µs making 2 calls to File::Copy::CORE:ftsize, avg 78µs/call |
328 | 2 | 9µs | if ($^O eq 'os2' and defined $tosz1 and defined $fromsz) { | ||
329 | # will not rename with overwrite | ||||
330 | unlink $to; | ||||
331 | } | ||||
332 | |||||
333 | 2 | 3µs | my $rename_to = $to; | ||
334 | 2 | 10µs | if (-$^O eq 'VMS' && -e $from) { | ||
335 | |||||
336 | if (! -d $to && ! -d $from) { | ||||
337 | |||||
338 | my $vms_efs = _vms_efs(); | ||||
339 | my $unix_rpt = _vms_unix_rpt(); | ||||
340 | my $unix_mode = 0; | ||||
341 | my $from_unix = 0; | ||||
342 | $from_unix = 1 if ($from =~ /^\.\.?$/); | ||||
343 | my $from_vms = 0; | ||||
344 | $from_vms = 1 if ($from =~ m#[\[<\]]#); | ||||
345 | |||||
346 | # Need to know if we are in Unix mode. | ||||
347 | if ($from_vms == $from_unix) { | ||||
348 | $unix_mode = $unix_rpt; | ||||
349 | } else { | ||||
350 | $unix_mode = $from_unix; | ||||
351 | } | ||||
352 | |||||
353 | # VMS has sticky defaults on extensions, which means that | ||||
354 | # if there is a null extension on the destination file, it | ||||
355 | # will inherit the extension of the source file | ||||
356 | # So add a '.' for a null extension. | ||||
357 | |||||
358 | # In unix_rpt mode, the trailing dot should not be added. | ||||
359 | |||||
360 | if ($vms_efs) { | ||||
361 | $rename_to = $to; | ||||
362 | } else { | ||||
363 | $rename_to = VMS::Filespec::vmsify($to); | ||||
364 | } | ||||
365 | my ($vol, $dirs, $file) = File::Spec->splitpath($rename_to); | ||||
366 | $file = $file . '.' | ||||
367 | unless (($file =~ /(?<!\^)\./) || $unix_rpt); | ||||
368 | $rename_to = File::Spec->catpath($vol, $dirs, $file); | ||||
369 | |||||
370 | # Get rid of the old versions to be like UNIX | ||||
371 | 1 while unlink $rename_to; | ||||
372 | } | ||||
373 | } | ||||
374 | |||||
375 | 2 | 225ms | 2 | 225ms | return 1 if rename $from, $rename_to; # spent 225ms making 2 calls to File::Copy::CORE:rename, avg 113ms/call |
376 | |||||
377 | # Did rename return an error even though it succeeded, because $to | ||||
378 | # is on a remote NFS file system, and NFS lost the server's ack? | ||||
379 | return 1 if defined($fromsz) && !-e $from && # $from disappeared | ||||
380 | (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there | ||||
381 | ((!defined $tosz1) || # not before or | ||||
382 | ($tosz1 != $tosz2 or $tomt1 != $tomt2)) && # was changed | ||||
383 | $tosz2 == $fromsz; # it's all there | ||||
384 | |||||
385 | ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something | ||||
386 | |||||
387 | { | ||||
388 | local $@; | ||||
389 | eval { | ||||
390 | local $SIG{__DIE__}; | ||||
391 | $fallback->($from,$to) or die; | ||||
392 | my($atime, $mtime) = (stat($from))[8,9]; | ||||
393 | utime($atime, $mtime, $to); | ||||
394 | unlink($from) or die; | ||||
395 | }; | ||||
396 | return 1 unless $@; | ||||
397 | } | ||||
398 | ($sts,$ossts) = ($! + 0, $^E + 0); | ||||
399 | |||||
400 | ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; | ||||
401 | unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2; | ||||
402 | ($!,$^E) = ($sts,$ossts); | ||||
403 | return 0; | ||||
404 | } | ||||
405 | |||||
406 | 2 | 34µs | 2 | 226ms | # spent 226ms (35µs+226) within File::Copy::move which was called 2 times, avg 113ms/call:
# once (17µs+136ms) by installer::systemactions::rename_directory at line 880 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/systemactions.pm
# once (18µs+90.1ms) by installer::systemactions::rename_string_in_directory at line 820 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/systemactions.pm # spent 226ms making 2 calls to File::Copy::_move, avg 113ms/call |
407 | sub mv { _move(@_,\&cp); } | ||||
408 | |||||
409 | # &syscopy is an XSUB under OS/2 | ||||
410 | 1 | 2µs | unless (defined &syscopy) { | ||
411 | 1 | 6µs | if ($^O eq 'VMS') { | ||
412 | *syscopy = \&rmscopy; | ||||
413 | } elsif ($^O eq 'mpeix') { | ||||
414 | *syscopy = sub { | ||||
415 | return 0 unless @_ == 2; | ||||
416 | # Use the MPE cp program in order to | ||||
417 | # preserve MPE file attributes. | ||||
418 | return system('/bin/cp', '-f', $_[0], $_[1]) == 0; | ||||
419 | }; | ||||
420 | } elsif ($^O eq 'MSWin32' && defined &DynaLoader::boot_DynaLoader) { | ||||
421 | # Win32::CopyFile() fill only work if we can load Win32.xs | ||||
422 | *syscopy = sub { | ||||
423 | return 0 unless @_ == 2; | ||||
424 | return Win32::CopyFile(@_, 1); | ||||
425 | }; | ||||
426 | } else { | ||||
427 | 1 | 1µs | $Syscopy_is_copy = 1; | ||
428 | 1 | 6µs | *syscopy = \© | ||
429 | } | ||||
430 | } | ||||
431 | |||||
432 | 1 | 84µs | 1; | ||
433 | |||||
434 | __END__ | ||||
sub File::Copy::CORE:binmode; # opcode | |||||
sub File::Copy::CORE:close; # opcode | |||||
sub File::Copy::CORE:ftdir; # opcode | |||||
sub File::Copy::CORE:ftsize; # opcode | |||||
sub File::Copy::CORE:open; # opcode | |||||
# spent 225ms within File::Copy::CORE:rename which was called 2 times, avg 113ms/call:
# 2 times (225ms+0s) by File::Copy::_move at line 375, avg 113ms/call | |||||
# spent 2.82s within File::Copy::CORE:stat which was called 15808 times, avg 178µs/call:
# 7903 times (1.43s+0s) by File::Copy::copy at line 140, avg 181µs/call
# 7903 times (1.39s+0s) by File::Copy::copy at line 138, avg 176µs/call
# 2 times (310µs+0s) by File::Copy::_move at line 326, avg 155µs/call | |||||
# spent 2.69s within File::Copy::CORE:sysread which was called 15943 times, avg 169µs/call:
# 15943 times (2.69s+0s) by File::Copy::copy at line 241, avg 169µs/call | |||||
# spent 1.88s within File::Copy::CORE:syswrite which was called 8040 times, avg 234µs/call:
# 8040 times (1.88s+0s) by File::Copy::copy at line 245, avg 234µs/call |