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; |