diff options
Diffstat (limited to 'installperl')
-rwxr-xr-x | installperl | 41 |
1 files changed, 37 insertions, 4 deletions
diff --git a/installperl b/installperl index 0530d154f2..87b81ac2f1 100755 --- a/installperl +++ b/installperl @@ -69,10 +69,10 @@ if ($d_shrplib) { # First we install the version-numbered executables. -&unlink("$installbin/perl$ver"); +&safe_unlink("$installbin/perl$ver"); &cmd("cp perl $installbin/perl$ver"); -&unlink("$installbin/sperl$ver"); +&safe_unlink("$installbin/sperl$ver"); if ($d_dosuid) { &cmd("cp suidperl $installbin/sperl$ver"); &chmod(04711, "$installbin/sperl$ver"); @@ -83,13 +83,13 @@ exit 0 if $versiononly; # Make links to ordinary names if installbin directory isn't current directory. if (! &samepath($installbin, '.')) { - &unlink("$installbin/perl", "$installbin/suidperl"); + &safe_unlink("$installbin/perl", "$installbin/suidperl"); &link("$installbin/perl$ver", "$installbin/perl"); &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid; } if (! &samepath($installbin, 'x2p')) { - &unlink("$installbin/a2p"); + &safe_unlink("$installbin/a2p"); &cmd("cp x2p/a2p $installbin/a2p"); &chmod(0755, "$installbin/a2p"); } @@ -248,6 +248,22 @@ sub unlink { } } +sub safe_unlink { + local(@names) = @_; + + foreach $name (@names) { + next unless -e $name; + print STDERR " unlink $name\n"; + next if $nonono; + next if unlink($name); + warn "Couldn't unlink $name: $!\n"; + if ($! =~ /busy/i) { + print STDERR " mv $name $name.old\n"; + &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n"; + } + } +} + sub cmd { local($cmd) = @_; print STDERR " $cmd\n"; @@ -257,6 +273,19 @@ sub cmd { } } +sub rename { + local($from,$to) = @_; + unless (unlink($to)) { + my($i); + for ($i = 1; $i < 50; $i++) { + last if rename($to, "$to.$i"); + } + return 0 if $i >= 50; # Give up! + } + link($from,$to) || return 0; + unlink($from); +} + sub link { local($from,$to) = @_; @@ -304,6 +333,10 @@ sub installlib { $dir =~ s#^\.(?![^/])/?##; my $name = $_; + + # ignore patch backups and the .exists files. + return if $name =~ m{\.orig$|~$|^\.exists}; + $name = "$dir/$name" if $dir ne ''; my $installlib = $installprivlib; |