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