The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

UXYZAB / DBD-Mock-Session-GenerateFixtures-0.10 / local / lib / perl5 / ExtUtils / Helpers / 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

              
package ExtUtils::Helpers::VMS;
$ExtUtils::Helpers::VMS::VERSION = '0.028';
use strict;
use warnings FATAL => 'all';
use Exporter 5.57 'import';
our @EXPORT = qw/make_executable split_like_shell detildefy/;
use ExtUtils::Helpers::Unix qw/split_like_shell/; # Probably very wrong, but whatever
use File::Copy qw/copy/;
sub make_executable {
        my $filename = shift;
        my $batchname = "$filename.com";
        copy($filename, $batchname);
        ExtUtils::Helpers::Unix::make_executable($batchname);
        return;
}
sub detildefy {
        my $arg = shift;
        # Apparently double ~ are not translated.
        return $arg if ($arg =~ /^~~/);
        # Apparently ~ followed by whitespace are not translated.
        return $arg if ($arg =~ /^~ /);
        if ($arg =~ /^~/) {
                my $spec = $arg;
                # Remove the tilde
                $spec =~ s/^~//;
                # Remove any slash following the tilde if present.
                $spec =~ s#^/##;
                # break up the paths for the merge
                my $home = VMS::Filespec::unixify($ENV{HOME});
                # In the default VMS mode, the trailing slash is present.
                # In Unix report mode it is not.  The parsing logic assumes that
                # it is present.
                $home .= '/' unless $home =~ m#/$#;
                # Trivial case of just ~ by it self
                if ($spec eq '') {
                        $home =~ s#/$##;
                        return $home;
                }
                my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
                if ($hdir eq '') {
                         # Someone has tampered with $ENV{HOME}
                         # So hfile is probably the directory since this should be
                         # a path.
                         $hdir = $hfile;
                }
                my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
                my @hdirs = File::Spec::Unix->splitdir($hdir);
                my @dirs = File::Spec::Unix->splitdir($dir);
                unless ($arg =~ m#^~/#) {
                        # There is a home directory after the tilde, but it will already
                        # be present in in @hdirs so we need to remove it by from @dirs.
                        shift @dirs;
                }
                my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
                $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
        }
        return $arg;
}
# ABSTRACT: VMS specific helper bits
__END__
=pod
=encoding UTF-8
=head1 NAME
ExtUtils::Helpers::VMS - VMS specific helper bits
=head1 VERSION
version 0.028
=for Pod::Coverage make_executable
detildefy
=head1 AUTHORS
=over 4
=item *
Ken Williams <kwilliams@cpan.org>
=item *
Leon Timmermans <leont@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut