This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
back out change#2751, apply updated version
authorJan Dubois <jand@activestate.com>
Sat, 6 Feb 1999 01:06:29 +0000 (02:06 +0100)
committerGurusamy Sarathy <gsar@cpan.org>
Sun, 14 Feb 1999 10:59:38 +0000 (10:59 +0000)
Message-ID: <36bc844c.18763049@smtp1.ibm.net>
Subject: [PATCH] Cleanup of File::Spec module

p4raw-link: @2751 on //depot/perl: 99804bbbf0b24ddc3b565419ea53f59e7410d1f4

p4raw-id: //depot/perl@2916

lib/File/Spec.pm
lib/File/Spec/Mac.pm
lib/File/Spec/OS2.pm
lib/File/Spec/Unix.pm
lib/File/Spec/VMS.pm
lib/File/Spec/Win32.pm

index 616dcbc..9de9a80 100644 (file)
@@ -1,47 +1,18 @@
 package File::Spec;
 
-require Exporter;
-
-@ISA = qw(Exporter);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(
-       
-);
-@EXPORT_OK = qw($Verbose);
-
 use strict;
-use vars qw(@ISA $VERSION $Verbose);
+use vars qw(@ISA $VERSION);
 
 $VERSION = '0.6';
 
-$Verbose = 0;
-
-require File::Spec::Unix;
-
-
-sub load {
-       my($class,$OS) = @_;
-       if ($OS eq 'VMS') {
-               require File::Spec::VMS;
-               require VMS::Filespec;
-               'File::Spec::VMS'
-       } elsif ($OS eq 'os2') {
-               require File::Spec::OS2;
-               'File::Spec::OS2'
-       } elsif ($OS eq 'MacOS') {
-               require File::Spec::Mac;
-               'File::Spec::Mac'
-       } elsif ($OS eq 'MSWin32') {
-               require File::Spec::Win32;
-               'File::Spec::Win32'
-       } else {
-               'File::Spec::Unix'
-       }
-}
-
-@ISA = load('File::Spec', $^O);
+my %module = (MacOS   => 'Mac',
+             MSWin32 => 'Win32',
+             os2     => 'OS2',
+             VMS     => 'VMS');
+
+my $module = $module{$^O} || 'Unix';
+require "File/Spec/$module.pm";
+@ISA = ("File::Spec::$module");
 
 1;
 __END__
@@ -109,8 +80,3 @@ Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
 support by Charles Bailey <F<bailey@newman.upenn.edu>>.  OS/2 support by
 Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
 <F<schinder@pobox.com>>.
-
-=cut
-
-
-1;
index 63a9e12..e1f3c17 100644 (file)
@@ -1,18 +1,9 @@
 package File::Spec::Mac;
 
-use Exporter ();
-use Config;
 use strict;
-use File::Spec;
-use vars qw(@ISA $VERSION $Is_Mac);
-
-$VERSION = '1.0';
-
+use vars qw(@ISA);
+require File::Spec::Unix;
 @ISA = qw(File::Spec::Unix);
-$Is_Mac = $^O eq 'MacOS';
-
-Exporter::import('File::Spec', '$Verbose');
-
 
 =head1 NAME
 
@@ -20,7 +11,7 @@ File::Spec::Mac - File::Spec for MacOS
 
 =head1 SYNOPSIS
 
-C<require File::Spec::Mac;>
+ require File::Spec::Mac; # Done internally by File::Spec if needed
 
 =head1 DESCRIPTION
 
@@ -37,8 +28,8 @@ On MacOS, there's nothing to be done.  Returns what it's given.
 =cut
 
 sub canonpath {
-    my($self,$path) = @_;
-    $path;
+    my ($self,$path) = @_;
+    return $path;
 }
 
 =item catdir
@@ -84,20 +75,17 @@ aren't done here. This routine will treat this as absolute.
 
 =cut
 
