File Coverage

blib/lib/File/Spec/VMS.pm
Criterion Covered Total %
statement 118 206 57.2
branch 41 122 33.6
condition 15 71 21.1
subroutine 16 22 72.7
pod 16 16 100.0
total 206 437 47.1


line stmt bran cond sub pod time code
1             package File::Spec::VMS;
2              
3 2     2   2142 use strict;
  2         5  
  2         77  
4 2     2   11 use Cwd ();
  2         3  
  2         134  
5             require File::Spec::Unix;
6              
7             our $VERSION = '3.75';
8             $VERSION =~ tr/_//d;
9              
10             our @ISA = qw(File::Spec::Unix);
11              
12 2     2   16 use File::Basename;
  2         3  
  2         202  
13 2     2   304 use VMS::Filespec;
  1         2  
  1         105  
14              
15             =head1 NAME
16              
17             File::Spec::VMS - methods for VMS file specs
18              
19             =head1 SYNOPSIS
20              
21             require File::Spec::VMS; # Done internally by File::Spec if needed
22              
23             =head1 DESCRIPTION
24              
25             See File::Spec::Unix for a documentation of the methods provided
26             there. This package overrides the implementation of these methods, not
27             the semantics.
28              
29             The default behavior is to allow either VMS or Unix syntax on input and to
30             return VMS syntax on output unless Unix syntax has been explicitly requested
31             via the C CRTL feature.
32              
33             =over 4
34              
35             =cut
36              
37             # Need to look up the feature settings. The preferred way is to use the
38             # VMS::Feature module, but that may not be available to dual life modules.
39              
40             my $use_feature;
41             BEGIN {
42 1 50   1   3 if (eval { local $SIG{__DIE__};
  1         5  
43 1         5 local @INC = @INC;
44 1 50       4 pop @INC if $INC[-1] eq '.';
45 1         3858 require VMS::Feature; }) {
46 0         0 $use_feature = 1;
47             }
48             }
49              
50             # Need to look up the UNIX report mode. This may become a dynamic mode
51             # in the future.
52             sub _unix_rpt {
53 131     131   164 my $unix_rpt;
54 131 50       229 if ($use_feature) {
55 0         0 $unix_rpt = VMS::Feature::current("filename_unix_report");
56             } else {
57 131   50     415 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
58 131         208 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
59             }
60 131         253 return $unix_rpt;
61             }
62              
63             =item canonpath (override)
64              
65             Removes redundant portions of file specifications and returns results
66             in native syntax unless Unix filename reporting has been enabled.
67              
68             =cut
69              
70              
71             sub canonpath {
72 91     91 1 23437 my($self,$path) = @_;
73              
74 91 50       199 return undef unless defined $path;
75              
76 91         206 my $unix_rpt = $self->_unix_rpt;
77              
78 91 100       253 if ($path =~ m|/|) {
79 1         9 my $pathify = $path =~ m|/\Z(?!\n)|;
80 1         19 $path = $self->SUPER::canonpath($path);
81              
82 1 50       4 return $path if $unix_rpt;
83 1 50       21 $path = $pathify ? vmspath($path) : vmsify($path);
84             }
85              
86 90         143 $path =~ s/(? ==> [ and ]
87 90         123 $path =~ s/(?/]/;
88 90         128 $path =~ s/(? .][
89 90         165 $path =~ s/(? [
90 90         153 $path =~ s/(? [
91 90         113 $path =~ s/(? ]
92 90         131 $path =~ s/(? foo.bar
93 90         189 1 while ($path =~ s/(?
94             # That loop does the following
95             # with any amount of dashes:
96             # .-.-. ==> .--.
97             # [-.-. ==> [--.
98             # .-.-] ==> .--]
99             # [-.-] ==> [--]
100 90         318 1 while ($path =~ s/(?
101             # That loop does the following
102             # with any amount (minimum 2)
103             # of dashes:
104             # .foo.--. ==> .-.
105             # .foo.--] ==> .-]
106             # [foo.--. ==> [-.
107             # [foo.--] ==> [-]
108             #
109             # And then, the remaining cases
110 90         140 $path =~ s/(? [-
111 90         156 $path =~ s/(? .
112 90         155 $path =~ s/(? [
113 90         189 $path =~ s/(? ]