Commit | Line | Data |
270d1e39 |
1 | |
2 | package File::Spec::VMS; |
3 | |
4 | use Carp qw( &carp ); |
5 | use Config; |
6 | require Exporter; |
7 | use VMS::Filespec; |
8 | use File::Basename; |
9 | |
10 | use File::Spec; |
11 | use vars qw($Revision); |
12 | $Revision = '5.3901 (6-Mar-1997)'; |
13 | |
14 | @ISA = qw(File::Spec::Unix); |
15 | |
16 | Exporter::import('File::Spec', '$Verbose'); |
17 | |
18 | =head1 NAME |
19 | |
20 | File::Spec::VMS - methods for VMS file specs |
21 | |
22 | =head1 SYNOPSIS |
23 | |
24 | use File::Spec::VMS; # Done internally by File::Spec if needed |
25 | |
26 | =head1 DESCRIPTION |
27 | |
28 | See File::Spec::Unix for a documentation of the methods provided |
29 | there. This package overrides the implementation of these methods, not |
30 | the semantics. |
31 | |
32 | =head2 Methods always loaded |
33 | |
34 | =over |
35 | |
36 | =item catdir |
37 | |
38 | Concatenates a list of file specifications, and returns the result as a |
39 | VMS-syntax directory specification. |
40 | |
41 | =cut |
42 | |
43 | sub catdir { |
44 | my($self,@dirs) = @_; |
45 | my($dir) = pop @dirs; |
46 | @dirs = grep($_,@dirs); |
47 | my($rslt); |
48 | if (@dirs) { |
49 | my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); |
50 | my($spath,$sdir) = ($path,$dir); |
51 | $spath =~ s/.dir$//; $sdir =~ s/.dir$//; |
52 | $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/; |
53 | $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); |
54 | } |
55 | else { |
56 | if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; } |
57 | else { $rslt = vmspath($dir); } |
58 | } |
59 | print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; |
60 | $rslt; |
61 | } |
62 | |
63 | =item catfile |
64 | |
65 | Concatenates a list of file specifications, and returns the result as a |
66 | VMS-syntax directory specification. |
67 | |
68 | =cut |
69 | |
70 | sub catfile { |
71 | my($self,@files) = @_; |
72 | my($file) = pop @files; |
73 | @files = grep($_,@files); |
74 | my($rslt); |
75 | if (@files) { |
76 | my($path) = (@files == 1 ? $files[0] : $self->catdir(@files)); |
77 | my($spath) = $path; |
78 | $spath =~ s/.dir$//; |
79 | if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; } |
80 | else { |
81 | $rslt = $self->eliminate_macros($spath); |
82 | $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file)); |
83 | } |
84 | } |
85 | else { $rslt = vmsify($file); } |
86 | print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3; |
87 | $rslt; |
88 | } |
89 | |
90 | =item curdir (override) |
91 | |
92 | Returns a string representing of the current directory. |
93 | |
94 | =cut |
95 | |
96 | sub curdir { |
97 | return '[]'; |
98 | } |
99 | |
99804bbb |
100 | =item devnull (override) |
101 | |
102 | Returns a string representing the null device. |
103 | |
104 | =cut |
105 | |
106 | sub devnull { |
107 | return 'NL:'; |
108 | } |
109 | |
270d1e39 |
110 | =item rootdir (override) |
111 | |
112 | Returns a string representing of the root directory. |
113 | |
114 | =cut |
115 | |
116 | sub rootdir { |
117 | return ''; |
118 | } |
119 | |
120 | =item updir (override) |
121 | |
122 | Returns a string representing of the parent directory. |
123 | |
124 | =cut |
125 | |
126 | sub updir { |
127 | return '[-]'; |
128 | } |
129 | |
130 | =item path (override) |
131 | |
132 | Translate logical name DCL$PATH as a searchlist, rather than trying |
133 | to C<split> string value of C<$ENV{'PATH'}>. |
134 | |
135 | =cut |
136 | |
137 | sub path { |
138 | my(@dirs,$dir,$i); |
139 | while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); } |
140 | @dirs; |
141 | } |
142 | |
143 | =item file_name_is_absolute (override) |
144 | |
145 | Checks for VMS directory spec as well as Unix separators. |
146 | |
147 | =cut |
148 | |
149 | sub file_name_is_absolute { |
150 | my($self,$file) = @_; |
151 | # If it's a logical name, expand it. |
152 | $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file}; |
153 | $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/; |
154 | } |
155 | |
156 | 1; |
157 | __END__ |
158 | |