-# ';
-
 sub catdir {
     shift;
     my @args = @_;
-       $args[0] =~ s/:$//;
-       my $result = shift @args;
-       for (@args) {
-               s/:$//;
-               s/^://;
-               $result .= ":$_";
+    my $result = shift @args;
+    $result =~ s/:$//;
+    foreach (@args) {
+       s/:$//;
+       s/^://;
+       $result .= ":$_";
     }
-    $result .= ":";
-       $result;
+    return "$result:";
 }
 
 =item catfile
@@ -118,50 +106,69 @@ give the same answer, as one might expect.
 =cut
 
 sub catfile {
-    my $self = shift @_;
+    my $self = shift;
     my $file = pop @_;
     return $file unless @_;
     my $dir = $self->catdir(@_);
-       $file =~ s/^://;
+    $file =~ s/^://;
     return $dir.$file;
 }
 
 =item curdir
 
-Returns a string representing of the current directory.
+Returns a string representing the current directory.
 
 =cut
 
 sub curdir {
-    return ":" ;
+    return ":";
+}
+
+=item devnull
+
+Returns a string representing the null device.
+
+=cut
+
+sub devnull {
+    return "Dev:Null";
 }
 
 =item rootdir
 
 Returns a string representing the root directory.  Under MacPerl,
 returns the name of the startup volume, since that's the closest in
-concept, although other volumes aren't rooted there.  On any other
-platform returns '', since there's no common way to indicate "root
-directory" across all Macs.
+concept, although other volumes aren't rooted there.
 
 =cut
 
 sub rootdir {
 #
-#  There's no real root directory on MacOS.  If you're using MacPerl,
-#  the name of the startup volume is returned, since that's the closest in
-#  concept.  On other platforms, simply return '', because nothing better
-#  can be done.
+#  There's no real root directory on MacOS.  The name of the startup
+#  volume is returned, since that's the closest in concept.
 #
-       if($Is_Mac) {
-        require Mac::Files;
-               my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
-                       &Mac::Files::kSystemFolderType);
-               $system =~ s/:.*$/:/;
-               return $system;
-       } else {
-               return '';
-    }
+    require Mac::Files;
+    my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
+                                        &Mac::Files::kSystemFolderType);
+    $system =~ s/:.*$/:/;
+    return $system;
+}
+
+=item tmpdir
+
+Returns a string representation of the first existing directory
+from the following list or '' if none exist:
+
+    $ENV{TMPDIR}
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
 }
 
 =item updir
@@ -185,11 +192,11 @@ distinguish unambiguously.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
-       if ($file =~ /:/) {
-               return ($file !~ m/^:/);
-       } else {
-               return (! -e ":$file");
+    my ($self,$file) = @_;
+    if ($file =~ /:/) {
+       return ($file !~ m/^:/);
+    } else {
+       return (! -e ":$file");
     }
 }
 
@@ -207,14 +214,8 @@ sub path {
 #  The concept is meaningless under the MacPerl application.
 #  Under MPW, it has a meaning.
 #
-    my($self) = @_;
-       my @path;
-       if(exists $ENV{Commands}) {
-               @path = split /,/,$ENV{Commands};
-       } else {
-           @path = ();
-       }
-    @path;
+    return unless exists $ENV{Commands};
+    return split(/,/, $ENV{Commands});
 }
 
 =back
@@ -226,5 +227,3 @@ L<File::Spec>
 =cut
 
 1;
-__END__
-
index ee7b331..985c411 100644 (file)
@@ -1,38 +1,40 @@
 package File::Spec::OS2;
 
-#use Config;
-#use Cwd;
-#use File::Basename;
 use strict;
-require Exporter;
-
-use File::Spec;
 use vars qw(@ISA);
-
-Exporter::import('File::Spec',
-       qw( $Verbose));
-
+require File::Spec::Unix;
 @ISA = qw(File::Spec::Unix);
 
-$ENV{EMXSHELL} = 'sh'; # to run `commands`
+sub devnull {
+    return "/dev/nul";
+}
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
-    $file =~ m{^([a-z]:)?[\\/]}i ;
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z]:)?[\\/]}i);
 }
 
 sub path {
-    my($self) = @_;
-    my $path_sep = ";";
     my $path = $ENV{PATH};
     $path =~ s:\\:/:g;
-    my @path = split $path_sep, $path;
-    foreach(@path) { $_ = '.' if $_ eq '' }
-    @path;
+    my @path = split(';',$path);
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
 }
 
-sub devnull {
-    return "/dev/nul";
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    my $self = shift;
+    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
+       next unless defined && -d;
+       $tmpdir = $_;
+       last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    $tmpdir =~ s:\\:/:g;
+    $tmpdir = $self->canonpath($tmpdir);
+    return $tmpdir;
 }
 
 1;
@@ -44,12 +46,10 @@ File::Spec::OS2 - methods for OS/2 file specs
 
 =head1 SYNOPSIS
 
use File::Spec::OS2; # Done internally by File::Spec if needed
require File::Spec::OS2; # Done internally by File::Spec if needed
 
 =head1 DESCRIPTION
 
 See File::Spec::Unix for a documentation of the methods provided
 there. This package overrides the implementation of these methods, not
 the semantics.
