Revision 20075,
1010 bytes
checked in by zacheiss, 21 years ago
(diff) |
This commit was generated by cvs2svn to compensate for changes in r20074,
which included commits to RCS files with non-trunk default branches.
|
Line | |
---|
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; |
---|
Note: See
TracBrowser
for help on using the repository browser.