Commit | Line | Data |
748a9306 |
1 | # Perl hooks into the routines in vms.c for interconversion |
2 | # of VMS and Unix file specification syntax. |
3 | # |
4 | # Version: 1.1 |
5 | # Author: Charles Bailey bailey@genetics.upenn.edu |
6 | # Revised: 08-Mar-1995 |
7 | |
8 | =head1 NAME |
9 | |
10 | VMS::Filespec - convert between VMS and Unix file specification syntax |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | use VMS::Filespec; |
15 | $vmsspec = vmsify('/my/Unix/file/specification'); |
16 | $unixspec = unixify('my:[VMS]file.specification'); |
17 | $path = pathify('my:[VMS.or.Unix.directory]specification.dir'); |
18 | $dirfile = fileify('my:[VMS.or.Unix.directory.specification]'); |
19 | $vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir'); |
20 | $unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir'); |
21 | candelete('my:[VMS.or.Unix]file.specification'); |
22 | |
23 | =head1 DESCRIPTION |
24 | |
25 | This package provides routines to simplify conversion between VMS and |
26 | Unix syntax when processing file specifications. This is useful when |
27 | porting scripts designed to run under either OS, and also allows you |
a5f75d66 |
28 | to take advantage of conveniences provided by either syntax (I<e.g.> |
748a9306 |
29 | ability to easily concatenate Unix-style specifications). In |
30 | addition, it provides an additional file test routine, C<candelete>, |
31 | which determines whether you have delete access to a file. |
32 | |
33 | If you're running under VMS, the routines in this package are special, |
34 | in that they're automatically made available to any Perl script, |
35 | whether you're running F<miniperl> or the full F<perl>. The C<use |
36 | VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...> |
37 | statement can be used to import the function names into the current |
38 | package, but they're always available if you use the fully qualified |
39 | name, whether or not you've mentioned the F<.pm> file in your script. |
40 | If you're running under another OS and have installed this package, it |
41 | behaves like a normal Perl extension (in fact, you're using Perl |
42 | substitutes to emulate the necessary VMS system calls). |
43 | |
44 | Each of these routines accepts a file specification in either VMS or |
e518068a |
45 | Unix syntax, and returns the converted file specification, or C<undef> |
46 | if an error occurs. The conversions are, for the most part, simply |
748a9306 |
47 | string manipulations; the routines do not check the details of syntax |
48 | (e.g. that only legal characters are used). There is one exception: |
49 | when running under VMS, conversions from VMS syntax use the $PARSE |
50 | service to expand specifications, so illegal syntax, or a relative |
51 | directory specification which extends above the tope of the current |
52 | directory path (e.g [---.foo] when in dev:[dir.sub]) will cause |
53 | errors. In general, any legal file specification will be converted |
54 | properly, but garbage input tends to produce garbage output. |
55 | |
a5f75d66 |
56 | Each of these routines is prototyped as taking a single scalar |
57 | argument, so you can use them as unary operators in complex |
58 | expressions (as long as you don't use the C<&> form of |
59 | subroutine call, which bypasses prototype checking). |
60 | |
61 | |
748a9306 |
62 | The routines provided are: |
63 | |
64 | =head2 vmsify |
65 | |
66 | Converts a file specification to VMS syntax. |
67 | |
68 | =head2 unixify |
69 | |
70 | Converts a file specification to Unix syntax. |
71 | |
72 | =head2 pathify |
73 | |
74 | Converts a directory specification to a path - that is, a string you |
75 | can prepend to a file name to form a valid file specification. If the |
76 | input file specification uses VMS syntax, the returned path does, too; |
77 | likewise for Unix syntax (Unix paths are guaranteed to end with '/'). |
e518068a |
78 | Note that this routine will insist that the input be a legal directory |
79 | file specification; the file type and version, if specified, must be |
80 | F<.DIR;1>. For compatibility with Unix usage, the type and version |
81 | may also be omitted. |
748a9306 |
82 | |
83 | =head2 fileify |
84 | |
85 | Converts a directory specification to the file specification of the |
86 | directory file - that is, a string you can pass to functions like |
87 | C<stat> or C<rmdir> to manipulate the directory file. If the |
88 | input directory specification uses VMS syntax, the returned file |
e518068a |
89 | specification does, too; likewise for Unix syntax. As with |
90 | C<pathify>, the input file specification must have a type and |
91 | version of F<.DIR;1>, or the type and version must be omitted. |
748a9306 |
92 | |
93 | =head2 vmspath |
94 | |
95 | Acts like C<pathify>, but insures the returned path uses VMS syntax. |
96 | |
97 | =head2 unixpath |
98 | |
99 | Acts like C<pathify>, but insures the returned path uses Unix syntax. |
100 | |
101 | =head2 candelete |
102 | |
103 | Determines whether you have delete access to a file. If you do, C<candelete> |
104 | returns true. If you don't, or its argument isn't a legal file specification, |
105 | C<candelete> returns FALSE. Unlike other file tests, the argument to |
106 | C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB, |
107 | it's a list operator, so you need to be careful about parentheses. Both of |
108 | these restrictions may be removed in the future if the functionality of |
109 | C<candelete> becomes part of the Perl core. |
110 | |
111 | =head1 REVISION |
112 | |
a5f75d66 |
113 | This document was last revised 22-Feb-1996, for Perl 5.002. |
748a9306 |
114 | |
115 | =cut |
116 | |
117 | package VMS::Filespec; |
a5f75d66 |
118 | require 5.002; |
119 | |
748a9306 |
120 | |
e518068a |
121 | # If you want to use this package on a non-VMS system, |
122 | # uncomment the following line. |
123 | # use AutoLoader; |
748a9306 |
124 | require Exporter; |
125 | |
126 | @ISA = qw( Exporter ); |
e518068a |
127 | @EXPORT = qw( &vmsify &unixify &pathify &fileify |
128 | &vmspath &unixpath &candelete); |
748a9306 |
129 | |
e518068a |
130 | @EXPORT_OK = qw( &rmsexpand ); |
748a9306 |
131 | 1; |
132 | |
133 | |
134 | __END__ |
135 | |
136 | |
137 | # The autosplit routines here are provided for use by non-VMS systems |
138 | # They are not guaranteed to function identically to the XSUBs of the |
139 | # same name, since they do not have access to the RMS system routine |
140 | # sys$parse() (in particular, no real provision is made for handling |
141 | # of complex DECnet node specifications). However, these routines |
142 | # should be adequate for most purposes. |
143 | |
144 | # A sort-of sys$parse() replacement |
145 | sub rmsexpand { |
146 | my($fspec,$defaults) = @_; |
147 | if (!$fspec) { return undef } |
148 | my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver); |
149 | |
150 | $fspec =~ s/:$//; |
151 | $defaults = [] unless $defaults; |
152 | $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY'; |
153 | |
154 | while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} } |
155 | |
156 | if ($fspec =~ /:/) { |
157 | my($dev,$devtrn,$base); |
158 | ($dev,$base) = split(/:/,$fspec); |
159 | $devtrn = $dev; |
160 | while ($devtrn = $ENV{$devtrn}) { |
161 | if ($devtrn =~ /(.)([:>\]])$/) { |
162 | $dev .= ':', last if $1 eq '.'; |
163 | $dev = $devtrn, last; |
164 | } |
165 | } |
166 | $fspec = $dev . $base; |
167 | } |
168 | |
169 | ($node,$dev,$dir,$name,$type,$ver) = $fspec =~ |
170 | /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; |
171 | foreach ((@$defaults,$ENV{'DEFAULT'})) { |
172 | last if $node && $ver && $type && $dev && $dir && $name; |
173 | ($dnode,$ddev,$ddir,$dname,$dtype,$dver) = |
174 | /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; |
175 | $node = $dnode if $dnode && !$node; |
176 | $dev = $ddev if $ddev && !$dev; |
177 | $dir = $ddir if $ddir && !$dir; |
178 | $name = $dname if $dname && !$name; |
179 | $type = $dtype if $dtype && !$type; |
180 | $ver = $dver if $dver && !$ver; |
181 | } |
182 | # do this the long way to keep -w happy |
183 | $fspec = ''; |
184 | $fspec .= $node if $node; |
185 | $fspec .= $dev if $dev; |
186 | $fspec .= $dir if $dir; |
187 | $fspec .= $name if $name; |
188 | $fspec .= $type if $type; |
189 | $fspec .= $ver if $ver; |
190 | $fspec; |
191 | } |
192 | |
a5f75d66 |
193 | sub vmsify ($) { |
748a9306 |
194 | my($fspec) = @_; |
195 | my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs); |
196 | |
197 | if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; } |
198 | return $fspec if $fspec !~ m#/#; |
199 | ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#; |
200 | @dirs = split(m#/#,$dir); |
201 | if ($base eq '.') { $base = ''; } |
202 | elsif ($base eq '..') { |
203 | push @dirs,$base; |
204 | $base = ''; |
205 | } |
206 | foreach (@dirs) { |
207 | next unless $_; # protect against // in input |
208 | next if $_ eq '.'; |
209 | if ($_ eq '..') { |
210 | if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs } |
211 | else { push @realdirs, '-' } |
212 | } |
213 | else { push @realdirs, $_; } |
214 | } |
215 | if ($hasdev) { |
216 | $dev = shift @realdirs; |
217 | @realdirs = ('000000') unless @realdirs; |
218 | $base = '' unless $base; # keep -w happy |
219 | $dev . ':[' . join('.',@realdirs) . "]$base"; |
220 | } |
221 | else { |
222 | '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base"; |
223 | } |
224 | } |
225 | |
a5f75d66 |
226 | sub unixify ($) { |
748a9306 |
227 | my($fspec) = @_; |
228 | |
229 | return $fspec if $fspec !~ m#[:>\]]#; |
230 | return '.' if ($fspec eq '[]' || $fspec eq '<>'); |
231 | if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) { |
232 | $fspec = ($1 eq '.' ? '' : "$1.") . $2; |
233 | my($dir,$base) = split(/[\]>]/,$fspec); |
234 | my(@dirs) = grep($_,split(m#\.#,$dir)); |
235 | if ($dirs[0] =~ /^-/) { |
236 | my($steps) = shift @dirs; |
237 | for (1..length($steps)) { unshift @dirs, '..'; } |
238 | } |
239 | join('/',@dirs) . "/$base"; |
240 | } |
241 | else { |
242 | $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]'); |
243 | $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//; |
244 | my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#; |
245 | my(@dirs) = split(m#\.#,$dir); |
246 | if ($dirs[0] && $dirs[0] =~ /^-/) { |
247 | my($steps) = shift @dirs; |
248 | for (1..length($steps)) { unshift @dirs, '..'; } |
249 | } |
250 | "/$dev/" . join('/',@dirs) . "/$base"; |
251 | } |
252 | } |
253 | |
254 | |
a5f75d66 |
255 | sub fileify ($) { |
748a9306 |
256 | my($path) = @_; |
257 | |
258 | if (!$path) { return undef } |
259 | if ($path =~ /(.+)\.([^:>\]]*)$/) { |
260 | $path = $1; |
261 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } |
262 | } |
263 | |
264 | if ($path !~ m#[/>\]]#) { |
265 | $path =~ s/:$//; |
266 | while ($ENV{$path}) { |
267 | ($path = $ENV{$path}) =~ s/:$//; |
268 | last if $path =~ m#[/>\]]#; |
269 | } |
270 | } |
271 | if ($path =~ m#[>\]]#) { |
272 | my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/; |
273 | $sep =~ tr/<[/>]/; |
274 | if ($base) { |
275 | "$dir$sep$base.dir;1"; |
276 | } |
277 | else { |
278 | if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; } |
279 | $dir =~ s#\.(\w+)$#$sep$1#; |
280 | $dir =~ s/^.$sep//; |
281 | "$dir.dir;1"; |
282 | } |
283 | } |
284 | else { |
285 | $path =~ s#/$##; |
286 | "$path.dir;1"; |
287 | } |
288 | } |
289 | |
a5f75d66 |
290 | sub pathify ($) { |
748a9306 |
291 | my($fspec) = @_; |
292 | |
293 | if (!$fspec) { return undef } |
294 | if ($fspec =~ m#[/>\]]$#) { return $fspec; } |
295 | if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') { |
296 | $fspec = $1; |
297 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } |
298 | } |
299 | |
300 | if ($fspec !~ m#[/>\]]#) { |
301 | $fspec =~ s/:$//; |
302 | while ($ENV{$fspec}) { |
303 | if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} } |
304 | else { $fspec = $ENV{$fspec} =~ s/:$// } |
305 | } |
306 | } |
307 | |
308 | if ($fspec !~ m#[>\]]#) { "$fspec/"; } |
309 | else { |
310 | if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; } |
311 | else { $fspec; } |
312 | } |
313 | } |
314 | |
a5f75d66 |
315 | sub vmspath ($) { |
748a9306 |
316 | pathify(vmsify($_[0])); |
317 | } |
318 | |
a5f75d66 |
319 | sub unixpath ($) { |
748a9306 |
320 | pathify(unixify($_[0])); |
321 | } |
322 | |
a5f75d66 |
323 | sub candelete ($) { |
748a9306 |
324 | my($fspec) = @_; |
325 | my($parent); |
326 | |
327 | return '' unless -w $fspec; |
328 | $fspec =~ s#/$##; |
329 | if ($fspec =~ m#/#) { |
330 | ($parent = $fspec) =~ s#/[^/]+$#; |
331 | return (-w $parent); |
332 | } |
333 | elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms |
334 | $parent =~ s/[>\]][^>\]]+//; |
335 | return (-w fileify($parent)); |
336 | } |
337 | else { return (-w '[-]'); } |
338 | } |