basename() and suffixes

Message-ID: <20050707223832.GA4782@windhund.schwern.org>

p4raw-id: //depot/perl@25097

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index cc6ba58..c89c752 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -157,9 +157,9 @@ sub fileparse {
   }
       
 
-  my($tail, $suffix);
+  my $tail   = '';
+  my $suffix = '';
   if (@suffices) {
-    $tail = '';
     foreach $suffix (@suffices) {
       my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
       if ($basename =~ s/$pat//s) {
@@ -170,7 +170,7 @@ sub fileparse {
   }
 
   # Ensure taint is propgated from the path to its pieces.
-  $tail .= $taint if defined $tail; # avoid warning if $tail == undef
+  $tail .= $taint;
   wantarray ? ($basename .= $taint, $dirpath .= $taint, $tail)
             : ($basename .= $taint);
 }
@@ -202,15 +202,34 @@ quoted.
     my $filename = basename("/foo/bar/baz.txt",  ".txt");
     my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
 
+Also note that in order to be compatible with the shell command,
+C<basename()> does not strip off a suffix if it is identical to the
+remaining characters in the filename.
+
 =cut
 
 
 sub basename {
   my($path) = shift;
 
+  # From BSD basename(1)
+  # The basename utility deletes any prefix ending with the last slash `/'
+  # character present in string (after first stripping trailing slashes)
   _strip_trailing_sep($path);
-  my($basename, $dirname) = fileparse( $path, map("\Q$_\E",@_) );
-  $basename = $dirname unless length $basename;
+
+  my($basename, $dirname, $suffix) = fileparse( $path, map("\Q$_\E",@_) );
+
+  # From BSD basename(1)
+  # The suffix is not stripped if it is identical to the remaining 
+  # characters in string.
+  if( length $suffix and !length $basename ) {
+      $basename = $suffix;
+  }
+  
+  # Ensure that basename '/' == '/'
+  if( !length $basename ) {
+      $basename = $dirname;
+  }
 
   return $basename;
 }

diff --git a/lib/File/Basename.t b/lib/File/Basename.t
index 84e1a4e..0d3b633 100755 (executable)
--- a/lib/File/Basename.t
+++ b/lib/File/Basename.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Test::More tests => 60;
+use Test::More tests => 64;
 
 BEGIN { use_ok 'File::Basename' }
 
@@ -142,6 +142,17 @@ can_ok( __PACKAGE__, qw( basename fileparse dirname fileparse_set_fstype ) );
 }
 
 
+### basename(1) sez: "The suffix is not stripped if it is identical to the
+### remaining characters in string"
+{
+    fileparse_set_fstype('Unix');
+    is(basename('.foo'), '.foo');
+    is(basename('.foo', '.foo'),     '.foo');
+    is(basename('.foo.bar', '.foo'), '.foo.bar');
+    is(basename('.foo.bar', '.bar'), '.foo');
+}
+
+
 ### Test tainting
 {
     #   The empty tainted value, for tainting strings