Commit | Line | Data |
270d1e39 |
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__ |