contrib/perl5/lib/File/Spec/Unix.pm

   1 package File::Spec::Unix;
   2
   3 use Exporter ();
   4 use Config;
   5 use File::Basename qw(basename dirname fileparse);
   6 use DirHandle;
   7 use strict;
   8 use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32);
   9 use File::Spec;
  10
  11 Exporter::import('File::Spec', '$Verbose');
  12
  13 $Is_OS2 = $^O eq 'os2';
  14 $Is_Mac = $^O eq 'MacOS';
  15 $Is_Win32 = $^O eq 'MSWin32';
  16
  17 if ($Is_VMS = $^O eq 'VMS') {
  18     require VMS::Filespec;
  19     import VMS::Filespec qw( &vmsify );
  20 }
  21
  22 =head1 NAME
  23
  24 File::Spec::Unix - methods used by File::Spec
  25
  26 =head1 SYNOPSIS
  27
  28 C<require File::Spec::Unix;>
  29
  30 =head1 DESCRIPTION
  31
  32 Methods for manipulating file specifications.
  33
  34 =head1 METHODS
  35
  36 =over 2
  37
  38 =item canonpath
  39
  40 No physical check on the filesystem, but a logical cleanup of a
  41 path. On UNIX eliminated successive slashes and successive "/.".
  42
  43 =cut
  44
  45 sub canonpath {
  46     my($self,$path) = @_;
  47     $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
  48     $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
  49     $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
  50     $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
  51     $path;
  52 }
  53
  54 =item catdir
  55
  56 Concatenate two or more directory names to form a complete path ending
  57 with a directory. But remove the trailing slash from the resulting
  58 string, because it doesn't look good, isn't necessary and confuses
  59 OS2. Of course, if this is the root directory, don't cut off the
  60 trailing slash :-)
  61
  62 =cut
  63
  64 # ';
  65
  66 sub catdir {
  67     shift;
  68     my @args = @_;
  69     for (@args) {
  70         # append a slash to each argument unless it has one there
  71         $_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
  72     }
  73     my $result = join('', @args);
  74     # remove a trailing slash unless we are root
  75     substr($result,-1) = ""
  76         if length($result) > 1 && substr($result,-1) eq "/";
  77     $result;
  78 }
  79
  80 =item catfile
  81
  82 Concatenate one or more directory names and a filename to form a
  83 complete path ending with a filename
  84
  85 =cut
  86
  87 sub catfile {
  88     my $self = shift @_;
  89     my $file = pop @_;
  90     return $file unless @_;
  91     my $dir = $self->catdir(@_);
  92     for ($dir) {
  93         $_ .= "/" unless substr($_,length($_)-1,1) eq "/";
  94     }
  95     return $dir.$file;
  96 }
  97
  98 =item curdir
  99
 100 Returns a string representing of the current directory.  "." on UNIX.
 101
 102 =cut
 103
 104 sub curdir {
 105     return "." ;
 106 }
 107
 108 =item rootdir
 109
 110 Returns a string representing of the root directory.  "/" on UNIX.
 111
 112 =cut
 113
 114 sub rootdir {
 115     return "/";
 116 }
 117
 118 =item updir
 119
 120 Returns a string representing of the parent directory.  ".." on UNIX.
 121
 122 =cut
 123
 124 sub updir {
 125     return "..";
 126 }
 127
 128 =item no_upwards
 129
 130 Given a list of file names, strip out those that refer to a parent
 131 directory. (Does not strip symlinks, only '.', '..', and equivalents.)
 132
 133 =cut
 134
 135 sub no_upwards {
 136     my($self) = shift;
 137     return grep(!/^\.{1,2}$/, @_);
 138 }
 139
 140 =item file_name_is_absolute
 141
 142 Takes as argument a path and returns true, if it is an absolute path.
 143
 144 =cut
 145
 146 sub file_name_is_absolute {
 147     my($self,$file) = @_;
 148     $file =~ m:^/: ;
 149 }
 150
 151 =item path
 152
 153 Takes no argument, returns the environment variable PATH as an array.
 154
 155 =cut
 156
 157 sub path {
 158     my($self) = @_;
 159     my $path_sep = ":";
 160     my $path = $ENV{PATH};
 161     my @path = split $path_sep, $path;
 162     foreach(@path) { $_ = '.' if $_ eq '' }
 163     @path;
 164 }
 165
 166 =item join
 167
 168 join is the same as catfile.
 169
 170 =cut
 171
 172 sub join {
 173         my($self) = shift @_;
 174         $self->catfile(@_);
 175 }
 176
 177 =item nativename
 178
 179 TBW.
 180
 181 =cut
 182
 183 sub nativename {
 184         my($self,$name) = shift @_;
 185         $name;
 186 }
 187
 188 =back
 189
 190 =head1 SEE ALSO
 191
 192 L<File::Spec>
 193
 194 =cut
 195
 196 1;
 197 __END__