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
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
--- /dev/null
+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<use File::Spec;>
+
+C<$x=File::Spec-E<gt>catfile('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 KE<ouml>nig, 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<File::Spec::Unix>,
+which contains the entire set, and inherited by the modules for other
+platforms. For further information, please see L<File::Spec::Mac>,
+L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
+
+=head1 SEE ALSO
+
+File::Spec::Unix, File::Spec::Mac, File::Spec::OS2, File::Spec::Win32,
+File::Spec::VMS, ExtUtils::MakeMaker
+
+=head1 AUTHORS
+
+Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
+<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
+<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS
+support by Charles Bailey <F<bailey@genetics.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;
\ No newline at end of file
--- /dev/null
+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<require File::Spec::Mac;>
+
+=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<File::Spec>
+
+=cut
+
+1;
+__END__
+
--- /dev/null
+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
--- /dev/null
+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<require File::Spec::Unix;>
+
+=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<File::Spec>
+
+=cut
+
+1;
+__END__
--- /dev/null
+
+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<split> 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__
+
--- /dev/null
+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
+
--- /dev/null
+#!/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";
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff