This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re-order struct yy_parser to save space on most systems.
[perl5.git] / lib / Module / Build / Platform / VMS.pm
CommitLineData
bb4e9162
YST
1package Module::Build::Platform::VMS;
2
3use strict;
4use Module::Build::Base;
5
6use vars qw(@ISA);
7@ISA = qw(Module::Build::Base);
8
9
10
11=head1 NAME
12
13Module::Build::Platform::VMS - Builder class for VMS platforms
14
15=head1 DESCRIPTION
16
17This module inherits from C<Module::Build::Base> and alters a few
18minor details of its functionality. Please see L<Module::Build> for
19the general docs.
20
21=head2 Overridden Methods
22
23=over 4
24
77e96e88 25=item _set_defaults
bb4e9162
YST
26
27Change $self->{build_script} to 'Build.com' so @Build works.
28
29=cut
30
77e96e88
RGS
31sub _set_defaults {
32 my $self = shift;
33 $self->SUPER::_set_defaults(@_);
bb4e9162
YST
34
35 $self->{properties}{build_script} = 'Build.com';
bb4e9162
YST
36}
37
38
39=item cull_args
40
41'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
42people to write '@Build "foo"' we'll dispatch case-insensitively.
43
44=cut
45
46sub cull_args {
47 my $self = shift;
48 my($action, $args) = $self->SUPER::cull_args(@_);
49 my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
50
51 die "Ambiguous action '$action'. Could be one of @possible_actions"
52 if @possible_actions > 1;
53
54 return ($possible_actions[0], $args);
55}
56
57
58=item manpage_separator
59
60Use '__' instead of '::'.
61
62=cut
63
64sub manpage_separator {
65 return '__';
66}
67
68
69=item prefixify
70
71Prefixify taking into account VMS' filepath syntax.
72
73=cut
74
75# Translated from ExtUtils::MM_VMS::prefixify()
76sub _prefixify {
77 my($self, $path, $sprefix, $type) = @_;
78 my $rprefix = $self->prefix;
79
80 $self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
81
82 # Translate $(PERLPREFIX) to a real path.
83 $rprefix = $self->eliminate_macros($rprefix);
84 $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
85 $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
86
87 $self->log_verbose(" rprefix translated to $rprefix\n".
88 " sprefix translated to $sprefix\n");
89
90 if( length $path == 0 ) {
91 $self->log_verbose(" no path to prefixify.\n")
92 }
93 elsif( !File::Spec->file_name_is_absolute($path) ) {
94 $self->log_verbose(" path is relative, not prefixifying.\n");
95 }
96 elsif( $sprefix eq $rprefix ) {
97 $self->log_verbose(" no new prefix.\n");
98 }
99 else {
100 my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
77e96e88 101 my $vms_prefix = $self->config('vms_prefix');
bb4e9162
YST
102 if( $path_vol eq $vms_prefix.':' ) {
103 $self->log_verbose(" $vms_prefix: seen\n");
104
105 $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
106 $path = $self->_catprefix($rprefix, $path_dirs);
107 }
108 else {
109 $self->log_verbose(" cannot prefixify.\n");
110 return $self->prefix_relpaths($self->installdirs, $type);
111 }
112 }
113
114 $self->log_verbose(" now $path\n");
115
116 return $path;
117}
118
77e96e88
RGS
119=item _quote_args
120
121Command-line arguments (but not the command itself) must be quoted
122to ensure case preservation.
123
124=cut
bb4e9162 125
a314697d
RS
126sub _quote_args {
127 # Returns a string that can become [part of] a command line with
77e96e88
RGS
128 # proper quoting so that the subprocess sees this same list of args,
129 # or if we get a single arg that is an array reference, quote the
130 # elements of it and return the reference.
a314697d 131 my ($self, @args) = @_;
77e96e88
RGS
132 my $got_arrayref = (scalar(@args) == 1
133 && UNIVERSAL::isa($args[0], 'ARRAY'))
134 ? 1
135 : 0;
136
137 map { $_ = q(").$_.q(") if !/^\"/ && length($_) > 0 }
138 ($got_arrayref ? @{$args[0]}
139 : @args
140 );
141
142 return $got_arrayref ? $args[0]
143 : join(' ', @args);
a314697d
RS
144}
145
77e96e88
RGS
146=item have_forkpipe
147
148There is no native fork(), so some constructs depending on it are not
149available.
150
151=cut
152
dc8021d3 153sub have_forkpipe { 0 }
a314697d 154
77e96e88
RGS
155=item _backticks
156
157Override to ensure that we quote the arguments but not the command.
158
159=cut
160
161sub _backticks {
162 # The command must not be quoted but the arguments to it must be.
163 my ($self, @cmd) = @_;
164 my $cmd = shift @cmd;
165 my $args = $self->_quote_args(@cmd);
166 return `$cmd $args`;
167}
168
169=item do_system
170
171Override to ensure that we quote the arguments but not the command.
172
173=cut
174
175sub do_system {
176 # The command must not be quoted but the arguments to it must be.
177 my ($self, @cmd) = @_;
178 $self->log_info("@cmd\n");
179 my $cmd = shift @cmd;
180 my $args = $self->_quote_args(@cmd);
181 return !system("$cmd $args");
182}
183
184=item _infer_xs_spec
185
186Inherit the standard version but tweak the library file name to be
187something Dynaloader can find.
188
189=cut
190
191sub _infer_xs_spec {
192 my $self = shift;
193 my $file = shift;
194
195 my $spec = $self->SUPER::_infer_xs_spec($file);
196
197 # Need to create with the same name as DynaLoader will load with.
198 if (defined &DynaLoader::mod2fname) {
199 my $file = DynaLoader::mod2fname([$$spec{base_name}]);
d9103e67
CB
200 $file .= '.' . $self->{config}->get('dlext');
201 $$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
77e96e88
RGS
202 }
203
204 return $spec;
205}
206
d9103e67
CB
207=item rscan_dir
208
209Inherit the standard version but remove dots at end of name. This may not be
210necessary if File::Find has been fixed or DECC$FILENAME_UNIX_REPORT is in effect.
211
212=cut
213
214sub rscan_dir {
215 my ($self, $dir, $pattern) = @_;
216
217 my $result = $self->SUPER::rscan_dir( $dir, $pattern );
218
219 for my $file (@$result) { $file =~ s/\.$//; }
220 return $result;
221}
222
223
bb4e9162
YST
224=back
225
226=head1 AUTHOR
227
77e96e88 228Michael G Schwern <schwern@pobox.com>, Ken Williams <kwilliams@cpan.org>
bb4e9162
YST
229
230=head1 SEE ALSO
231
232perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
233
234=cut
235
2361;
237__END__