=head1 NAME
-Basename - parse file specifications
-
fileparse - split a pathname into pieces
basename - extract just the filename from a path
=item fileparse_set_fstype
You select the syntax via the routine fileparse_set_fstype().
+
If the argument passed to it contains one of the substrings
-"VMS", "MSDOS", or "MacOS", the file specification syntax of that
-operating system is used in future calls to fileparse(),
-basename(), and dirname(). If it contains none of these
-substrings, UNIX syntax is used. This pattern matching is
+"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification
+syntax of that operating system is used in future calls to
+fileparse(), basename(), and dirname(). If it contains none of
+these substrings, UNIX syntax is used. This pattern matching is
case-insensitive. If you've selected VMS syntax, and the file
specification you pass to one of these routines contains a "/",
they assume you are using UNIX emulation and apply the UNIX syntax
rules instead, for that function call only.
+If the argument passed to it contains one of the substrings "VMS",
+"MSDOS", "MacOS", "AmigaOS", "os2", "MSWin32" or "RISCOS", then the pattern
+matching for suffix removal is performed without regard for case,
+since those systems are not case-sensitive when opening existing files
+(though some of them preserve case on file creation).
+
If you haven't called fileparse_set_fstype(), the syntax is chosen
by examining the builtin variable C<$^O> according to these rules.
$dir eq 'Doc_Root:[Help]'
$type eq '.Rnh'
+=over
+
=item C<basename>
The basename() routine returns the first element of the list produced
-by calling fileparse() with the same arguments. It is provided for
-compatibility with the UNIX shell command basename(1).
+by calling fileparse() with the same arguments, except that it always
+quotes metacharacters in the given suffixes. It is provided for
+programmer compatibility with the UNIX shell command basename(1).
=item C<dirname>
considers the directory name to be F<lib/>, while dirname() considers the
directory name to be F<.>).
+=back
+
=cut
require 5.002;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
#use strict;
-#use vars qw($VERSION $Fileparse_fstype);
-$VERSION = "2.4";
+#use vars qw($VERSION $Fileparse_fstype $Fileparse_igncase);
+$VERSION = "2.5";
# fileparse_set_fstype() - specify OS-based rules used in future
# calls to routines in this package
#
-# Currently recognized values: VMS, MSDOS, MacOS
-# Any other name uses Unix-style rules
+# Currently recognized values: VMS, MSDOS, MacOS, AmigaOS, os2, RISCOS
+# Any other name uses Unix-style rules and is case-sensitive
sub fileparse_set_fstype {
- my($old) = $Fileparse_fstype;
- $Fileparse_fstype = $_[0] if $_[0];
- $old;
+ my @old = ($Fileparse_fstype, $Fileparse_igncase);
+ if (@_) {
+ $Fileparse_fstype = $_[0];
+ $Fileparse_igncase = ($_[0] =~ /^(?:MacOS|VMS|AmigaOS|os2|RISCOS|MSWin32)/i);
+ }
+ wantarray ? @old : $old[0];
}
# fileparse() - parse file specification
sub fileparse {
my($fullname,@suffices) = @_;
- my($fstype) = $Fileparse_fstype;
+ my($fstype,$igncase) = ($Fileparse_fstype, $Fileparse_igncase);
my($dirpath,$tail,$suffix,$basename);
if ($fstype =~ /^VMS/i) {
($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
}
}
- if ($fstype =~ /^MSDOS/i) {
- ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/);
- $dirpath .= '.\\' unless $dirpath =~ /\\$/;
+ if ($fstype =~ /^MS(DOS|Win32)/i) {
+ ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/);
+ $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
}
elsif ($fstype =~ /^MacOS/i) {
($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
}
+ elsif ($fstype =~ /^AmigaOS/i) {
+ ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
+ $dirpath = './' unless $dirpath;
+ }
elsif ($fstype !~ /^VMS/i) { # default to Unix
($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
$dirpath = './' unless $dirpath;
if (@suffices) {
$tail = '';
foreach $suffix (@suffices) {
- if ($basename =~ /([\x00-\xff]*?)($suffix)$/) {
- $tail = $2 . $tail;
- $basename = $1;
+ my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
+ if ($basename =~ s/$pat//) {
+ $tail = $1 . $tail;
}
}
}
wantarray ? ($basename,$dirpath,$tail) : $basename;
-
}
}
if ($fstype =~ /MacOS/i) { return $dirname }
elsif ($fstype =~ /MSDOS/i) {
- if ( $dirname =~ /:\\$/) { return $dirname }
+ $dirname =~ s/([^:])[\\\/]*$/$1/;
+ unless( length($basename) ) {
+ ($basename,$dirname) = fileparse $dirname;
+ $dirname =~ s/([^:])[\\\/]*$/$1/;
+ }
+ }
+ elsif ($fstype =~ /MSWin32/i) {
+ $dirname =~ s/([^:])[\\\/]*$/$1/;
+ unless( length($basename) ) {
+ ($basename,$dirname) = fileparse $dirname;
+ $dirname =~ s/([^:])[\\\/]*$/$1/;
+ }
+ }
+ elsif ($fstype =~ /AmigaOS/i) {
+ if ( $dirname =~ /:$/) { return $dirname }
chop $dirname;
- $dirname =~ s:[^\\]+$:: unless length($basename);
- $dirname = '.' unless length($dirname);
+ $dirname =~ s#[^:/]+$## unless length($basename);
}
else {
- if ( $dirname =~ m:^/+$:) { return '/'; }
- chop $dirname;
- $dirname =~ s:[^/]+$:: unless length($basename);
- $dirname =~ s:/+$:: ;
- $dirname = '.' unless length($dirname);
+ $dirname =~ s:(.)/*$:$1:;
+ unless( length($basename) ) {
+ local($File::Basename::Fileparse_fstype) = $fstype;
+ ($basename,$dirname) = fileparse $dirname;
+ $dirname =~ s:(.)/*$:$1:;
+ }
}
$dirname;
}
-$Fileparse_fstype = $^O;
+fileparse_set_fstype $^O;
1;
projects / p5sagit/p5-mst-13.2.git / blobdiff