-
-=cut
index ae3546e..420075d 100644 (file)
@@ -1,23 +1,6 @@
 package File::Spec::Unix;
 
-use Exporter ();
-use Config;
-use File::Basename qw(basename dirname fileparse);
-use DirHandle;
 use strict;
-use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32);
-use File::Spec;
-
-Exporter::import('File::Spec', '$Verbose');
-
-$Is_OS2 = $^O eq 'os2';
-$Is_Mac = $^O eq 'MacOS';
-$Is_Win32 = $^O eq 'MSWin32';
-
-if ($Is_VMS = $^O eq 'VMS') {
-    require VMS::Filespec;
-    import VMS::Filespec qw( &vmsify );
-}
 
 =head1 NAME
 
@@ -25,7 +8,7 @@ File::Spec::Unix - methods used by File::Spec
 
 =head1 SYNOPSIS
 
-C<require File::Spec::Unix;>
+ require File::Spec::Unix; # Done automatically by File::Spec
 
 =head1 DESCRIPTION
 
@@ -43,12 +26,12 @@ path. On UNIX eliminated successive slashes and successive "/.".
 =cut
 
 sub canonpath {
-    my($self,$path) = @_;
-    $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
-    $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
+    my ($self,$path) = @_;
+    $path =~ s|/+|/|g                            # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g                       # xx/././xx -> xx/xx
     $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
     $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
-    $path;
+    return $path;
 }
 
 =item catdir
@@ -61,20 +44,14 @@ trailing slash :-)
 
 =cut
 
