This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Debugging REx with lookbehind
[perl5.git] / lib / File / Spec / VMS.pm
CommitLineData
270d1e39
GS
1
2package File::Spec::VMS;
3
4use Carp qw( &carp );
5use Config;
6require Exporter;
7use VMS::Filespec;
8use File::Basename;
9
10use File::Spec;
11use vars qw($Revision);
12$Revision = '5.3901 (6-Mar-1997)';
13
14@ISA = qw(File::Spec::Unix);
15
16Exporter::import('File::Spec', '$Verbose');
17
18=head1 NAME
19
20File::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
28See File::Spec::Unix for a documentation of the methods provided
29there. This package overrides the implementation of these methods, not
30the semantics.
31
32=head2 Methods always loaded
33
34=over
35
36=item catdir
37
38Concatenates a list of file specifications, and returns the result as a
39VMS-syntax directory specification.
40
41=cut
42
43sub 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
65Concatenates a list of file specifications, and returns the result as a
66VMS-syntax directory specification.
67
68=cut
69
70sub 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
92Returns a string representing of the current directory.
93
94=cut
95
96sub curdir {
97 return '[]';
98}
99
100=item rootdir (override)
101
102Returns a string representing of the root directory.
103
104=cut
105
106sub rootdir {
107 return '';
108}
109
110=item updir (override)
111
112Returns a string representing of the parent directory.
113
114=cut
115
116sub updir {
117 return '[-]';
118}
119
120=item path (override)
121
122Translate logical name DCL$PATH as a searchlist, rather than trying
123to C<split> string value of C<$ENV{'PATH'}>.
124
125=cut
126
127sub path {
128 my(@dirs,$dir,$i);
129 while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
130 @dirs;
131}
132
133=item file_name_is_absolute (override)
134
135Checks for VMS directory spec as well as Unix separators.
136
137=cut
138
139sub file_name_is_absolute {
140 my($self,$file) = @_;
141 # If it's a logical name, expand it.
142 $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
143 $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
144}
145
1461;
147__END__
148