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 | |
99804bbb |
108 | =item devnull |
109 | |
110 | Returns the name of the null device (bit bucket). "/dev/null" on UNIX. |
111 | |
112 | =cut |
113 | |
114 | sub devnull { |
115 | return "/dev/null"; |
116 | } |
117 | |
270d1e39 |
118 | =item rootdir |
119 | |
120 | Returns a string representing of the root directory. "/" on UNIX. |
121 | |
122 | =cut |
123 | |
124 | sub rootdir { |
125 | return "/"; |
126 | } |
127 | |
128 | =item updir |
129 | |
130 | Returns a string representing of the parent directory. ".." on UNIX. |
131 | |
132 | =cut |
133 | |
134 | sub updir { |
135 | return ".."; |
136 | } |
137 | |
138 | =item no_upwards |
139 | |
140 | Given a list of file names, strip out those that refer to a parent |
141 | directory. (Does not strip symlinks, only '.', '..', and equivalents.) |
142 | |
143 | =cut |
144 | |
145 | sub no_upwards { |
146 | my($self) = shift; |
147 | return grep(!/^\.{1,2}$/, @_); |
148 | } |
149 | |
150 | =item file_name_is_absolute |
151 | |
152 | Takes as argument a path and returns true, if it is an absolute path. |
153 | |
154 | =cut |
155 | |
156 | sub file_name_is_absolute { |
157 | my($self,$file) = @_; |
158 | $file =~ m:^/: ; |
159 | } |
160 | |
161 | =item path |
162 | |
163 | Takes no argument, returns the environment variable PATH as an array. |
164 | |
165 | =cut |
166 | |
167 | sub path { |
168 | my($self) = @_; |
169 | my $path_sep = ":"; |
170 | my $path = $ENV{PATH}; |
171 | my @path = split $path_sep, $path; |
172 | foreach(@path) { $_ = '.' if $_ eq '' } |
173 | @path; |
174 | } |
175 | |
176 | =item join |
177 | |
178 | join is the same as catfile. |
179 | |
180 | =cut |
181 | |
182 | sub join { |
183 | my($self) = shift @_; |
184 | $self->catfile(@_); |
185 | } |
186 | |
187 | =item nativename |
188 | |
189 | TBW. |
190 | |
191 | =cut |
192 | |
193 | sub nativename { |
194 | my($self,$name) = shift @_; |
195 | $name; |
196 | } |
197 | |
198 | =back |
199 | |
200 | =head1 SEE ALSO |
201 | |
202 | L<File::Spec> |
203 | |
204 | =cut |
205 | |
206 | 1; |
207 | __END__ |