| 1 | #!/usr/bin/perl -w |
| 2 | use strict; |
| 3 | use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write); |
| 4 | use Config; # Remember, this is running using an existing perl |
| 5 | |
| 6 | # Common functions needed by the regen scripts |
| 7 | |
| 8 | $Is_W32 = $^O eq 'MSWin32'; |
| 9 | $Is_OS2 = $^O eq 'os2'; |
| 10 | $Is_Cygwin = $^O eq 'cygwin'; |
| 11 | $Is_NetWare = $Config{osname} eq 'NetWare'; |
| 12 | if ($Is_NetWare) { |
| 13 | $Is_W32 = 0; |
| 14 | } |
| 15 | |
| 16 | $Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare; |
| 17 | |
| 18 | sub safer_unlink { |
| 19 | my @names = @_; |
| 20 | my $cnt = 0; |
| 21 | |
| 22 | my $name; |
| 23 | foreach $name (@names) { |
| 24 | next unless -e $name; |
| 25 | chmod 0777, $name if $Needs_Write; |
| 26 | ( CORE::unlink($name) and ++$cnt |
| 27 | or warn "Couldn't unlink $name: $!\n" ); |
| 28 | } |
| 29 | return $cnt; |
| 30 | } |
| 31 | |
| 32 | sub safer_rename_silent { |
| 33 | my ($from, $to) = @_; |
| 34 | |
| 35 | # Some dosish systems can't rename over an existing file: |
| 36 | safer_unlink $to; |
| 37 | chmod 0600, $from if $Needs_Write; |
| 38 | rename $from, $to; |
| 39 | } |
| 40 | |
| 41 | sub safer_rename { |
| 42 | my ($from, $to) = @_; |
| 43 | safer_rename_silent($from, $to) or die "renaming $from to $to: $!"; |
| 44 | } |
| 45 | 1; |