Commit | Line | Data |
270d1e39 |
1 | package File::Spec::Unix; |
2 | |
270d1e39 |
3 | use strict; |
270d1e39 |
4 | |
5 | =head1 NAME |
6 | |
7 | File::Spec::Unix - methods used by File::Spec |
8 | |
9 | =head1 SYNOPSIS |
10 | |
cbc7acb0 |
11 | require File::Spec::Unix; # Done automatically by File::Spec |
270d1e39 |
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 { |
cbc7acb0 |
29 | my ($self,$path) = @_; |
30 | $path =~ s|/+|/|g; # xx////xx -> xx/xx |
31 | $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx |
270d1e39 |
32 | $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx |
33 | $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx |
cbc7acb0 |
34 | return $path; |
270d1e39 |
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 | |
270d1e39 |
47 | sub catdir { |
cbc7acb0 |
48 | my $self = shift; |
270d1e39 |
49 | my @args = @_; |
cbc7acb0 |
50 | foreach (@args) { |
270d1e39 |
51 | # append a slash to each argument unless it has one there |
cbc7acb0 |
52 | $_ .= "/" if $_ eq '' || substr($_,-1) ne "/"; |
270d1e39 |
53 | } |
cbc7acb0 |
54 | return $self->canonpath(join('', @args)); |
270d1e39 |
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 { |
cbc7acb0 |
65 | my $self = shift; |
270d1e39 |
66 | my $file = pop @_; |
67 | return $file unless @_; |
68 | my $dir = $self->catdir(@_); |
cbc7acb0 |
69 | $dir .= "/" unless substr($dir,-1) eq "/"; |
270d1e39 |
70 | return $dir.$file; |
71 | } |
72 | |
73 | =item curdir |
74 | |
cbc7acb0 |
75 | Returns a string representation of the current directory. "." on UNIX. |
270d1e39 |
76 | |
77 | =cut |
78 | |
79 | sub curdir { |
cbc7acb0 |
80 | return "."; |
270d1e39 |
81 | } |
82 | |
99804bbb |
83 | =item devnull |
84 | |
cbc7acb0 |
85 | Returns a string representation of the null device. "/dev/null" on UNIX. |
99804bbb |
86 | |
87 | =cut |
88 | |
89 | sub devnull { |
90 | return "/dev/null"; |
91 | } |
92 | |
270d1e39 |
93 | =item rootdir |
94 | |
cbc7acb0 |
95 | Returns a string representation of the root directory. "/" on UNIX. |
270d1e39 |
96 | |
97 | =cut |
98 | |
99 | sub rootdir { |
100 | return "/"; |
101 | } |
102 | |
cbc7acb0 |
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 | |
270d1e39 |
125 | =item updir |
126 | |
cbc7acb0 |
127 | Returns a string representation of the parent directory. ".." on UNIX. |
270d1e39 |
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 { |
cbc7acb0 |
143 | my $self = shift; |
270d1e39 |
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 { |
cbc7acb0 |
154 | my ($self,$file) = @_; |
155 | return scalar($file =~ m:^/:); |
270d1e39 |
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 { |
cbc7acb0 |
165 | my @path = split(':', $ENV{PATH}); |
166 | foreach (@path) { $_ = '.' if $_ eq '' } |
167 | return @path; |
270d1e39 |
168 | } |
169 | |
170 | =item join |
171 | |
172 | join is the same as catfile. |
173 | |
174 | =cut |
175 | |
176 | sub join { |
cbc7acb0 |
177 | my $self = shift; |
178 | return $self->catfile(@_); |
270d1e39 |
179 | } |
180 | |
181 | =back |
182 | |
183 | =head1 SEE ALSO |
184 | |
185 | L<File::Spec> |
186 | |
187 | =cut |
188 | |
189 | 1; |