require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
-$VERSION = "2.81";
+$VERSION = "2.82";
fileparse_set_fstype($^O);
$dirpath = './' unless $dirpath; # Can't be 0
$dirpath .= '/' unless $dirpath =~ m#[\\/]\z#;
}
+ elsif ($type eq "MacOS") {
+ ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
+ $dirpath = ':' unless $dirpath;
+ }
elsif ($type eq "AmigaOS") {
($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
$dirpath = './' unless $dirpath;
if ($type eq 'VMS') {
$dirname ||= $ENV{DEFAULT};
}
+ elsif ($type eq 'MacOS') {
+ if( !length($basename) && $dirname !~ /^[^:]+:\z/) {
+ _strip_trailing_sep($dirname);
+ ($basename,$dirname) = fileparse $dirname;
+ }
+ $dirname .= ":" unless $dirname =~ /:\z/;
+ }
elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
_strip_trailing_sep($dirname);
unless( length($basename) ) {
sub _strip_trailing_sep {
my $type = $Fileparse_fstype;
- if (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
+ if ($type eq 'MacOS') {
+ $_[0] =~ s/([^:]):\z/$1/s;
+ }
+ elsif (grep { $type eq $_ } qw(MSDOS DOS MSWin32 OS2)) {
$_[0] =~ s/([^:])[\\\/]*\z/$1/;
}
else {
operating system (ie. /foo/bar style on Unix, \foo\bar on Windows, etc...).
With this function you can override that assumption.
-Valid $types are "VMS", "AmigaOS", "OS2", "RISCOS",
+Valid $types are "MacOS", "VMS", "AmigaOS", "OS2", "RISCOS",
"MSWin32", "DOS" (also "MSDOS" for backwards bug compatibility),
"Epoc" and "Unix" (all case-insensitive). If an unrecognized $type is
given "Unix" will be assumed.
BEGIN {
-my @Ignore_Case = qw(VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
+my @Ignore_Case = qw(MacOS VMS AmigaOS OS2 RISCOS MSWin32 MSDOS DOS Epoc);
my @Types = (@Ignore_Case, qw(Unix));
sub fileparse_set_fstype {
@INC = '../lib';
}
-use Test::More tests => 49;
+use Test::More tests => 64;
BEGIN { use_ok 'File::Basename' }
is( dirname("\\foo\\bar\\baz"), "\\foo\\bar" );
}
+
+### Testing MacOS
+{
+ is(fileparse_set_fstype('MacOS'), 'MSDOS', 'set fstype to MacOS');
+
+ my($base,$path,$type) = fileparse('virgil:aeneid:draft.book7',
+ '\.book\d+');
+ is($base, 'draft');
+ is($path, 'virgil:aeneid:');
+ is($type, '.book7');
+
+ is(basename(':arma:virumque:cano.trojae'), 'cano.trojae');
+ is(dirname(':arma:virumque:cano.trojae'), ':arma:virumque:');
+ is(dirname(':arma:virumque:'), ':arma:');
+ is(dirname(':arma:virumque'), ':arma:');
+ is(dirname(':arma:'), ':');
+ is(dirname(':arma'), ':');
+ is(dirname('arma:'), 'arma:');
+ is(dirname('arma'), ':');
+ is(dirname(':'), ':');
+
+
+ # Check quoting of metacharacters in suffix arg by basename()
+ is(basename(':arma:virumque:cano.trojae','.trojae'), 'cano');
+ is(basename(':arma:virumque:cano_trojae','.trojae'), 'cano_trojae');
+}
+
+
### extra tests for a few specific bugs
{
fileparse_set_fstype 'DOS';