lib/File/Spec/Unix.pm

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