From: Gurusamy Sarathy Date: Sat, 20 Jun 1998 23:29:09 +0000 (+0000) Subject: add File-Spec-0.6 from CPAN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=270d1e3932d8fd3e603e87df650a603bf9eefa79;p=p5sagit%2Fp5-mst-13.2.git add File-Spec-0.6 from CPAN p4raw-id: //depot/perl@1164 --- diff --git a/MANIFEST b/MANIFEST index 7634708..b1b9125 100644 --- a/MANIFEST +++ b/MANIFEST @@ -461,6 +461,12 @@ lib/File/Copy.pm Emulation of cp command lib/File/DosGlob.pm Win32 DOS-globbing module lib/File/Find.pm Routines to do a find lib/File/Path.pm Do things like `mkdir -p' and `rm -r' +lib/File/Spec.pm portable operations on file names +lib/File/Spec/Mac.pm portable operations on Mac file names +lib/File/Spec/OS2.pm portable operations on OS2 file names +lib/File/Spec/Unix.pm portable operations on Unix file names +lib/File/Spec/VMS.pm portable operations on VMS file names +lib/File/Spec/Win32.pm portable operations on Win32 file names lib/File/stat.pm By-name interface to Perl's builtin stat lib/FileCache.pm Keep more files open than the system permits lib/FileHandle.pm Backward-compatible front end to IO extension @@ -791,6 +797,7 @@ t/lib/filecopy.t See if File::Copy works t/lib/filefind.t See if File::Find works t/lib/filehand.t See if FileHandle works t/lib/filepath.t See if File::Path works +t/lib/filespec.t See if File::Spec works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long works diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm new file mode 100644 index 0000000..e768e0d --- /dev/null +++ b/lib/File/Spec.pm @@ -0,0 +1,116 @@ +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); + +$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); + +1; +__END__ + +=head1 NAME + +File::Spec - portably perform operations on file names + +=head1 SYNOPSIS + +C + +C<$x=File::Spec-Ecatfile('a','b','c');> + +which returns 'a/b/c' under Unix. + +=head1 DESCRIPTION + +This module is designed to support operations commonly performed on file +specifications (usually called "file names", but not to be confused with the +contents of a file, or Perl's file handles), such as concatenating several +directory and file names into a single path, or determining whether a path +is rooted. It is based on code directly taken from MakeMaker 5.17, code +written by Andreas KEnig, Andy Dougherty, Charles Bailey, Ilya +Zakharevich, Paul Schinder, and others. + +Since these functions are different for most operating systems, each set of +OS specific routines is available in a separate module, including: + + File::Spec::Unix + File::Spec::Mac + File::Spec::OS2 + File::Spec::Win32 + File::Spec::VMS + +The module appropriate for the current OS is automatically loaded by +File::Spec. Since some modules (like VMS) make use of OS specific +facilities, it may not be possible to load all modules under all operating +systems. + +Since File::Spec is object oriented, subroutines should not called directly, +as in: + + File::Spec::catfile('a','b'); + +but rather as class methods: + + File::Spec->catfile('a','b'); + +For a reference of available functions, pleaes consult L, +which contains the entire set, and inherited by the modules for other +platforms. For further information, please see L, +L, L, or L. + +=head1 SEE ALSO + +File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32, +File::Spec::VMS, ExtUtils::MakeMaker + +=head1 AUTHORS + +Kenneth Albanowski >, Andy Dougherty +>, Andreas KEnig +>, Tim Bunce >. VMS +support by Charles Bailey >. OS/2 support by +Ilya Zakharevich >. Mac support by Paul Schinder +>. + +=cut + + +1; \ No newline at end of file diff --git a/lib/File/Spec/Mac.pm b/lib/File/Spec/Mac.pm new file mode 100644 index 0000000..4968e24 --- /dev/null +++ b/lib/File/Spec/Mac.pm @@ -0,0 +1,230 @@ +package File::Spec::Mac; + +use Exporter (); +use Config; +use strict; +use File::Spec; +use vars qw(@ISA $VERSION $Is_Mac); + +$VERSION = '1.0'; + +@ISA = qw(File::Spec::Unix); +$Is_Mac = $^O eq 'MacOS'; + +Exporter::import('File::Spec', '$Verbose'); + + +=head1 NAME + +File::Spec::Mac - File::Spec for MacOS + +=head1 SYNOPSIS + +C + +=head1 DESCRIPTION + +Methods for manipulating file specifications. + +=head1 METHODS + +=over 2 + +=item canonpath + +On MacOS, there's nothing to be done. Returns what it's given. + +=cut + +sub canonpath { + my($self,$path) = @_; + $path; +} + +=item catdir + +Concatenate two or more directory names to form a complete path ending with +a directory. Put a trailing : on the end of the complete path if there +isn't one, because that's what's done in MacPerl's environment. + +The fundamental requirement of this routine is that + + File::Spec->catdir(split(":",$path)) eq $path + +But because of the nature of Macintosh paths, some additional +possibilities are allowed to make using this routine give resonable results +for some common situations. Here are the rules that are used. Each +argument has its trailing ":" removed. Each argument, except the first, +has its leading ":" removed. They are then joined together by a ":". + +So + + File::Spec->catdir("a","b") = "a:b:" + File::Spec->catdir("a:",":b") = "a:b:" + File::Spec->catdir("a:","b") = "a:b:" + File::Spec->catdir("a",":b") = "a:b" + File::Spec->catdir("a","","b") = "a::b" + +etc. + +To get a relative path (one beginning with :), begin the first argument with : +or put a "" as the first argument. + +If you don't want to worry about these rules, never allow a ":" on the ends +of any of the arguments except at the beginning of the first. + +Under MacPerl, there is an additional ambiguity. Does the user intend that + + File::Spec->catfile("LWP","Protocol","http.pm") + +be relative or absolute? There's no way of telling except by checking for the +existance of LWP: or :LWP, and even there he may mean a dismounted volume or +a relative path in a different directory (like in @INC). So those checks +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 .= ":$_"; + } + $result .= ":"; + $result; +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename. Since this uses catdir, the +same caveats apply. Note that the leading : is removed from the filename, +so that + + File::Spec->catfile($ENV{HOME},"file"); + +and + + File::Spec->catfile($ENV{HOME},":file"); + +give the same answer, as one might expect. + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $file unless @_; + my $dir = $self->catdir(@_); + $file =~ s/^://; + return $dir.$file; +} + +=item curdir + +Returns a string representing of the current directory. + +=cut + +sub curdir { + return ":" ; +} + +=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. + +=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. +# + if($Is_Mac) { + require Mac::Files; + my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk, + &Mac::Files::kSystemFolderType); + $system =~ s/:.*$/:/; + return $system; + } else { + return ''; + } +} + +=item updir + +Returns a string representing the parent directory. + +=cut + +sub updir { + return "::"; +} + +=item file_name_is_absolute + +Takes as argument a path and returns true, if it is an absolute path. In +the case where a name can be either relative or absolute (for example, a +folder named "HD" in the current working directory on a drive named "HD"), +relative wins. Use ":" in the appropriate place in the path if you want to +distinguish unambiguously. + +=cut + +sub file_name_is_absolute { + my($self,$file) = @_; + if ($file =~ /:/) { + return ($file !~ m/^:/); + } else { + return (! -e ":$file"); + } +} + +=item path + +Returns the null list for the MacPerl application, since the concept is +usually meaningless under MacOS. But if you're using the MacPerl tool under +MPW, it gives back $ENV{Commands} suitably split, as is done in +:lib:ExtUtils:MM_Mac.pm. + +=cut + +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; +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; +__END__ + diff --git a/lib/File/Spec/OS2.pm b/lib/File/Spec/OS2.pm new file mode 100644 index 0000000..d602617 --- /dev/null +++ b/lib/File/Spec/OS2.pm @@ -0,0 +1,51 @@ +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)); + +@ISA = qw(File::Spec::Unix); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` + +sub file_name_is_absolute { + my($self,$file) = @_; + $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; +} + +1; +__END__ + +=head1 NAME + +File::Spec::OS2 - methods for OS/2 file specs + +=head1 SYNOPSIS + + use 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 diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm new file mode 100644 index 0000000..77de73a --- /dev/null +++ b/lib/File/Spec/Unix.pm @@ -0,0 +1,197 @@ +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 + +File::Spec::Unix - methods used by File::Spec + +=head1 SYNOPSIS + +C + +=head1 DESCRIPTION + +Methods for manipulating file specifications. + +=head1 METHODS + +=over 2 + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +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 + $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx + $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx + $path; +} + +=item catdir + +Concatenate two or more directory names to form a complete path ending +with a directory. But remove the trailing slash from the resulting +string, because it doesn't look good, isn't necessary and confuses +OS2. Of course, if this is the root directory, don't cut off the +trailing slash :-) + +=cut + +# '; + +sub catdir { + shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "/" if $_ eq '' or 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; +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $file unless @_; + my $dir = $self->catdir(@_); + for ($dir) { + $_ .= "/" unless substr($_,length($_)-1,1) eq "/"; + } + return $dir.$file; +} + +=item curdir + +Returns a string representing of the current directory. "." on UNIX. + +=cut + +sub curdir { + return "." ; +} + +=item rootdir + +Returns a string representing of the root directory. "/" on UNIX. + +=cut + +sub rootdir { + return "/"; +} + +=item updir + +Returns a string representing of the parent directory. ".." on UNIX. + +=cut + +sub updir { + return ".."; +} + +=item no_upwards + +Given a list of file names, strip out those that refer to a parent +directory. (Does not strip symlinks, only '.', '..', and equivalents.) + +=cut + +sub no_upwards { + my($self) = shift; + return grep(!/^\.{1,2}$/, @_); +} + +=item file_name_is_absolute + +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:^/: ; +} + +=item path + +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; +} + +=item join + +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; +} + +=back + +=head1 SEE ALSO + +L + +=cut + +1; +__END__ diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm new file mode 100644 index 0000000..c5269fd --- /dev/null +++ b/lib/File/Spec/VMS.pm @@ -0,0 +1,148 @@ + +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)'; + +@ISA = qw(File::Spec::Unix); + +Exporter::import('File::Spec', '$Verbose'); + +=head1 NAME + +File::Spec::VMS - methods for VMS file specs + +=head1 SYNOPSIS + + use File::Spec::VMS; # 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. + +=head2 Methods always loaded + +=over + +=item catdir + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory specification. + +=cut + +sub catdir { + my($self,@dirs) = @_; + my($dir) = pop @dirs; + @dirs = grep($_,@dirs); + 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); + } + else { + if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; } + else { $rslt = vmspath($dir); } + } + print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item catfile + +Concatenates a list of file specifications, and returns the result as a +VMS-syntax directory specification. + +=cut + +sub catfile { + my($self,@files) = @_; + my($file) = pop @files; + @files = grep($_,@files); + 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)); + } + } + else { $rslt = vmsify($file); } + print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; + $rslt; +} + +=item curdir (override) + +Returns a string representing of the current directory. + +=cut + +sub curdir { + return '[]'; +} + +=item rootdir (override) + +Returns a string representing of the root directory. + +=cut + +sub rootdir { + return ''; +} + +=item updir (override) + +Returns a string representing of the parent directory. + +=cut + +sub updir { + return '[-]'; +} + +=item path (override) + +Translate logical name DCL$PATH as a searchlist, rather than trying +to C string value of C<$ENV{'PATH'}>. + +=cut + +sub path { + my(@dirs,$dir,$i); + while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } + @dirs; +} + +=item file_name_is_absolute (override) + +Checks for VMS directory spec as well as Unix separators. + +=cut + +sub file_name_is_absolute { + 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 =~ /:[^<\[]/; +} + +1; +__END__ + diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm new file mode 100644 index 0000000..034a0cb --- /dev/null +++ b/lib/File/Spec/Win32.pm @@ -0,0 +1,104 @@ +package File::Spec::Win32; + +=head1 NAME + +File::Spec::Win32 - methods for Win32 file specs + +=head1 SYNOPSIS + + use File::Spec::Win32; # 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. + +=over + +=cut + +#use Config; +#use Cwd; +use File::Basename; +require Exporter; +use strict; + +use vars qw(@ISA); + +use File::Spec; +Exporter::import('File::Spec', qw( $Verbose)); + +@ISA = qw(File::Spec::Unix); + +$ENV{EMXSHELL} = 'sh'; # to run `commands` + +sub file_name_is_absolute { + my($self,$file) = @_; + $file =~ m{^([a-z]:)?[\\/]}i ; +} + +sub catdir { + my $self = shift; + my @args = @_; + for (@args) { + # append a slash to each argument unless it has one there + $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; + } + my $result = $self->canonpath(join('', @args)); + $result; +} + +=item catfile + +Concatenate one or more directory names and a filename to form a +complete path ending with a filename + +=cut + +sub catfile { + my $self = shift @_; + my $file = pop @_; + return $file unless @_; + my $dir = $self->catdir(@_); + $dir =~ s/(\\\.)$//; + $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; + return $dir.$file; +} + +sub path { + local $^W = 1; + my($self) = @_; + my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; + my @path = split(';',$path); + foreach(@path) { $_ = '.' if $_ eq '' } + @path; +} + +=item canonpath + +No physical check on the filesystem, but a logical cleanup of a +path. On UNIX eliminated successive slashes and successive "/.". + +=cut + +sub canonpath { + 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|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx + $path =~ s|\\$|| + unless $path =~ m#^([a-z]:)?\\#; # xx/ -> xx + $path .= '.' if $path =~ m#\\$#; + $path; +} + +1; +__END__ + +=back + +=cut + diff --git a/t/lib/filespec.t b/t/lib/filespec.t new file mode 100755 index 0000000..8ba4363 --- /dev/null +++ b/t/lib/filespec.t @@ -0,0 +1,41 @@ +#!/usr/bin/perl + +print "1..4\n"; + +BEGIN { + $^O = ''; +} + +use File::Spec; + + +if (File::Spec->catfile('a','b','c') eq 'a/b/c') { + print "ok 1\n"; +} else { + print "not ok 1\n"; +} + +use File::Spec::OS2; + +if (File::Spec::OS2->catfile('a','b','c') eq 'a/b/c') { + print "ok 2\n"; +} else { + print "not ok 2\n"; +} + +use File::Spec::Win32; + +if (File::Spec::Win32->catfile('a','b','c') eq 'a\b\c') { + print "ok 3\n"; +} else { + print "not ok 3\n"; +} + +use File::Spec::Mac; + +if (File::Spec::Mac->catfile('a','b','c') eq 'a:b:c') { + print "ok 4\n"; +} else { + print "not ok 4\n"; +} +