Commit | Line | Data |
---|---|---|
9ad884cb JH |
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; |