diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1998-03-07 07:51:28 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1998-03-07 07:51:28 +0000 |
commit | 3bd495df69b982704c59fc1ecbed71e5112e7da0 (patch) | |
tree | 47303adb4596ab4c7c0b981f50c0a72d52092338 /lib | |
parent | fe9f1ed50ae7ad31787549184f98f0a71eda0191 (diff) | |
parent | 1d16519d77cbada019f865cb923236cd48a23c72 (diff) | |
download | perl-3bd495df69b982704c59fc1ecbed71e5112e7da0.tar.gz |
[win32] integrate mainline changes
p4raw-id: //depot/asperl@799
Diffstat (limited to 'lib')
-rw-r--r-- | lib/ExtUtils/typemap | 2 | ||||
-rw-r--r-- | lib/File/Basename.pm | 11 | ||||
-rw-r--r-- | lib/File/Find.pm | 78 | ||||
-rw-r--r-- | lib/File/Path.pm | 14 | ||||
-rw-r--r-- | lib/autouse.pm | 9 |
5 files changed, 60 insertions, 54 deletions
diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 20cc96f0b5..03ba050d1e 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -262,7 +262,7 @@ T_ARRAY ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } - sp += $var.size - 1; + SP += $var.size - 1; T_IN { GV *gv = newGVgen("$Package"); diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm index 5c6299e596..8828a52bfc 100644 --- a/lib/File/Basename.pm +++ b/lib/File/Basename.pm @@ -127,8 +127,8 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(fileparse fileparse_set_fstype basename dirname); #use strict; -#use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase); -$VERSION = "2.5"; +use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase); +$VERSION = "2.6"; # fileparse_set_fstype() - specify OS-based rules used in future @@ -155,11 +155,13 @@ sub fileparse { my($fullname,@suffices) = @_; my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase); my($dirpath,$tail,$suffix,$basename); + my($taint) = substr($fullname,0,0); # Is $fullname tainted? if ($fstype =~ /^VMS/i) { if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation else { ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/); + $dirpath ||= ''; # should always be defined } } if ($fstype =~ /^MS(DOS|Win32)/i) { @@ -183,12 +185,15 @@ sub fileparse { foreach $suffix (@suffices) { my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$"; if ($basename =~ s/$pat//) { + $taint .= substr($suffix,0,0); $tail = $1 . $tail; } } } - wantarray ? ($basename,$dirpath,$tail) : $basename; + $tail .= $taint if defined $tail; # avoid warning if $tail == undef + wantarray ? ($basename . $taint, $dirpath . $taint, $tail) + : $basename . $taint; } diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 11835067ff..7abebc6544 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -17,7 +17,7 @@ finddepth - traverse a directory structure depth-first use File::Find; find(\&wanted, '/foo','/bar'); sub wanted { ... } - + use File::Find; finddepth(\&wanted, '/foo','/bar'); sub wanted { ... } @@ -34,7 +34,7 @@ prune the tree. File::Find assumes that you don't alter the $_ variable. If you do then make sure you return it to its original value before exiting your function. -This library is primarily for the C<find2perl> tool, which when fed, +This library is primarily for the C<find2perl> tool, which when fed, find2perl / -name .nfs\* -mtime +7 \ -exec rm -f {} \; -o -fstype nfs -prune @@ -63,7 +63,7 @@ that don't resolve: sub wanted { -l && !-e && print "bogus link: $File::Find::name\n"; - } + } =head1 BUGS @@ -91,12 +91,11 @@ sub find { $name = $topdir; $prune = 0; &$wanted; - if (!$prune) { - my $fixtopdir = $topdir; - $fixtopdir =~ s,/$,, ; - $fixtopdir =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$fixtopdir,$topnlink); - } + next if $prune; + my $fixtopdir = $topdir; + $fixtopdir =~ s,/$,, ; + $fixtopdir =~ s/\.dir$// if $Is_VMS; + &finddir($wanted,$fixtopdir,$topnlink); } else { warn "Can't cd to $topdir: $!\n"; @@ -106,8 +105,13 @@ sub find { unless (($_,$dir) = File::Basename::fileparse($topdir)) { ($dir,$_) = ('.', $topdir); } - $name = $topdir; - chdir $dir && &$wanted; + if (chdir($dir)) { + $name = $topdir; + &$wanted; + } + else { + warn "Can't cd to $dir: $!\n"; + } } chdir $cwd; } @@ -134,7 +138,7 @@ sub finddir { &$wanted; } } - else { # This dir has subdirectories. + else { # This dir has subdirectories. $subcount = $nlink - 2; for (@filenames) { next if $_ eq '.'; @@ -148,17 +152,21 @@ sub finddir { ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); # unless ($nlink || $dont_use_nlink); - + if (-d _) { # It really is a directory, so do it recursively. - if (!$prune && chdir $_) { + --$subcount; + next if $prune; + if (chdir $_) { $name =~ s/\.dir$// if $Is_VMS; &finddir($wanted,$name,$nlink); chdir '..'; } - --$subcount; + else { + warn "Can't cd to $_: $!\n"; + } } } } @@ -168,12 +176,10 @@ sub finddir { sub finddepth { my $wanted = shift; - - $cwd = Cwd::fastcwd();; - + my $cwd = Cwd::cwd(); # Localize these rather than lexicalizing them for backwards # compatibility. - local($topdir, $topdev, $topino, $topmode, $topnlink); + local($topdir,$topdev,$topino,$topmode,$topnlink); foreach $topdir (@_) { (($topdev,$topino,$topmode,$topnlink) = ($Is_VMS ? stat($topdir) : lstat($topdir))) @@ -184,8 +190,8 @@ sub finddepth { $fixtopdir =~ s,/$,, ; $fixtopdir =~ s/\.dir$// if $Is_VMS; &finddepthdir($wanted,$fixtopdir,$topnlink); - ($dir,$_) = ($fixtopdir,'.'); - $name = $fixtopdir; + ($dir,$_) = ($topdir,'.'); + $name = $topdir; &$wanted; } else { @@ -196,8 +202,13 @@ sub finddepth { unless (($_,$dir) = File::Basename::fileparse($topdir)) { ($dir,$_) = ('.', $topdir); } - $name = $topdir; - chdir $dir && &$wanted; + if (chdir($dir)) { + $name = $topdir; + &$wanted; + } + else { + warn "Can't cd to $dir: $!\n"; + } } chdir $cwd; } @@ -206,15 +217,15 @@ sub finddepth { sub finddepthdir { my($wanted, $nlink); local($dir, $name); - ($wanted,$dir,$nlink) = @_; + ($wanted, $dir, $nlink) = @_; my($dev, $ino, $mode, $subcount); # Get the list of files in the current directory. - opendir(DIR,'.') || warn "Can't open $dir: $!\n"; + opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); my(@filenames) = readdir(DIR); closedir(DIR); - if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. + if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. for (@filenames) { next if $_ eq '.'; next if $_ eq '..'; @@ -223,7 +234,7 @@ sub finddepthdir { &$wanted; } } - else { # This dir has subdirectories. + else { # This dir has subdirectories. $subcount = $nlink - 2; for (@filenames) { next if $_ eq '.'; @@ -235,17 +246,20 @@ sub finddepthdir { # Get link count and check for directoriness. ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); - + if (-d _) { # It really is a directory, so do it recursively. + --$subcount; if (chdir $_) { $name =~ s/\.dir$// if $Is_VMS; &finddepthdir($wanted,$name,$nlink); chdir '..'; } - --$subcount; + else { + warn "Can't cd to $_: $!\n"; + } } } &$wanted; @@ -264,13 +278,9 @@ if ($^O eq 'VMS') { $Is_VMS = 1; $dont_use_nlink = 1; } -if ($^O =~ m:^mswin32:i) { - $Is_NT = 1; - $dont_use_nlink = 1; -} $dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos'; + if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; 1; diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 492f150b5a..6b5d5683f1 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -92,7 +92,7 @@ Charles Bailey <F<bailey@genetics.upenn.edu>> =head1 REVISION -Current $VERSION is 1.04. +Current $VERSION is 1.0401. =cut @@ -103,7 +103,7 @@ use Exporter (); use strict; use vars qw( $VERSION @ISA @EXPORT ); -$VERSION = "1.04"; +$VERSION = "1.0401"; @ISA = qw( Exporter ); @EXPORT = qw( mkpath rmtree ); @@ -202,18 +202,18 @@ sub rmtree { if $force_writeable; print "unlink $root\n" if $verbose; # delete all versions under VMS - while (-e $root || -l $root) { - if (unlink $root) { - ++$count; - } - else { + for (;;) { + unless (unlink $root) { carp "Can't unlink file $root: $!"; if ($force_writeable) { chmod $rp, $root or carp("and can't restore permissions to " . sprintf("0%o",$rp) . "\n"); } + last; } + ++$count; + last unless $Is_VMS && lstat $root; } } } diff --git a/lib/autouse.pm b/lib/autouse.pm index ab95a19d8a..4445c6c419 100644 --- a/lib/autouse.pm +++ b/lib/autouse.pm @@ -146,15 +146,6 @@ The first line ensures that the errors in your argument specification are found early. When you ship your application you should comment out the first line, since it makes the second one useless. -=head1 BUGS - -If Module::func3() is autoused, and the module is loaded between the -C<autouse> directive and a call to Module::func3(), warnings about -redefinition would appear if warnings are enabled. - -If Module::func3() is autoused, warnings are disabled when loading the -module via autoused functions. - =head1 AUTHOR Ilya Zakharevich (ilya@math.ohio-state.edu) |