These routines allow you to parse file paths into their directory, filename
and suffix.
-B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and quirks, of
-the shell and C functions of the same name. See each function's documention
-for details.
+B<NOTE>: C<dirname()> and C<basename()> emulate the behaviours, and
+quirks, of the shell and C functions of the same name. See each
+function's documentation for details. If your concern is just parsing
+paths it is safer to use L<File::Spec>'s C<splitpath()> and
+C<splitdir()> methods.
+
+It is guaranteed that
+
+ # Where $path_separator is / for Unix, \ for Windows, etc...
+ dirname($path) . $path_separator . basename($path);
+
+is equivalent to the original path for all systems but VMS.
+
=cut
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.73";
+$VERSION = "2.76";
fileparse_set_fstype($^O);
=over 4
=item C<fileparse>
+X<fileparse>
my($filename, $directories, $suffix) = fileparse($path);
my($filename, $directories, $suffix) = fileparse($path, @suffixes);
portion is removed and becomes the $suffix.
# On Unix returns ("baz", "/foo/bar", ".txt")
- fileparse("/foo/bar/baz", qr/\.[^.]*/);
+ fileparse("/foo/bar/baz.txt", qr/\.[^.]*/);
If type is non-Unix (see C<fileparse_set_fstype()>) then the pattern
matching for suffix removal is performed case-insensitively, since
$dirpath ||= ''; # should always be defined
}
else { # Default to Unix semantics.
- ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
- if ($orig_type eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
+ ($dirpath,$basename) = ($fullname =~ m{^(.*/)?(.*)}s);
+ if ($orig_type eq 'VMS' and $fullname =~ m{^(/[^/]+/000000(/|$))(.*)}) {
# dev:[000000] is top of VMS tree, similar to Unix '/'
# so strip it off and treat the rest as "normal"
my $devspec = $1;
my $remainder = $3;
- ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
+ ($dirpath,$basename) = ($remainder =~ m{^(.*/)?(.*)}s);
$dirpath ||= ''; # should always be defined
$dirpath = $devspec.$dirpath;
}
}
- my($tail, $suffix);
+ my $tail = '';
+ my $suffix = '';
if (@suffices) {
- $tail = '';
foreach $suffix (@suffices) {
my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
if ($basename =~ s/$pat//s) {
}
# 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);
}
=item C<basename>
+X<basename> X<filename>
my $filename = basename($path);
my $filename = basename($path, @suffixes);
-C<basename()> works just like C<fileparse()> in scalar context - you only get
-the $filename - except that it always quotes metacharacters in the @suffixes.
+This function is provided for compatibility with the Unix shell command
+C<basename(1)>. It does B<NOT> always return the file name portion of a
+path as you might expect. To be safe, if you want the file name portion of
+a path use C<fileparse()>.
+
+C<basename()> returns the last level of a filepath even if the last
+level is clearly directory. In effect, it is acting like C<pop()> for
+paths. This differs from C<fileparse()>'s behaviour.
+
+ # Both return "bar"
+ basename("/foo/bar");
+ basename("/foo/bar/");
+
+@suffixes work as in C<fileparse()> except all regex metacharacters are
+quoted.
# These two function calls are equivalent.
my $filename = basename("/foo/bar/baz.txt", ".txt");
my $filename = fileparse("/foo/bar/baz.txt", qr/\Q.txt\E/);
-This function is provided for compatibility with the Unix shell command
-C<basename(1)>.
+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($name) = shift;
- (fileparse($name, map("\Q$_\E",@_)))[0];
+ 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, $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;
}
=item C<dirname>
+X<dirname>
This function is provided for compatibility with the Unix shell
command C<dirname(1)> and has inherited some of its quirks. In spite of
}
elsif ($type eq 'MacOS') {
if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
- $dirname =~ s/([^:]):\z/$1/s;
+ _strip_trailing_sep($dirname);
($basename,$dirname) = fileparse $dirname;
}
$dirname .= ":" unless $dirname =~ /:\z/;
}
elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
- $dirname =~ s/([^:])[\\\/]*\z/$1/;
+ _strip_trailing_sep($dirname);
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
- $dirname =~ s/([^:])[\\\/]*\z/$1/;
+ _strip_trailing_sep($dirname);
}
}
elsif ($type eq 'AmigaOS') {
if ( $dirname =~ /:\z/) { return $dirname }
chop $dirname;
- $dirname =~ s#[^:/]+\z## unless length($basename);
+ $dirname =~ s{[^:/]+\z}{} unless length($basename);
}
else {
- $dirname =~ s{(.)/*\z}{$1}s;
+ _strip_trailing_sep($dirname);
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
- $dirname =~ s{(.)/*\z}{$1}s;
+ _strip_trailing_sep($dirname);
}
}
}
+# Strip the trailing path separator.
+sub _strip_trailing_sep {
+ my $type = $Fileparse_fstype;
+
+ if ($type eq 'MacOS') {
+ $_[0] =~ s/([^:]):\z/$1/s;
+ }
+ elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
+ $_[0] =~ s/([^:])[\\\/]*\z/$1/;
+ }
+ else {
+ $_[0] =~ s{(.)/*\z}{$1}s;
+ }
+}
+
+
=item C<fileparse_set_fstype>
+X<filesystem>
my $type = fileparse_set_fstype();
my $previous_type = fileparse_set_fstype($type);
1;
+
+
+=head1 SEE ALSO
+
+L<dirname(1)>, L<basename(1)>, L<File::Spec>
projects / p5sagit/p5-mst-13.2.git / blobdiff