Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

GSAR / perl5.005_02 / lib / File / Spec / VMS.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
—
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
—
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
—
89
90
91
92
93
94
95
96
97
98
—
99
100
101
102
103
104
105
106
107
108
—
109
110
111
112
113
114
115
116
117
118
—
119
120
121
122
123
124
125
126
127
128
129
130
131
—
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

              
package File::Spec::VMS;
use Carp qw( &carp );
use Config;
require Exporter;
use VMS::Filespec;
use File::Basename;
use File::Spec;
use vars qw($Revision);
$Revision = '5.3901 (6-Mar-1997)';
@ISA = qw(File::Spec::Unix);
Exporter::import('File::Spec', '$Verbose');
=head1 NAME
File::Spec::VMS - methods for VMS file specs
=head1 SYNOPSIS
 use File::Spec::VMS; # Done internally by File::Spec if needed
=head1 DESCRIPTION
See File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
=head2 Methods always loaded
=over
=item catdir
Concatenates a list of file specifications, and returns the result as a
VMS-syntax directory specification.
=cut
sub catdir {
    my($self,@dirs) = @_;
    my($dir) = pop @dirs;
    @dirs = grep($_,@dirs);
    my($rslt);
    if (@dirs) {
      my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
      my($spath,$sdir) = ($path,$dir);
      $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
      $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
      $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
    }
    else { 
      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
      else                          { $rslt = vmspath($dir); }
    }
    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
    $rslt;
}
=item catfile
Concatenates a list of file specifications, and returns the result as a
VMS-syntax directory specification.
=cut
sub catfile {
    my($self,@files) = @_;
    my($file) = pop @files;
    @files = grep($_,@files);
    my($rslt);
    if (@files) {
      my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
      my($spath) = $path;
      $spath =~ s/.dir$//;
      if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
      else {
          $rslt = $self->eliminate_macros($spath);
          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
      }
    }
    else { $rslt = vmsify($file); }
    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
    $rslt;
}
=item curdir (override)
Returns a string representing of the current directory.
=cut
sub curdir {
    return '[]';
}
=item rootdir (override)
Returns a string representing of the root directory.
=cut
sub rootdir {
    return '';
}
=item updir (override)
Returns a string representing of the parent directory.
=cut
sub updir {
    return '[-]';
}
=item path (override)
Translate logical name DCL$PATH as a searchlist, rather than trying
to C<split> string value of C<$ENV{'PATH'}>.
=cut
sub path {
    my(@dirs,$dir,$i);
    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
    @dirs;
}
=item file_name_is_absolute (override)
Checks for VMS directory spec as well as Unix separators.
=cut
sub file_name_is_absolute {
    my($self,$file) = @_;
    # If it's a logical name, expand it.
    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
}
1;
__END__