This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
MakeMaker support for pod2html
[perl5.git] / lib / File / Spec / VMS.pm
CommitLineData
270d1e39
GS
1package File::Spec::VMS;
2
cbc7acb0
JD
3use strict;
4use vars qw(@ISA);
5require File::Spec::Unix;
270d1e39
GS
6@ISA = qw(File::Spec::Unix);
7
cbc7acb0
JD
8use File::Basename;
9use VMS::Filespec;
270d1e39
GS
10
11=head1 NAME
12
13File::Spec::VMS - methods for VMS file specs
14
15=head1 SYNOPSIS
16
cbc7acb0 17 require File::Spec::VMS; # Done internally by File::Spec if needed
270d1e39
GS
18
19=head1 DESCRIPTION
20
21See File::Spec::Unix for a documentation of the methods provided
22there. This package overrides the implementation of these methods, not
23the semantics.
24
25=head2 Methods always loaded
26
27=over
28
29=item catdir
30
31Concatenates a list of file specifications, and returns the result as a
32VMS-syntax directory specification.
33
34=cut
35
36sub catdir {
cbc7acb0
JD
37 my ($self,@dirs) = @_;
38 my $dir = pop @dirs;
270d1e39 39 @dirs = grep($_,@dirs);
cbc7acb0 40 my $rslt;
270d1e39 41 if (@dirs) {
cbc7acb0
JD
42 my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
43 my ($spath,$sdir) = ($path,$dir);
44 $spath =~ s/.dir$//; $sdir =~ s/.dir$//;
45 $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
46 $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
270d1e39 47 }
cbc7acb0
JD
48 else {
49 if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
50 else { $rslt = vmspath($dir); }
270d1e39 51 }
cbc7acb0 52 return $rslt;
270d1e39
GS
53}
54
55=item catfile
56
57Concatenates a list of file specifications, and returns the result as a
58VMS-syntax directory specification.
59
60=cut
61
62sub catfile {
cbc7acb0
JD
63 my ($self,@files) = @_;
64 my $file = pop @files;
270d1e39 65 @files = grep($_,@files);
cbc7acb0 66 my $rslt;
270d1e39 67 if (@files) {
cbc7acb0
JD
68 my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
69 my $spath = $path;
70 $spath =~ s/.dir$//;
71 if ($spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) {
72 $rslt = "$spath$file";
73 }
74 else {
75 $rslt = $self->eliminate_macros($spath);
76 $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
77 }
270d1e39
GS
78 }
79 else { $rslt = vmsify($file); }
cbc7acb0 80 return $rslt;
270d1e39
GS
81}
82
83=item curdir (override)
84
cbc7acb0 85Returns a string representation of the current directory: '[]'
270d1e39
GS
86
87=cut
88
89sub curdir {
90 return '[]';
91}
92
99804bbb
GS
93=item devnull (override)
94
cbc7acb0 95Returns a string representation of the null device: '_NLA0:'
99804bbb
GS
96
97=cut
98
99sub devnull {
cbc7acb0 100 return "_NLA0:";
99804bbb
GS
101}
102
270d1e39
GS
103=item rootdir (override)
104
cbc7acb0 105Returns a string representation of the root directory: 'SYS$DISK:[000000]'
270d1e39
GS
106
107=cut
108
109sub rootdir {
cbc7acb0
JD
110 return 'SYS$DISK:[000000]';
111}
112
113=item tmpdir (override)
114
115Returns a string representation of the first writable directory
116from the following list or '' if none are writable:
117
118 /sys$scratch
119 $ENV{TMPDIR}
120
121=cut
122
123my $tmpdir;
124sub tmpdir {
125 return $tmpdir if defined $tmpdir;
126 foreach ('/sys$scratch', $ENV{TMPDIR}) {
127 next unless defined && -d && -w _;
128 $tmpdir = $_;
129 last;
130 }
131 $tmpdir = '' unless defined $tmpdir;
132 return $tmpdir;
270d1e39
GS
133}
134
135=item updir (override)
136
cbc7acb0 137Returns a string representation of the parent directory: '[-]'
270d1e39
GS
138
139=cut
140
141sub updir {
142 return '[-]';
143}
144
145=item path (override)
146
147Translate logical name DCL$PATH as a searchlist, rather than trying
148to C<split> string value of C<$ENV{'PATH'}>.
149
150=cut
151
152sub path {
cbc7acb0 153 my (@dirs,$dir,$i);
270d1e39 154 while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
cbc7acb0 155 return @dirs;
270d1e39
GS
156}
157
158=item file_name_is_absolute (override)
159
160Checks for VMS directory spec as well as Unix separators.
161
162=cut
163
164sub file_name_is_absolute {
cbc7acb0 165 my ($self,$file) = @_;
270d1e39 166 # If it's a logical name, expand it.
cbc7acb0
JD
167 $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file};
168 return scalar($file =~ m!^/! ||
169 $file =~ m![<\[][^.\-\]>]! ||
170 $file =~ /:[^<\[]/);
270d1e39
GS
171}
172
cbc7acb0 173=back
270d1e39 174
cbc7acb0
JD
175=head1 SEE ALSO
176
177L<File::Spec>
178
179=cut
180
1811;