Re: Not OK: perl v5.9.0 +DEVEL17881 on i386-freebsd 4.6-release (UNINSTALLED)

[p5sagit/p5-mst-13.2.git] / lib / File / Basename.pm

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index 035c597..1c9a419 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -167,6 +167,10 @@ sub fileparse_set_fstype {
 
 sub fileparse {
   my($fullname,@suffices) = @_;
+  unless (defined $fullname) {
+      require Carp;
+      Carp::croak("fileparse(): need a valid pathname");
+  }
   my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
   my($dirpath,$tail,$suffix,$basename);
   my($taint) = substr($fullname,0,0);  # Is $fullname tainted?
@@ -182,6 +186,11 @@ sub fileparse {
     ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
     $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
   }
+  elsif ($fstype =~ /^os2/i) {
+    ($dirpath,$basename) = ($fullname =~ m#^((?:.*[:\\/])?)(.*)#s);
+    $dirpath = './' unless $dirpath;   # Can't be 0
+    $dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
+  }
   elsif ($fstype =~ /^MacOS/si) {
     ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
     $dirpath = ':' unless $dirpath;
@@ -217,7 +226,7 @@ sub fileparse {
 
   $tail .= $taint if defined $tail; # avoid warning if $tail == undef
   wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
-            : $basename .= $taint;
+            : ($basename .= $taint);
 }
 
 
@@ -251,14 +260,7 @@ sub dirname {
        }
        $dirname .= ":" unless $dirname =~ /:\z/;
     }
-    elsif ($fstype =~ /MSDOS/i) { 
-        $dirname =~ s/([^:])[\\\/]*\z/$1/;
-        unless( length($basename) ) {
-           ($basename,$dirname) = fileparse $dirname;
-           $dirname =~ s/([^:])[\\\/]*\z/$1/;
-       }
-    }
-    elsif ($fstype =~ /MSWin32/i) { 
+    elsif ($fstype =~ /MS(DOS|Win32)|os2/i) { 
         $dirname =~ s/([^:])[\\\/]*\z/$1/;
         unless( length($basename) ) {
            ($basename,$dirname) = fileparse $dirname;