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

   1 package File::Spec::Mac;
   2
   3 use Exporter ();
   4 use Config;
   5 use strict;
   6 use File::Spec;
   7 use vars qw(@ISA $VERSION $Is_Mac);
   8
   9 $VERSION = '1.0';
  10
  11 @ISA = qw(File::Spec::Unix);
  12 $Is_Mac = $^O eq 'MacOS';
  13
  14 Exporter::import('File::Spec', '$Verbose');
  15
  16
  17 =head1 NAME
  18
  19 File::Spec::Mac - File::Spec for MacOS
  20
  21 =head1 SYNOPSIS
  22
  23 C<require File::Spec::Mac;>
  24
  25 =head1 DESCRIPTION
  26
  27 Methods for manipulating file specifications.
  28
  29 =head1 METHODS
  30
  31 =over 2
  32
  33 =item canonpath
  34
  35 On MacOS, there's nothing to be done.  Returns what it's given.
  36
  37 =cut
  38
  39 sub canonpath {
  40     my($self,$path) = @_;
  41     $path;
  42 }
  43
  44 =item catdir
  45
  46 Concatenate two or more directory names to form a complete path ending with
  47 a directory.  Put a trailing : on the end of the complete path if there
  48 isn't one, because that's what's done in MacPerl's environment.
  49
  50 The fundamental requirement of this routine is that
  51
  52           File::Spec->catdir(split(":",$path)) eq $path
  53
  54 But because of the nature of Macintosh paths, some additional
  55 possibilities are allowed to make using this routine give reasonable results
  56 for some common situations.  Here are the rules that are used.  Each
  57 argument has its trailing ":" removed.  Each argument, except the first,
  58 has its leading ":" removed.  They are then joined together by a ":".
  59
  60 So
  61
  62           File::Spec->catdir("a","b") = "a:b:"
  63           File::Spec->catdir("a:",":b") = "a:b:"
  64           File::Spec->catdir("a:","b") = "a:b:"
  65           File::Spec->catdir("a",":b") = "a:b"
  66           File::Spec->catdir("a","","b") = "a::b"
  67
  68 etc.
  69
  70 To get a relative path (one beginning with :), begin the first argument with :
  71 or put a "" as the first argument.
  72
  73 If you don't want to worry about these rules, never allow a ":" on the ends
  74 of any of the arguments except at the beginning of the first.
  75
  76 Under MacPerl, there is an additional ambiguity.  Does the user intend that
  77
  78           File::Spec->catfile("LWP","Protocol","http.pm")
  79
  80 be relative or absolute?  There's no way of telling except by checking for the
  81 existence of LWP: or :LWP, and even there he may mean a dismounted volume or
  82 a relative path in a different directory (like in @INC).   So those checks
  83 aren't done here. This routine will treat this as absolute.
  84
  85 =cut
  86
  87 # ';
  88
  89 sub catdir {
  90     shift;
  91     my @args = @_;
  92         $args[0] =~ s/:$//;
  93         my $result = shift @args;
  94         for (@args) {
  95                 s/:$//;
  96                 s/^://;
  97                 $result .= ":$_";
  98     }
  99     $result .= ":";
 100         $result;
 101 }
 102
 103 =item catfile
 104
 105 Concatenate one or more directory names and a filename to form a
 106 complete path ending with a filename.  Since this uses catdir, the
 107 same caveats apply.  Note that the leading : is removed from the filename,
 108 so that
 109
 110           File::Spec->catfile($ENV{HOME},"file");
 111
 112 and
 113
 114           File::Spec->catfile($ENV{HOME},":file");
 115
 116 give the same answer, as one might expect.
 117
 118 =cut
 119
 120 sub catfile {
 121     my $self = shift @_;
 122     my $file = pop @_;
 123     return $file unless @_;
 124     my $dir = $self->catdir(@_);
 125         $file =~ s/^://;
 126     return $dir.$file;
 127 }
 128
 129 =item curdir
 130
 131 Returns a string representing of the current directory.
 132
 133 =cut
 134
 135 sub curdir {
 136     return ":" ;
 137 }
 138
 139 =item rootdir
 140
 141 Returns a string representing the root directory.  Under MacPerl,
 142 returns the name of the startup volume, since that's the closest in
 143 concept, although other volumes aren't rooted there.  On any other
 144 platform returns '', since there's no common way to indicate "root
 145 directory" across all Macs.
 146
 147 =cut
 148
 149 sub rootdir {
 150 #
 151 #  There's no real root directory on MacOS.  If you're using MacPerl,
 152 #  the name of the startup volume is returned, since that's the closest in
 153 #  concept.  On other platforms, simply return '', because nothing better
 154 #  can be done.
 155 #
 156         if($Is_Mac) {
 157         require Mac::Files;
 158                 my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
 159                         &Mac::Files::kSystemFolderType);
 160                 $system =~ s/:.*$/:/;
 161                 return $system;
 162         } else {
 163                 return '';
 164     }
 165 }
 166
 167 =item updir
 168
 169 Returns a string representing the parent directory.
 170
 171 =cut
 172
 173 sub updir {
 174     return "::";
 175 }
 176
 177 =item file_name_is_absolute
 178
 179 Takes as argument a path and returns true, if it is an absolute path.  In
 180 the case where a name can be either relative or absolute (for example, a
 181 folder named "HD" in the current working directory on a drive named "HD"),
 182 relative wins.  Use ":" in the appropriate place in the path if you want to
 183 distinguish unambiguously.
 184
 185 =cut
 186
 187 sub file_name_is_absolute {
 188     my($self,$file) = @_;
 189         if ($file =~ /:/) {
 190                 return ($file !~ m/^:/);
 191         } else {
 192                 return (! -e ":$file");
 193     }
 194 }
 195
 196 =item path
 197
 198 Returns the null list for the MacPerl application, since the concept is
 199 usually meaningless under MacOS. But if you're using the MacPerl tool under
 200 MPW, it gives back $ENV{Commands} suitably split, as is done in
 201 :lib:ExtUtils:MM_Mac.pm.
 202
 203 =cut
 204
 205 sub path {
 206 #
 207 #  The concept is meaningless under the MacPerl application.
 208 #  Under MPW, it has a meaning.
 209 #
 210     my($self) = @_;
 211         my @path;
 212         if(exists $ENV{Commands}) {
 213                 @path = split /,/,$ENV{Commands};
 214         } else {
 215             @path = ();
 216         }
 217     @path;
 218 }
 219
 220 =back
 221
 222 =head1 SEE ALSO
 223
 224 L<File::Spec>
 225
 226 =cut
 227
 228 1;
 229 __END__
 230