Commit | Line | Data |
36bb303b |
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; |