-# ';
-
 sub catdir {
-    shift;
+    my $self = shift;
     my @args = @_;
-    for (@args) {
+    foreach (@args) {
        # append a slash to each argument unless it has one there
-       $_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
+       $_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
     }
-    my $result = join('', @args);
-    # remove a trailing slash unless we are root
-    substr($result,-1) = ""
-       if length($result) > 1 && substr($result,-1) eq "/";
-    $result;
+    return $self->canonpath(join('', @args));
 }
 
 =item catfile
@@ -85,29 +62,27 @@ complete path ending with a filename
 =cut
 
 sub catfile {
-    my $self = shift @_;
+    my $self = shift;
     my $file = pop @_;
     return $file unless @_;
     my $dir = $self->catdir(@_);
-    for ($dir) {
-       $_ .= "/" unless substr($_,length($_)-1,1) eq "/";
-    }
+    $dir .= "/" unless substr($dir,-1) eq "/";
     return $dir.$file;
 }
 
 =item curdir
 
-Returns a string representing of the current directory.  "." on UNIX.
+Returns a string representation of the current directory.  "." on UNIX.
 
 =cut
 
 sub curdir {
-    return "." ;
+    return ".";
 }
 
 =item devnull
 
-Returns the name of the null device (bit bucket). "/dev/null" on UNIX.
+Returns a string representation of the null device. "/dev/null" on UNIX.
 
 =cut
 
@@ -117,7 +92,7 @@ sub devnull {
 
 =item rootdir
 
-Returns a string representing of the root directory.  "/" on UNIX.
+Returns a string representation of the root directory.  "/" on UNIX.
 
 =cut
 
@@ -125,9 +100,31 @@ sub rootdir {
     return "/";
 }
 
+=item tmpdir
+
+Returns a string representation of the first writable directory
+from the following list or "" if none are writable:
+
+    $ENV{TMPDIR}
+    /tmp
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ($ENV{TMPDIR}, "/tmp") {
+       next unless defined && -d && -w _;
+       $tmpdir = $_;
+       last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
+}
+
 =item updir
 
-Returns a string representing of the parent directory.  ".." on UNIX.
+Returns a string representation of the parent directory.  ".." on UNIX.
 
 =cut
 
@@ -143,7 +140,7 @@ directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 =cut
 
 sub no_upwards {
-    my($self) = shift;
+    my $self = shift;
     return grep(!/^\.{1,2}$/, @_);
 }
 
@@ -154,8 +151,8 @@ Takes as argument a path and returns true, if it is an absolute path.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
-    $file =~ m:^/: ;
+    my ($self,$file) = @_;
+    return scalar($file =~ m:^/:);
 }
 
 =item path
@@ -165,12 +162,9 @@ Takes no argument, returns the environment variable PATH as an array.
 =cut
 
 sub path {
-    my($self) = @_;
-    my $path_sep = ":";
-    my $path = $ENV{PATH};
-    my @path = split $path_sep, $path;
-    foreach(@path) { $_ = '.' if $_ eq '' }
-    @path;
+    my @path = split(':', $ENV{PATH});
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
 }
 
 =item join
@@ -180,19 +174,8 @@ join is the same as catfile.
 =cut
 
 sub join {
-       my($self) = shift @_;
-       $self->catfile(@_);
-}
-
-=item nativename
-
-TBW.
-
-=cut
-
-sub nativename {
-       my($self,$name) = shift @_;
-       $name;
+    my $self = shift;
+    return $self->catfile(@_);
 }
 
 =back
@@ -204,4 +187,3 @@ L<File::Spec>
 =cut
 
 1;
-__END__
index 2084505..30440c2 100644 (file)
@@ -1,19 +1,12 @@
-
 package File::Spec::VMS;
 
-use Carp qw( &carp );
-use Config;
-require Exporter;
-use VMS::Filespec;
-use File::Basename;
-
-use File::Spec;
-use vars qw($Revision);
-$Revision = '5.3901 (6-Mar-1997)';
-
+use strict;
+use vars qw(@ISA);
+require File::Spec::Unix;
 @ISA = qw(File::Spec::Unix);
 
-Exporter::import('File::Spec', '$Verbose');
+use File::Basename;
+use VMS::Filespec;
 
 =head1 NAME
 
@@ -21,7 +14,7 @@ File::Spec::VMS - methods for VMS file specs
 
 =head1 SYNOPSIS
 
use File::Spec::VMS; # Done internally by File::Spec if needed
require File::Spec::VMS; # Done internally by File::Spec if needed
 
 =head1 DESCRIPTION
 
@@ -41,23 +34,22 @@ VMS-syntax directory specification.
 =cut
 
 sub catdir {
-    my($self,@dirs) = @_;
-    my($dir) = pop @dirs;
+    my ($self,@dirs) = @_;
+    my $dir = pop @dirs;
     @dirs = grep($_,@dirs);
-    my($rslt);
+    my $rslt;
     if (@dirs) {
-      my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
-      my($spath,$sdir) = ($path,$dir);
-      $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
-      $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
-      $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+       my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+       my ($spath,$sdir) = ($path,$dir);
+       $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
+       $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
+       $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
     }
-    else { 
-      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
-      else                          { $rslt = vmspath($dir); }
+    else {
+       if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
+       else                          { $rslt = vmspath($dir); }
     }
-    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
-    $rslt;
+    return $rslt;
 }
 
 =item catfile
@@ -68,28 +60,29 @@ VMS-syntax directory specification.
 =cut
 
 sub catfile {
-    my($self,@files) = @_;
-    my($file) = pop @files;
+    my ($self,@files) = @_;
+    my $file = pop @files;
     @files = grep($_,@files);
-    my($rslt);
+    my $rslt;
     if (@files) {
-      my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
-      my($spath) = $path;
-      $spath =~ s/.dir$//;
-      if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
-      else {
-          $rslt = $self->eliminate_macros($spath);
-          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
-      }
+       my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
+       my $spath = $path;
+       $spath =~ s/.dir$//;
+       if ($spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) {
+           $rslt = "$spath$file";
+       }
+       else {
+           $rslt = $self->eliminate_macros($spath);
+           $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+       }
     }
     else { $rslt = vmsify($file); }
-    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
-    $rslt;
+    return $rslt;
 }
 
 =item curdir (override)
 
-Returns a string representing of the current directory.
+Returns a string representation of the current directory: '[]'
 
 =cut
 
@@ -99,27 +92,49 @@ sub curdir {
 
 =item devnull (override)
 
-Returns a string representing the null device.
+Returns a string representation of the null device: '_NLA0:'
 
 =cut
 
 sub devnull {
-    return 'NL:';
+    return "_NLA0:";
 }
 
 =item rootdir (override)
 
-Returns a string representing of the root directory.
+Returns a string representation of the root directory: 'SYS$DISK:[000000]'
 
 =cut
 
 sub rootdir {
-    return '';
+    return 'SYS$DISK:[000000]';
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first writable directory
+from the following list or '' if none are writable:
+
+    /sys$scratch
+    $ENV{TMPDIR}
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ('/sys$scratch', $ENV{TMPDIR}) {
+       next unless defined && -d && -w _;
+       $tmpdir = $_;
+       last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
 }
 
 =item updir (override)
 
-Returns a string representing of the parent directory.
+Returns a string representation of the parent directory: '[-]'
 
 =cut
 
@@ -135,9 +150,9 @@ to C<split> string value of C<$ENV{'PATH'}>.
 =cut
 
 sub path {
-    my(@dirs,$dir,$i);
+    my (@dirs,$dir,$i);
     while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
-    @dirs;
+    return @dirs;
 }
 
 =item file_name_is_absolute (override)
@@ -147,12 +162,20 @@ Checks for VMS directory spec as well as Unix separators.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
+    my ($self,$file) = @_;
     # If it's a logical name, expand it.
-    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
-    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file};
+    return scalar($file =~ m!^/!              ||
+                 $file =~ m![<\[][^.\-\]>]!  ||
+                 $file =~ /:[^<\[]/);
 }
 
-1;
-__END__
+=back
 
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;
index 3af8bcf..5d998b9 100644 (file)
@@ -1,12 +1,17 @@
 package File::Spec::Win32;
 
+use strict;
+use vars qw(@ISA);
+require File::Spec::Unix;
+@ISA = qw(File::Spec::Unix);
+
 =head1 NAME
 
 File::Spec::Win32 - methods for Win32 file specs
 
 =head1 SYNOPSIS
 
use File::Spec::Win32; # Done internally by File::Spec if needed
require File::Spec::Win32; # Done internally by File::Spec if needed
 
 =head1 DESCRIPTION
 
@@ -16,37 +21,46 @@ the semantics.
 
 =over
 
-=cut 
+=item devnull
 
-#use Config;
-#use Cwd;
-use File::Basename;
-require Exporter;
-use strict;
+Returns a string representation of the null device.
 
-use vars qw(@ISA);
+=cut
 
-use File::Spec;
-Exporter::import('File::Spec', qw( $Verbose));
+sub devnull {
+    return "nul";
+}
 
-@ISA = qw(File::Spec::Unix);
+=item tmpdir
 
-$ENV{EMXSHELL} = 'sh'; # to run `commands`
+Returns a string representation of the first existing directory
+from the following list:
 
-sub file_name_is_absolute {
-    my($self,$file) = @_;
-    $file =~ m{^([a-z]:)?[\\/]}i ;
-}
+    $ENV{TMPDIR}
+    $ENV{TEMP}
+    $ENV{TMP}
+    /tmp
+    /
+
+=cut
 
-sub catdir {
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
     my $self = shift;
-    my @args = @_;
-    for (@args) {
-       # append a slash to each argument unless it has one there
-       $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
+    foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
+       next unless defined && -d;
+       $tmpdir = $_;
+       last;
     }
-    my $result = $self->canonpath(join('', @args));
-    $result;
+    $tmpdir = '' unless defined $tmpdir;
+    $tmpdir = $self->canonpath($tmpdir);
+    return $tmpdir;
+}
+
+sub file_name_is_absolute {
+    my ($self,$file) = @_;
+    return scalar($file =~ m{^([a-z]:)?[\\/]}i);
 }
 
 =item catfile
@@ -57,26 +71,20 @@ complete path ending with a filename
 =cut
 
 sub catfile {
-    my $self = shift @_;
+    my $self = shift;
     my $file = pop @_;
     return $file unless @_;
     my $dir = $self->catdir(@_);
-    $dir =~ s/(\\\.)$//;
-    $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
+    $dir .= "\\" unless substr($dir,-1) eq "\\";
     return $dir.$file;
 }
 
-sub devnull {
-    return "nul";
-}
-
 sub path {
     local $^W = 1;
-    my($self) = @_;
     my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
     my @path = split(';',$path);
-    foreach(@path) { $_ = '.' if $_ eq '' }
-    @path;
+    foreach (@path) { $_ = '.' if $_ eq '' }
+    return @path;
 }
 
 =item canonpath
@@ -87,22 +95,23 @@ path. On UNIX eliminated successive slashes and successive "/.".
 =cut
 
 sub canonpath {
-    my($self,$path) = @_;
+    my ($self,$path) = @_;
     $path =~ s/^([a-z]:)/\u$1/;
     $path =~ s|/|\\|g;
-    $path =~ s|\\+|\\|g ;                          # xx////xx  -> xx/xx
-    $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
+    $path =~ s|([^\\])\\+|\1\\|g;                  # xx////xx  -> xx/xx
+    $path =~ s|(\\\.)+\\|\\|g                    # xx/././xx -> xx/xx
     $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
-    $path =~ s|\\$|| 
-             unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
-    $path .= '.' if $path =~ m#\\$#;
-    $path;
+    $path =~ s|\\$||
+             unless $path =~ m#^([A-Z]:)?\\#;      # xx/       -> xx
+    return $path;
 }
 
-1;
-__END__
-
 =back
 
-=cut 
+=head1 SEE ALSO
+
+L<File::Spec>
 
+=cut
+
+1;