summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1998-03-07 07:51:28 +0000
committerGurusamy Sarathy <gsar@cpan.org>1998-03-07 07:51:28 +0000
commit3bd495df69b982704c59fc1ecbed71e5112e7da0 (patch)
tree47303adb4596ab4c7c0b981f50c0a72d52092338 /lib
parentfe9f1ed50ae7ad31787549184f98f0a71eda0191 (diff)
parent1d16519d77cbada019f865cb923236cd48a23c72 (diff)
downloadperl-3bd495df69b982704c59fc1ecbed71e5112e7da0.tar.gz
[win32] integrate mainline changes
p4raw-id: //depot/asperl@799
Diffstat (limited to 'lib')
-rw-r--r--lib/ExtUtils/typemap2
-rw-r--r--lib/File/Basename.pm11
-rw-r--r--lib/File/Find.pm78
-rw-r--r--lib/File/Path.pm14
-rw-r--r--lib/autouse.pm9
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)