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
|
package Module::Build::Platform::VMS;
use strict;
use Module::Build::Base;
use vars qw(@ISA);
@ISA = qw(Module::Build::Base);
=head1 NAME
Module::Build::Platform::VMS - Builder class for VMS platforms
=head1 DESCRIPTION
This module inherits from C<Module::Build::Base> and alters a few
minor details of its functionality. Please see L<Module::Build> for
the general docs.
=head2 Overridden Methods
=over 4
=item new
Change $self->{build_script} to 'Build.com' so @Build works.
=cut
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{properties}{build_script} = 'Build.com';
return $self;
}
=item cull_args
'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
people to write '@Build "foo"' we'll dispatch case-insensitively.
=cut
sub cull_args {
my $self = shift;
my($action, $args) = $self->SUPER::cull_args(@_);
my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
die "Ambiguous action '$action'. Could be one of @possible_actions"
if @possible_actions > 1;
return ($possible_actions[0], $args);
}
=item manpage_separator
Use '__' instead of '::'.
=cut
sub manpage_separator {
return '__';
}
=item prefixify
Prefixify taking into account VMS' filepath syntax.
=cut
# Translated from ExtUtils::MM_VMS::prefixify()
sub _prefixify {
my($self, $path, $sprefix, $type) = @_;
my $rprefix = $self->prefix;
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
# Translate $(PERLPREFIX) to a real path.
$rprefix = $self->eliminate_macros($rprefix);
$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
$self->log_verbose(" rprefix translated to $rprefix\n".
" sprefix translated to $sprefix\n");
if( length $path == 0 ) {
$self->log_verbose(" no path to prefixify.\n")
}
elsif( !File::Spec->file_name_is_absolute($path) ) {
$self->log_verbose(" path is relative, not prefixifying.\n");
}
elsif( $sprefix eq $rprefix ) {
$self->log_verbose(" no new prefix.\n");
}
else {
my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
my $vms_prefix = $self->config->{vms_prefix};
if( $path_vol eq $vms_prefix.':' ) {
$self->log_verbose(" $vms_prefix: seen\n");
$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
$path = $self->_catprefix($rprefix, $path_dirs);
}
else {
$self->log_verbose(" cannot prefixify.\n");
return $self->prefix_relpaths($self->installdirs, $type);
}
}
$self->log_verbose(" now $path\n");
return $path;
}
=back
=head1 AUTHOR
Michael G Schwern <schwern@pobox.com>, Ken Williams <ken@cpan.org>
=head1 SEE ALSO
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
=cut
1;
__END__
|
