1 | package ExtUtils::MM_VMS;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | use ExtUtils::MakeMaker::Config;
|
---|
6 | require Exporter;
|
---|
7 |
|
---|
8 | BEGIN {
|
---|
9 | # so we can compile the thing on non-VMS platforms.
|
---|
10 | if( $^O eq 'VMS' ) {
|
---|
11 | require VMS::Filespec;
|
---|
12 | VMS::Filespec->import;
|
---|
13 | }
|
---|
14 | }
|
---|
15 |
|
---|
16 | use File::Basename;
|
---|
17 |
|
---|
18 | # $Revision can't be on the same line or SVN/K gets confused
|
---|
19 | use vars qw($Revision
|
---|
20 | $VERSION @ISA);
|
---|
21 | $VERSION = '5.73';
|
---|
22 |
|
---|
23 | require ExtUtils::MM_Any;
|
---|
24 | require ExtUtils::MM_Unix;
|
---|
25 | @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
|
---|
26 |
|
---|
27 | use ExtUtils::MakeMaker qw($Verbose neatvalue);
|
---|
28 | $Revision = $ExtUtils::MakeMaker::Revision;
|
---|
29 |
|
---|
30 |
|
---|
31 | =head1 NAME
|
---|
32 |
|
---|
33 | ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
|
---|
34 |
|
---|
35 | =head1 SYNOPSIS
|
---|
36 |
|
---|
37 | Do not use this directly.
|
---|
38 | Instead, use ExtUtils::MM and it will figure out which MM_*
|
---|
39 | class to use for you.
|
---|
40 |
|
---|
41 | =head1 DESCRIPTION
|
---|
42 |
|
---|
43 | See ExtUtils::MM_Unix for a documentation of the methods provided
|
---|
44 | there. This package overrides the implementation of these methods, not
|
---|
45 | the semantics.
|
---|
46 |
|
---|
47 | =head2 Methods always loaded
|
---|
48 |
|
---|
49 | =over 4
|
---|
50 |
|
---|
51 | =item wraplist
|
---|
52 |
|
---|
53 | Converts a list into a string wrapped at approximately 80 columns.
|
---|
54 |
|
---|
55 | =cut
|
---|
56 |
|
---|
57 | sub wraplist {
|
---|
58 | my($self) = shift;
|
---|
59 | my($line,$hlen) = ('',0);
|
---|
60 |
|
---|
61 | foreach my $word (@_) {
|
---|
62 | # Perl bug -- seems to occasionally insert extra elements when
|
---|
63 | # traversing array (scalar(@array) doesn't show them, but
|
---|
64 | # foreach(@array) does) (5.00307)
|
---|
65 | next unless $word =~ /\w/;
|
---|
66 | $line .= ' ' if length($line);
|
---|
67 | if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
|
---|
68 | $line .= $word;
|
---|
69 | $hlen += length($word) + 2;
|
---|
70 | }
|
---|
71 | $line;
|
---|
72 | }
|
---|
73 |
|
---|
74 |
|
---|
75 | # This isn't really an override. It's just here because ExtUtils::MM_VMS
|
---|
76 | # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext()
|
---|
77 | # in MM_VMS, then AUTOLOAD is called, and bad things happen. So, we just
|
---|
78 | # mimic inheritance here and hand off to ExtUtils::Liblist::Kid.
|
---|
79 | # XXX This hackery will die soon. --Schwern
|
---|
80 | sub ext {
|
---|
81 | require ExtUtils::Liblist::Kid;
|
---|
82 | goto &ExtUtils::Liblist::Kid::ext;
|
---|
83 | }
|
---|
84 |
|
---|
85 | =back
|
---|
86 |
|
---|
87 | =head2 Methods
|
---|
88 |
|
---|
89 | Those methods which override default MM_Unix methods are marked
|
---|
90 | "(override)", while methods unique to MM_VMS are marked "(specific)".
|
---|
91 | For overridden methods, documentation is limited to an explanation
|
---|
92 | of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
|
---|
93 | documentation for more details.
|
---|
94 |
|
---|
95 | =over 4
|
---|
96 |
|
---|
97 | =item guess_name (override)
|
---|
98 |
|
---|
99 | Try to determine name of extension being built. We begin with the name
|
---|
100 | of the current directory. Since VMS filenames are case-insensitive,
|
---|
101 | however, we look for a F<.pm> file whose name matches that of the current
|
---|
102 | directory (presumably the 'main' F<.pm> file for this extension), and try
|
---|
103 | to find a C<package> statement from which to obtain the Mixed::Case
|
---|
104 | package name.
|
---|
105 |
|
---|
106 | =cut
|
---|
107 |
|
---|
108 | sub guess_name {
|
---|
109 | my($self) = @_;
|
---|
110 | my($defname,$defpm,@pm,%xs,$pm);
|
---|
111 | local *PM;
|
---|
112 |
|
---|
113 | $defname = basename(fileify($ENV{'DEFAULT'}));
|
---|
114 | $defname =~ s![\d\-_]*\.dir.*$!!; # Clip off .dir;1 suffix, and package version
|
---|
115 | $defpm = $defname;
|
---|
116 | # Fallback in case for some reason a user has copied the files for an
|
---|
117 | # extension into a working directory whose name doesn't reflect the
|
---|
118 | # extension's name. We'll use the name of a unique .pm file, or the
|
---|
119 | # first .pm file with a matching .xs file.
|
---|
120 | if (not -e "${defpm}.pm") {
|
---|
121 | @pm = map { s/.pm$//; $_ } glob('*.pm');
|
---|
122 | if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
|
---|
123 | elsif (@pm) {
|
---|
124 | %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
|
---|
125 | if (keys %xs) {
|
---|
126 | foreach $pm (@pm) {
|
---|
127 | $defpm = $pm, last if exists $xs{$pm};
|
---|
128 | }
|
---|
129 | }
|
---|
130 | }
|
---|
131 | }
|
---|
132 | if (open(PM,"${defpm}.pm")){
|
---|
133 | while (<PM>) {
|
---|
134 | if (/^\s*package\s+([^;]+)/i) {
|
---|
135 | $defname = $1;
|
---|
136 | last;
|
---|
137 | }
|
---|
138 | }
|
---|
139 | print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
|
---|
140 | "defaulting package name to $defname\n"
|
---|
141 | if eof(PM);
|
---|
142 | close PM;
|
---|
143 | }
|
---|
144 | else {
|
---|
145 | print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
|
---|
146 | "defaulting package name to $defname\n";
|
---|
147 | }
|
---|
148 | $defname =~ s#[\d.\-_]+$##;
|
---|
149 | $defname;
|
---|
150 | }
|
---|
151 |
|
---|
152 | =item find_perl (override)
|
---|
153 |
|
---|
154 | Use VMS file specification syntax and CLI commands to find and
|
---|
155 | invoke Perl images.
|
---|
156 |
|
---|
157 | =cut
|
---|
158 |
|
---|
159 | sub find_perl {
|
---|
160 | my($self, $ver, $names, $dirs, $trace) = @_;
|
---|
161 | my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
|
---|
162 | my($rslt);
|
---|
163 | my($inabs) = 0;
|
---|
164 | local *TCF;
|
---|
165 |
|
---|
166 | if( $self->{PERL_CORE} ) {
|
---|
167 | # Check in relative directories first, so we pick up the current
|
---|
168 | # version of Perl if we're running MakeMaker as part of the main build.
|
---|
169 | @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
|
---|
170 | my($absb) = $self->file_name_is_absolute($b);
|
---|
171 | if ($absa && $absb) { return $a cmp $b }
|
---|
172 | else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
|
---|
173 | } @$dirs;
|
---|
174 | # Check miniperl before perl, and check names likely to contain
|
---|
175 | # version numbers before "generic" names, so we pick up an
|
---|
176 | # executable that's less likely to be from an old installation.
|
---|
177 | @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!; # basename
|
---|
178 | my($bb) = $b =~ m!([^:>\]/]+)$!;
|
---|
179 | my($ahasdir) = (length($a) - length($ba) > 0);
|
---|
180 | my($bhasdir) = (length($b) - length($bb) > 0);
|
---|
181 | if ($ahasdir and not $bhasdir) { return 1; }
|
---|
182 | elsif ($bhasdir and not $ahasdir) { return -1; }
|
---|
183 | else { $bb =~ /\d/ <=> $ba =~ /\d/
|
---|
184 | or substr($ba,0,1) cmp substr($bb,0,1)
|
---|
185 | or length($bb) <=> length($ba) } } @$names;
|
---|
186 | }
|
---|
187 | else {
|
---|
188 | @sdirs = @$dirs;
|
---|
189 | @snames = @$names;
|
---|
190 | }
|
---|
191 |
|
---|
192 | # Image names containing Perl version use '_' instead of '.' under VMS
|
---|
193 | foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
|
---|
194 | if ($trace >= 2){
|
---|
195 | print "Looking for perl $ver by these names:\n";
|
---|
196 | print "\t@snames,\n";
|
---|
197 | print "in these dirs:\n";
|
---|
198 | print "\t@sdirs\n";
|
---|
199 | }
|
---|
200 | foreach $dir (@sdirs){
|
---|
201 | next unless defined $dir; # $self->{PERL_SRC} may be undefined
|
---|
202 | $inabs++ if $self->file_name_is_absolute($dir);
|
---|
203 | if ($inabs == 1) {
|
---|
204 | # We've covered relative dirs; everything else is an absolute
|
---|
205 | # dir (probably an installed location). First, we'll try potential
|
---|
206 | # command names, to see whether we can avoid a long MCR expression.
|
---|
207 | foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
|
---|
208 | $inabs++; # Should happen above in next $dir, but just in case . . .
|
---|
209 | }
|
---|
210 | foreach $name (@snames){
|
---|
211 | if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
|
---|
212 | else { push(@cand,$self->fixpath($name,0)); }
|
---|
213 | }
|
---|
214 | }
|
---|
215 | foreach $name (@cand) {
|
---|
216 | print "Checking $name\n" if ($trace >= 2);
|
---|
217 | # If it looks like a potential command, try it without the MCR
|
---|
218 | if ($name =~ /^[\w\-\$]+$/) {
|
---|
219 | open(TCF,">temp_mmvms.com") || die('unable to open temp file');
|
---|
220 | print TCF "\$ set message/nofacil/nosever/noident/notext\n";
|
---|
221 | print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";
|
---|
222 | close TCF;
|
---|
223 | $rslt = `\@temp_mmvms.com` ;
|
---|
224 | unlink('temp_mmvms.com');
|
---|
225 | if ($rslt =~ /VER_OK/) {
|
---|
226 | print "Using PERL=$name\n" if $trace;
|
---|
227 | return $name;
|
---|
228 | }
|
---|
229 | }
|
---|
230 | next unless $vmsfile = $self->maybe_command($name);
|
---|
231 | $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well
|
---|
232 | print "Executing $vmsfile\n" if ($trace >= 2);
|
---|
233 | open(TCF,">temp_mmvms.com") || die('unable to open temp file');
|
---|
234 | print TCF "\$ set message/nofacil/nosever/noident/notext\n";
|
---|
235 | print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";
|
---|
236 | close TCF;
|
---|
237 | $rslt = `\@temp_mmvms.com`;
|
---|
238 | unlink('temp_mmvms.com');
|
---|
239 | if ($rslt =~ /VER_OK/) {
|
---|
240 | print "Using PERL=MCR $vmsfile\n" if $trace;
|
---|
241 | return "MCR $vmsfile";
|
---|
242 | }
|
---|
243 | }
|
---|
244 | print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
|
---|
245 | 0; # false and not empty
|
---|
246 | }
|
---|
247 |
|
---|
248 | =item maybe_command (override)
|
---|
249 |
|
---|
250 | Follows VMS naming conventions for executable files.
|
---|
251 | If the name passed in doesn't exactly match an executable file,
|
---|
252 | appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
|
---|
253 | to check for DCL procedure. If this fails, checks directories in DCL$PATH
|
---|
254 | and finally F<Sys$System:> for an executable file having the name specified,
|
---|
255 | with or without the F<.Exe>-equivalent suffix.
|
---|
256 |
|
---|
257 | =cut
|
---|
258 |
|
---|
259 | sub maybe_command {
|
---|
260 | my($self,$file) = @_;
|
---|
261 | return $file if -x $file && ! -d _;
|
---|
262 | my(@dirs) = ('');
|
---|
263 | my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
|
---|
264 | my($dir,$ext);
|
---|
265 | if ($file !~ m![/:>\]]!) {
|
---|
266 | for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
|
---|
267 | $dir = $ENV{"DCL\$PATH;$i"};
|
---|
268 | $dir .= ':' unless $dir =~ m%[\]:]$%;
|
---|
269 | push(@dirs,$dir);
|
---|
270 | }
|
---|
271 | push(@dirs,'Sys$System:');
|
---|
272 | foreach $dir (@dirs) {
|
---|
273 | my $sysfile = "$dir$file";
|
---|
274 | foreach $ext (@exts) {
|
---|
275 | return $file if -x "$sysfile$ext" && ! -d _;
|
---|
276 | }
|
---|
277 | }
|
---|
278 | }
|
---|
279 | return 0;
|
---|
280 | }
|
---|
281 |
|
---|
282 |
|
---|
283 | =item pasthru (override)
|
---|
284 |
|
---|
285 | VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
|
---|
286 | options. This is used in every invokation of make in the VMS Makefile so
|
---|
287 | PASTHRU should not be necessary. Using PASTHRU tends to blow commands past
|
---|
288 | the 256 character limit.
|
---|
289 |
|
---|
290 | =cut
|
---|
291 |
|
---|
292 | sub pasthru {
|
---|
293 | return "PASTHRU=\n";
|
---|
294 | }
|
---|
295 |
|
---|
296 |
|
---|
297 | =item pm_to_blib (override)
|
---|
298 |
|
---|
299 | VMS wants a dot in every file so we can't have one called 'pm_to_blib',
|
---|
300 | it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
|
---|
301 | you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
|
---|
302 |
|
---|
303 | So in VMS its pm_to_blib.ts.
|
---|
304 |
|
---|
305 | =cut
|
---|
306 |
|
---|
307 | sub pm_to_blib {
|
---|
308 | my $self = shift;
|
---|
309 |
|
---|
310 | my $make = $self->SUPER::pm_to_blib;
|
---|
311 |
|
---|
312 | $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
|
---|
313 | $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
|
---|
314 |
|
---|
315 | $make = <<'MAKE' . $make;
|
---|
316 | # Dummy target to match Unix target name; we use pm_to_blib.ts as
|
---|
317 | # timestamp file to avoid repeated invocations under VMS
|
---|
318 | pm_to_blib : pm_to_blib.ts
|
---|
319 | $(NOECHO) $(NOOP)
|
---|
320 |
|
---|
321 | MAKE
|
---|
322 |
|
---|
323 | return $make;
|
---|
324 | }
|
---|
325 |
|
---|
326 |
|
---|
327 | =item perl_script (override)
|
---|
328 |
|
---|
329 | If name passed in doesn't specify a readable file, appends F<.com> or
|
---|
330 | F<.pl> and tries again, since it's customary to have file types on all files
|
---|
331 | under VMS.
|
---|
332 |
|
---|
333 | =cut
|
---|
334 |
|
---|
335 | sub perl_script {
|
---|
336 | my($self,$file) = @_;
|
---|
337 | return $file if -r $file && ! -d _;
|
---|
338 | return "$file.com" if -r "$file.com";
|
---|
339 | return "$file.pl" if -r "$file.pl";
|
---|
340 | return '';
|
---|
341 | }
|
---|
342 |
|
---|
343 |
|
---|
344 | =item replace_manpage_separator
|
---|
345 |
|
---|
346 | Use as separator a character which is legal in a VMS-syntax file name.
|
---|
347 |
|
---|
348 | =cut
|
---|
349 |
|
---|
350 | sub replace_manpage_separator {
|
---|
351 | my($self,$man) = @_;
|
---|
352 | $man = unixify($man);
|
---|
353 | $man =~ s#/+#__#g;
|
---|
354 | $man;
|
---|
355 | }
|
---|
356 |
|
---|
357 | =item init_DEST
|
---|
358 |
|
---|
359 | (override) Because of the difficulty concatenating VMS filepaths we
|
---|
360 | must pre-expand the DEST* variables.
|
---|
361 |
|
---|
362 | =cut
|
---|
363 |
|
---|
364 | sub init_DEST {
|
---|
365 | my $self = shift;
|
---|
366 |
|
---|
367 | $self->SUPER::init_DEST;
|
---|
368 |
|
---|
369 | # Expand DEST variables.
|
---|
370 | foreach my $var ($self->installvars) {
|
---|
371 | my $destvar = 'DESTINSTALL'.$var;
|
---|
372 | $self->{$destvar} = File::Spec->eliminate_macros($self->{$destvar});
|
---|
373 | }
|
---|
374 | }
|
---|
375 |
|
---|
376 |
|
---|
377 | =item init_DIRFILESEP
|
---|
378 |
|
---|
379 | No seperator between a directory path and a filename on VMS.
|
---|
380 |
|
---|
381 | =cut
|
---|
382 |
|
---|
383 | sub init_DIRFILESEP {
|
---|
384 | my($self) = shift;
|
---|
385 |
|
---|
386 | $self->{DIRFILESEP} = '';
|
---|
387 | return 1;
|
---|
388 | }
|
---|
389 |
|
---|
390 |
|
---|
391 | =item init_main (override)
|
---|
392 |
|
---|
393 |
|
---|
394 | =cut
|
---|
395 |
|
---|
396 | sub init_main {
|
---|
397 | my($self) = shift;
|
---|
398 |
|
---|
399 | $self->SUPER::init_main;
|
---|
400 |
|
---|
401 | $self->{DEFINE} ||= '';
|
---|
402 | if ($self->{DEFINE} ne '') {
|
---|
403 | my(@terms) = split(/\s+/,$self->{DEFINE});
|
---|
404 | my(@defs,@udefs);
|
---|
405 | foreach my $def (@terms) {
|
---|
406 | next unless $def;
|
---|
407 | my $targ = \@defs;
|
---|
408 | if ($def =~ s/^-([DU])//) { # If it was a Unix-style definition
|
---|
409 | $targ = \@udefs if $1 eq 'U';
|
---|
410 | $def =~ s/='(.*)'$/=$1/; # then remove shell-protection ''
|
---|
411 | $def =~ s/^'(.*)'$/$1/; # from entire term or argument
|
---|
412 | }
|
---|
413 | if ($def =~ /=/) {
|
---|
414 | $def =~ s/"/""/g; # Protect existing " from DCL
|
---|
415 | $def = qq["$def"]; # and quote to prevent parsing of =
|
---|
416 | }
|
---|
417 | push @$targ, $def;
|
---|
418 | }
|
---|
419 |
|
---|
420 | $self->{DEFINE} = '';
|
---|
421 | if (@defs) {
|
---|
422 | $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')';
|
---|
423 | }
|
---|
424 | if (@udefs) {
|
---|
425 | $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')';
|
---|
426 | }
|
---|
427 | }
|
---|
428 | }
|
---|
429 |
|
---|
430 | =item init_others (override)
|
---|
431 |
|
---|
432 | Provide VMS-specific forms of various utility commands, then hand
|
---|
433 | off to the default MM_Unix method.
|
---|
434 |
|
---|
435 | DEV_NULL should probably be overriden with something.
|
---|
436 |
|
---|
437 | Also changes EQUALIZE_TIMESTAMP to set revision date of target file to
|
---|
438 | one second later than source file, since MMK interprets precisely
|
---|
439 | equal revision dates for a source and target file as a sign that the
|
---|
440 | target needs to be updated.
|
---|
441 |
|
---|
442 | =cut
|
---|
443 |
|
---|
444 | sub init_others {
|
---|
445 | my($self) = @_;
|
---|
446 |
|
---|
447 | $self->{NOOP} = 'Continue';
|
---|
448 | $self->{NOECHO} ||= '@ ';
|
---|
449 |
|
---|
450 | $self->{MAKEFILE} ||= 'Descrip.MMS';
|
---|
451 | $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE};
|
---|
452 | $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
|
---|
453 | $self->{MAKEFILE_OLD} ||= '$(FIRST_MAKEFILE)_old';
|
---|
454 |
|
---|
455 | $self->{MACROSTART} ||= '/Macro=(';
|
---|
456 | $self->{MACROEND} ||= ')';
|
---|
457 | $self->{USEMAKEFILE} ||= '/Descrip=';
|
---|
458 |
|
---|
459 | $self->{ECHO} ||= '$(ABSPERLRUN) -le "print qq{@ARGV}"';
|
---|
460 | $self->{ECHO_N} ||= '$(ABSPERLRUN) -e "print qq{@ARGV}"';
|
---|
461 | $self->{TOUCH} ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e touch';
|
---|
462 | $self->{CHMOD} ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e chmod';
|
---|
463 | $self->{RM_F} ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_f';
|
---|
464 | $self->{RM_RF} ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_rf';
|
---|
465 | $self->{TEST_F} ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e test_f';
|
---|
466 | $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
|
---|
467 |
|
---|
468 | $self->{MOD_INSTALL} ||=
|
---|
469 | $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
|
---|
470 | install({split(' ',<STDIN>)}, '$(VERBINST)', 0, '$(UNINST)');
|
---|
471 | CODE
|
---|
472 |
|
---|
473 | $self->{SHELL} ||= 'Posix';
|
---|
474 |
|
---|
475 | $self->SUPER::init_others;
|
---|
476 |
|
---|
477 | # So we can copy files into directories with less fuss
|
---|
478 | $self->{CP} = '$(ABSPERLRUN) "-MExtUtils::Command" -e cp';
|
---|
479 | $self->{MV} = '$(ABSPERLRUN) "-MExtUtils::Command" -e mv';
|
---|
480 |
|
---|
481 | $self->{UMASK_NULL} = '! ';
|
---|
482 |
|
---|
483 | # Redirection on VMS goes before the command, not after as on Unix.
|
---|
484 | # $(DEV_NULL) is used once and its not worth going nuts over making
|
---|
485 | # it work. However, Unix's DEV_NULL is quite wrong for VMS.
|
---|
486 | $self->{DEV_NULL} = '';
|
---|
487 |
|
---|
488 | if ($self->{OBJECT} =~ /\s/) {
|
---|
489 | $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
|
---|
490 | $self->{OBJECT} = $self->wraplist(
|
---|
491 | map $self->fixpath($_,0), split /,?\s+/, $self->{OBJECT}
|
---|
492 | );
|
---|
493 | }
|
---|
494 |
|
---|
495 | $self->{LDFROM} = $self->wraplist(
|
---|
496 | map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM}
|
---|
497 | );
|
---|
498 | }
|
---|
499 |
|
---|
500 |
|
---|
501 | =item init_platform (override)
|
---|
502 |
|
---|
503 | Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
|
---|
504 |
|
---|
505 | MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
|
---|
506 | $VERSION.
|
---|
507 |
|
---|
508 | =cut
|
---|
509 |
|
---|
510 | sub init_platform {
|
---|
511 | my($self) = shift;
|
---|
512 |
|
---|
513 | $self->{MM_VMS_REVISION} = $Revision;
|
---|
514 | $self->{MM_VMS_VERSION} = $VERSION;
|
---|
515 | $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
|
---|
516 | if $self->{PERL_SRC};
|
---|
517 | }
|
---|
518 |
|
---|
519 |
|
---|
520 | =item platform_constants
|
---|
521 |
|
---|
522 | =cut
|
---|
523 |
|
---|
524 | sub platform_constants {
|
---|
525 | my($self) = shift;
|
---|
526 | my $make_frag = '';
|
---|
527 |
|
---|
528 | foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
|
---|
529 | {
|
---|
530 | next unless defined $self->{$macro};
|
---|
531 | $make_frag .= "$macro = $self->{$macro}\n";
|
---|
532 | }
|
---|
533 |
|
---|
534 | return $make_frag;
|
---|
535 | }
|
---|
536 |
|
---|
537 |
|
---|
538 | =item init_VERSION (override)
|
---|
539 |
|
---|
540 | Override the *DEFINE_VERSION macros with VMS semantics. Translate the
|
---|
541 | MAKEMAKER filepath to VMS style.
|
---|
542 |
|
---|
543 | =cut
|
---|
544 |
|
---|
545 | sub init_VERSION {
|
---|
546 | my $self = shift;
|
---|
547 |
|
---|
548 | $self->SUPER::init_VERSION;
|
---|
549 |
|
---|
550 | $self->{DEFINE_VERSION} = '"$(VERSION_MACRO)=""$(VERSION)"""';
|
---|
551 | $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
|
---|
552 | $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
|
---|
553 | }
|
---|
554 |
|
---|
555 |
|
---|
556 | =item constants (override)
|
---|
557 |
|
---|
558 | Fixes up numerous file and directory macros to insure VMS syntax
|
---|
559 | regardless of input syntax. Also makes lists of files
|
---|
560 | comma-separated.
|
---|
561 |
|
---|
562 | =cut
|
---|
563 |
|
---|
564 | sub constants {
|
---|
565 | my($self) = @_;
|
---|
566 |
|
---|
567 | # Be kind about case for pollution
|
---|
568 | for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
|
---|
569 |
|
---|
570 | # Cleanup paths for directories in MMS macros.
|
---|
571 | foreach my $macro ( qw [
|
---|
572 | INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB
|
---|
573 | PERL_LIB PERL_ARCHLIB
|
---|
574 | PERL_INC PERL_SRC ],
|
---|
575 | (map { 'INSTALL'.$_ } $self->installvars)
|
---|
576 | )
|
---|
577 | {
|
---|
578 | next unless defined $self->{$macro};
|
---|
579 | next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
|
---|
580 | $self->{$macro} = $self->fixpath($self->{$macro},1);
|
---|
581 | }
|
---|
582 |
|
---|
583 | # Cleanup paths for files in MMS macros.
|
---|
584 | foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD
|
---|
585 | MAKE_APERL_FILE MYEXTLIB] )
|
---|
586 | {
|
---|
587 | next unless defined $self->{$macro};
|
---|
588 | $self->{$macro} = $self->fixpath($self->{$macro},0);
|
---|
589 | }
|
---|
590 |
|
---|
591 | # Fixup files for MMS macros
|
---|
592 | # XXX is this list complete?
|
---|
593 | for my $macro (qw/
|
---|
594 | FULLEXT VERSION_FROM OBJECT LDFROM
|
---|
595 | / ) {
|
---|
596 | next unless defined $self->{$macro};
|
---|
597 | $self->{$macro} = $self->fixpath($self->{$macro},0);
|
---|
598 | }
|
---|
599 |
|
---|
600 |
|
---|
601 | for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
|
---|
602 | # Where is the space coming from? --jhi
|
---|
603 | next unless $self ne " " && defined $self->{$macro};
|
---|
604 | my %tmp = ();
|
---|
605 | for my $key (keys %{$self->{$macro}}) {
|
---|
606 | $tmp{$self->fixpath($key,0)} =
|
---|
607 | $self->fixpath($self->{$macro}{$key},0);
|
---|
608 | }
|
---|
609 | $self->{$macro} = \%tmp;
|
---|
610 | }
|
---|
611 |
|
---|
612 | for my $macro (qw/ C O_FILES H /) {
|
---|
613 | next unless defined $self->{$macro};
|
---|
614 | my @tmp = ();
|
---|
615 | for my $val (@{$self->{$macro}}) {
|
---|
616 | push(@tmp,$self->fixpath($val,0));
|
---|
617 | }
|
---|
618 | $self->{$macro} = \@tmp;
|
---|
619 | }
|
---|
620 |
|
---|
621 | # mms/k does not define a $(MAKE) macro.
|
---|
622 | $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
|
---|
623 |
|
---|
624 | return $self->SUPER::constants;
|
---|
625 | }
|
---|
626 |
|
---|
627 |
|
---|
628 | =item special_targets
|
---|
629 |
|
---|
630 | Clear the default .SUFFIXES and put in our own list.
|
---|
631 |
|
---|
632 | =cut
|
---|
633 |
|
---|
634 | sub special_targets {
|
---|
635 | my $self = shift;
|
---|
636 |
|
---|
637 | my $make_frag .= <<'MAKE_FRAG';
|
---|
638 | .SUFFIXES :
|
---|
639 | .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
|
---|
640 |
|
---|
641 | MAKE_FRAG
|
---|
642 |
|
---|
643 | return $make_frag;
|
---|
644 | }
|
---|
645 |
|
---|
646 | =item cflags (override)
|
---|
647 |
|
---|
648 | Bypass shell script and produce qualifiers for CC directly (but warn
|
---|
649 | user if a shell script for this extension exists). Fold multiple
|
---|
650 | /Defines into one, since some C compilers pay attention to only one
|
---|
651 | instance of this qualifier on the command line.
|
---|
652 |
|
---|
653 | =cut
|
---|
654 |
|
---|
655 | sub cflags {
|
---|
656 | my($self,$libperl) = @_;
|
---|
657 | my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
|
---|
658 | my($definestr,$undefstr,$flagoptstr) = ('','','');
|
---|
659 | my($incstr) = '/Include=($(PERL_INC)';
|
---|
660 | my($name,$sys,@m);
|
---|
661 |
|
---|
662 | ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
|
---|
663 | print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
|
---|
664 | " required to modify CC command for $self->{'BASEEXT'}\n"
|
---|
665 | if ($Config{$name});
|
---|
666 |
|
---|
667 | if ($quals =~ / -[DIUOg]/) {
|
---|
668 | while ($quals =~ / -([Og])(\d*)\b/) {
|
---|
669 | my($type,$lvl) = ($1,$2);
|
---|
670 | $quals =~ s/ -$type$lvl\b\s*//;
|
---|
671 | if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
|
---|
672 | else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
|
---|
673 | }
|
---|
674 | while ($quals =~ / -([DIU])(\S+)/) {
|
---|
675 | my($type,$def) = ($1,$2);
|
---|
676 | $quals =~ s/ -$type$def\s*//;
|
---|
677 | $def =~ s/"/""/g;
|
---|
678 | if ($type eq 'D') { $definestr .= qq["$def",]; }
|
---|
679 | elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
|
---|
680 | else { $undefstr .= qq["$def",]; }
|
---|
681 | }
|
---|
682 | }
|
---|
683 | if (length $quals and $quals !~ m!/!) {
|
---|
684 | warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
|
---|
685 | $quals = '';
|
---|
686 | }
|
---|
687 | $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};
|
---|
688 | if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
|
---|
689 | if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; }
|
---|
690 | # Deal with $self->{DEFINE} here since some C compilers pay attention
|
---|
691 | # to only one /Define clause on command line, so we have to
|
---|
692 | # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
|
---|
693 | # ($self->{DEFINE} has already been VMSified in constants() above)
|
---|
694 | if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
|
---|
695 | for my $type (qw(Def Undef)) {
|
---|
696 | my(@terms);
|
---|
697 | while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
|
---|
698 | my $term = $1;
|
---|
699 | $term =~ s:^\((.+)\)$:$1:;
|
---|
700 | push @terms, $term;
|
---|
701 | }
|
---|
702 | if ($type eq 'Def') {
|
---|
703 | push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];
|
---|
704 | }
|
---|
705 | if (@terms) {
|
---|
706 | $quals =~ s:/${type}i?n?e?=[^/]+::ig;
|
---|
707 | $quals .= "/${type}ine=(" . join(',',@terms) . ')';
|
---|
708 | }
|
---|
709 | }
|
---|
710 |
|
---|
711 | $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
|
---|
712 |
|
---|
713 | # Likewise with $self->{INC} and /Include
|
---|
714 | if ($self->{'INC'}) {
|
---|
715 | my(@includes) = split(/\s+/,$self->{INC});
|
---|
716 | foreach (@includes) {
|
---|
717 | s/^-I//;
|
---|
718 | $incstr .= ','.$self->fixpath($_,1);
|
---|
719 | }
|
---|
720 | }
|
---|
721 | $quals .= "$incstr)";
|
---|
722 | # $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
|
---|
723 | $self->{CCFLAGS} = $quals;
|
---|
724 |
|
---|
725 | $self->{PERLTYPE} ||= '';
|
---|
726 |
|
---|
727 | $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
|
---|
728 | if ($self->{OPTIMIZE} !~ m!/!) {
|
---|
729 | if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
|
---|
730 | elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
|
---|
731 | $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
|
---|
732 | }
|
---|
733 | else {
|
---|
734 | warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
|
---|
735 | $self->{OPTIMIZE} = '/Optimize';
|
---|
736 | }
|
---|
737 | }
|
---|
738 |
|
---|
739 | return $self->{CFLAGS} = qq{
|
---|
740 | CCFLAGS = $self->{CCFLAGS}
|
---|
741 | OPTIMIZE = $self->{OPTIMIZE}
|
---|
742 | PERLTYPE = $self->{PERLTYPE}
|
---|
743 | };
|
---|
744 | }
|
---|
745 |
|
---|
746 | =item const_cccmd (override)
|
---|
747 |
|
---|
748 | Adds directives to point C preprocessor to the right place when
|
---|
749 | handling #include E<lt>sys/foo.hE<gt> directives. Also constructs CC
|
---|
750 | command line a bit differently than MM_Unix method.
|
---|
751 |
|
---|
752 | =cut
|
---|
753 |
|
---|
754 | sub const_cccmd {
|
---|
755 | my($self,$libperl) = @_;
|
---|
756 | my(@m);
|
---|
757 |
|
---|
758 | return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
|
---|
759 | return '' unless $self->needs_linking();
|
---|
760 | if ($Config{'vms_cc_type'} eq 'gcc') {
|
---|
761 | push @m,'
|
---|
762 | .FIRST
|
---|
763 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
|
---|
764 | }
|
---|
765 | elsif ($Config{'vms_cc_type'} eq 'vaxc') {
|
---|
766 | push @m,'
|
---|
767 | .FIRST
|
---|
768 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
|
---|
769 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
|
---|
770 | }
|
---|
771 | else {
|
---|
772 | push @m,'
|
---|
773 | .FIRST
|
---|
774 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
|
---|
775 | ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
|
---|
776 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
|
---|
777 | }
|
---|
778 |
|
---|
779 | push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
|
---|
780 |
|
---|
781 | $self->{CONST_CCCMD} = join('',@m);
|
---|
782 | }
|
---|
783 |
|
---|
784 |
|
---|
785 | =item tools_other (override)
|
---|
786 |
|
---|
787 | Throw in some dubious extra macros for Makefile args.
|
---|
788 |
|
---|
789 | Also keep around the old $(SAY) macro in case somebody's using it.
|
---|
790 |
|
---|
791 | =cut
|
---|
792 |
|
---|
793 | sub tools_other {
|
---|
794 | my($self) = @_;
|
---|
795 |
|
---|
796 | # XXX Are these necessary? Does anyone override them? They're longer
|
---|
797 | # than just typing the literal string.
|
---|
798 | my $extra_tools = <<'EXTRA_TOOLS';
|
---|
799 |
|
---|
800 | # Just in case anyone is using the old macro.
|
---|
801 | USEMACROS = $(MACROSTART)
|
---|
802 | SAY = $(ECHO)
|
---|
803 |
|
---|
804 | EXTRA_TOOLS
|
---|
805 |
|
---|
806 | return $self->SUPER::tools_other . $extra_tools;
|
---|
807 | }
|
---|
808 |
|
---|
809 | =item init_dist (override)
|
---|
810 |
|
---|
811 | VMSish defaults for some values.
|
---|
812 |
|
---|
813 | macro description default
|
---|
814 |
|
---|
815 | ZIPFLAGS flags to pass to ZIP -Vu
|
---|
816 |
|
---|
817 | COMPRESS compression command to gzip
|
---|
818 | use for tarfiles
|
---|
819 | SUFFIX suffix to put on -gz
|
---|
820 | compressed files
|
---|
821 |
|
---|
822 | SHAR shar command to use vms_share
|
---|
823 |
|
---|
824 | DIST_DEFAULT default target to use to tardist
|
---|
825 | create a distribution
|
---|
826 |
|
---|
827 | DISTVNAME Use VERSION_SYM instead of $(DISTNAME)-$(VERSION_SYM)
|
---|
828 | VERSION for the name
|
---|
829 |
|
---|
830 | =cut
|
---|
831 |
|
---|
832 | sub init_dist {
|
---|
833 | my($self) = @_;
|
---|
834 | $self->{ZIPFLAGS} ||= '-Vu';
|
---|
835 | $self->{COMPRESS} ||= 'gzip';
|
---|
836 | $self->{SUFFIX} ||= '-gz';
|
---|
837 | $self->{SHAR} ||= 'vms_share';
|
---|
838 | $self->{DIST_DEFAULT} ||= 'zipdist';
|
---|
839 |
|
---|
840 | $self->SUPER::init_dist;
|
---|
841 |
|
---|
842 | $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}";
|
---|
843 | }
|
---|
844 |
|
---|
845 | =item c_o (override)
|
---|
846 |
|
---|
847 | Use VMS syntax on command line. In particular, $(DEFINE) and
|
---|
848 | $(PERL_INC) have been pulled into $(CCCMD). Also use MM[SK] macros.
|
---|
849 |
|
---|
850 | =cut
|
---|
851 |
|
---|
852 | sub c_o {
|
---|
853 | my($self) = @_;
|
---|
854 | return '' unless $self->needs_linking();
|
---|
855 | '
|
---|
856 | .c$(OBJ_EXT) :
|
---|
857 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
|
---|
858 |
|
---|
859 | .cpp$(OBJ_EXT) :
|
---|
860 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
|
---|
861 |
|
---|
862 | .cxx$(OBJ_EXT) :
|
---|
863 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
|
---|
864 |
|
---|
865 | ';
|
---|
866 | }
|
---|
867 |
|
---|
868 | =item xs_c (override)
|
---|
869 |
|
---|
870 | Use MM[SK] macros.
|
---|
871 |
|
---|
872 | =cut
|
---|
873 |
|
---|
874 | sub xs_c {
|
---|
875 | my($self) = @_;
|
---|
876 | return '' unless $self->needs_linking();
|
---|
877 | '
|
---|
878 | .xs.c :
|
---|
879 | $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
|
---|
880 | ';
|
---|
881 | }
|
---|
882 |
|
---|
883 | =item xs_o (override)
|
---|
884 |
|
---|
885 | Use MM[SK] macros, and VMS command line for C compiler.
|
---|
886 |
|
---|
887 | =cut
|
---|
888 |
|
---|
889 | sub xs_o { # many makes are too dumb to use xs_c then c_o
|
---|
890 | my($self) = @_;
|
---|
891 | return '' unless $self->needs_linking();
|
---|
892 | '
|
---|
893 | .xs$(OBJ_EXT) :
|
---|
894 | $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
|
---|
895 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
|
---|
896 | ';
|
---|
897 | }
|
---|
898 |
|
---|
899 |
|
---|
900 | =item dlsyms (override)
|
---|
901 |
|
---|
902 | Create VMS linker options files specifying universal symbols for this
|
---|
903 | extension's shareable image, and listing other shareable images or
|
---|
904 | libraries to which it should be linked.
|
---|
905 |
|
---|
906 | =cut
|
---|
907 |
|
---|
908 | sub dlsyms {
|
---|
909 | my($self,%attribs) = @_;
|
---|
910 |
|
---|
911 | return '' unless $self->needs_linking();
|
---|
912 |
|
---|
913 | my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
|
---|
914 | my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
|
---|
915 | my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
|
---|
916 | my(@m);
|
---|
917 |
|
---|
918 | unless ($self->{SKIPHASH}{'dynamic'}) {
|
---|
919 | push(@m,'
|
---|
920 | dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
|
---|
921 | $(NOECHO) $(NOOP)
|
---|
922 | ');
|
---|
923 | }
|
---|
924 |
|
---|
925 | push(@m,'
|
---|
926 | static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
|
---|
927 | $(NOECHO) $(NOOP)
|
---|
928 | ') unless $self->{SKIPHASH}{'static'};
|
---|
929 |
|
---|
930 | push @m,'
|
---|
931 | $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
|
---|
932 | $(CP) $(MMS$SOURCE) $(MMS$TARGET)
|
---|
933 |
|
---|
934 | $(BASEEXT).opt : Makefile.PL
|
---|
935 | $(PERLRUN) -e "use ExtUtils::Mksymlists;" -
|
---|
936 | ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
|
---|
937 | neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
|
---|
938 | q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
|
---|
939 |
|
---|
940 | push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include=';
|
---|
941 | if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
|
---|
942 | $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) {
|
---|
943 | push @m, ($Config{d_vms_case_sensitive_symbols}
|
---|
944 | ? uc($self->{BASEEXT}) :'$(BASEEXT)');
|
---|
945 | }
|
---|
946 | else { # We don't have a "main" object file, so pull 'em all in
|
---|
947 | # Upcase module names if linker is being case-sensitive
|
---|
948 | my($upcase) = $Config{d_vms_case_sensitive_symbols};
|
---|
949 | my(@omods) = map { s/\.[^.]*$//; # Trim off file type
|
---|
950 | s[\$\(\w+_EXT\)][]; # even as a macro
|
---|
951 | s/.*[:>\/\]]//; # Trim off dir spec
|
---|
952 | $upcase ? uc($_) : $_;
|
---|
953 | } split ' ', $self->eliminate_macros($self->{OBJECT});
|
---|
954 | my($tmp,@lines,$elt) = '';
|
---|
955 | $tmp = shift @omods;
|
---|
956 | foreach $elt (@omods) {
|
---|
957 | $tmp .= ",$elt";
|
---|
958 | if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; }
|
---|
959 | }
|
---|
960 | push @lines, $tmp;
|
---|
961 | push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
|
---|
962 | }
|
---|
963 | push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
|
---|
964 |
|
---|
965 | if (length $self->{LDLOADLIBS}) {
|
---|
966 | my($lib); my($line) = '';
|
---|
967 | foreach $lib (split ' ', $self->{LDLOADLIBS}) {
|
---|
968 | $lib =~ s%\$%\\\$%g; # Escape '$' in VMS filespecs
|
---|
969 | if (length($line) + length($lib) > 160) {
|
---|
970 | push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
|
---|
971 | $line = $lib . '\n';
|
---|
972 | }
|
---|
973 | else { $line .= $lib . '\n'; }
|
---|
974 | }
|
---|
975 | push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
|
---|
976 | }
|
---|
977 |
|
---|
978 | join('',@m);
|
---|
979 |
|
---|
980 | }
|
---|
981 |
|
---|
982 | =item dynamic_lib (override)
|
---|
983 |
|
---|
984 | Use VMS Link command.
|
---|
985 |
|
---|
986 | =cut
|
---|
987 |
|
---|
988 | sub dynamic_lib {
|
---|
989 | my($self, %attribs) = @_;
|
---|
990 | return '' unless $self->needs_linking(); #might be because of a subdir
|
---|
991 |
|
---|
992 | return '' unless $self->has_link_code();
|
---|
993 |
|
---|
994 | my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
|
---|
995 | my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
|
---|
996 | my $shr = $Config{'dbgprefix'} . 'PerlShr';
|
---|
997 | my(@m);
|
---|
998 | push @m,"
|
---|
999 |
|
---|
1000 | OTHERLDFLAGS = $otherldflags
|
---|
1001 | INST_DYNAMIC_DEP = $inst_dynamic_dep
|
---|
1002 |
|
---|
1003 | ";
|
---|
1004 | push @m, '
|
---|
1005 | $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
|
---|
1006 | If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
|
---|
1007 | Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
|
---|
1008 | ';
|
---|
1009 |
|
---|
1010 | join('',@m);
|
---|
1011 | }
|
---|
1012 |
|
---|
1013 |
|
---|
1014 | =item static_lib (override)
|
---|
1015 |
|
---|
1016 | Use VMS commands to manipulate object library.
|
---|
1017 |
|
---|
1018 | =cut
|
---|
1019 |
|
---|
1020 | sub static_lib {
|
---|
1021 | my($self) = @_;
|
---|
1022 | return '' unless $self->needs_linking();
|
---|
1023 |
|
---|
1024 | return '
|
---|
1025 | $(INST_STATIC) :
|
---|
1026 | $(NOECHO) $(NOOP)
|
---|
1027 | ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
|
---|
1028 |
|
---|
1029 | my(@m,$lib);
|
---|
1030 | push @m,'
|
---|
1031 | # Rely on suffix rule for update action
|
---|
1032 | $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
|
---|
1033 |
|
---|
1034 | $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
|
---|
1035 | ';
|
---|
1036 | # If this extension has its own library (eg SDBM_File)
|
---|
1037 | # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
|
---|
1038 | push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
|
---|
1039 |
|
---|
1040 | push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
|
---|
1041 |
|
---|
1042 | # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
|
---|
1043 | # 'cause it's a library and you can't stick them in other libraries.
|
---|
1044 | # In that case, we use $OBJECT instead and hope for the best
|
---|
1045 | if ($self->{MYEXTLIB}) {
|
---|
1046 | push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
|
---|
1047 | } else {
|
---|
1048 | push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
|
---|
1049 | }
|
---|
1050 |
|
---|
1051 | push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
|
---|
1052 | foreach $lib (split ' ', $self->{EXTRALIBS}) {
|
---|
1053 | push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
|
---|
1054 | }
|
---|
1055 | join('',@m);
|
---|
1056 | }
|
---|
1057 |
|
---|
1058 |
|
---|
1059 | =item extra_clean_files
|
---|
1060 |
|
---|
1061 | Clean up some OS specific files. Plus the temp file used to shorten
|
---|
1062 | a lot of commands.
|
---|
1063 |
|
---|
1064 | =cut
|
---|
1065 |
|
---|
1066 | sub extra_clean_files {
|
---|
1067 | return qw(
|
---|
1068 | *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
|
---|
1069 | .MM_Tmp
|
---|
1070 | );
|
---|
1071 | }
|
---|
1072 |
|
---|
1073 |
|
---|
1074 | =item zipfile_target
|
---|
1075 |
|
---|
1076 | =item tarfile_target
|
---|
1077 |
|
---|
1078 | =item shdist_target
|
---|
1079 |
|
---|
1080 | Syntax for invoking shar, tar and zip differs from that for Unix.
|
---|
1081 |
|
---|
1082 | =cut
|
---|
1083 |
|
---|
1084 | sub zipfile_target {
|
---|
1085 | my($self) = shift;
|
---|
1086 |
|
---|
1087 | return <<'MAKE_FRAG';
|
---|
1088 | $(DISTVNAME).zip : distdir
|
---|
1089 | $(PREOP)
|
---|
1090 | $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
|
---|
1091 | $(RM_RF) $(DISTVNAME)
|
---|
1092 | $(POSTOP)
|
---|
1093 | MAKE_FRAG
|
---|
1094 | }
|
---|
1095 |
|
---|
1096 | sub tarfile_target {
|
---|
1097 | my($self) = shift;
|
---|
1098 |
|
---|
1099 | return <<'MAKE_FRAG';
|
---|
1100 | $(DISTVNAME).tar$(SUFFIX) : distdir
|
---|
1101 | $(PREOP)
|
---|
1102 | $(TO_UNIX)
|
---|
1103 | $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
|
---|
1104 | $(RM_RF) $(DISTVNAME)
|
---|
1105 | $(COMPRESS) $(DISTVNAME).tar
|
---|
1106 | $(POSTOP)
|
---|
1107 | MAKE_FRAG
|
---|
1108 | }
|
---|
1109 |
|
---|
1110 | sub shdist_target {
|
---|
1111 | my($self) = shift;
|
---|
1112 |
|
---|
1113 | return <<'MAKE_FRAG';
|
---|
1114 | shdist : distdir
|
---|
1115 | $(PREOP)
|
---|
1116 | $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
|
---|
1117 | $(RM_RF) $(DISTVNAME)
|
---|
1118 | $(POSTOP)
|
---|
1119 | MAKE_FRAG
|
---|
1120 | }
|
---|
1121 |
|
---|
1122 |
|
---|
1123 | # --- Test and Installation Sections ---
|
---|
1124 |
|
---|
1125 | =item install (override)
|
---|
1126 |
|
---|
1127 | Work around DCL's 255 character limit several times,and use
|
---|
1128 | VMS-style command line quoting in a few cases.
|
---|
1129 |
|
---|
1130 | =cut
|
---|
1131 |
|
---|
1132 | sub install {
|
---|
1133 | my($self, %attribs) = @_;
|
---|
1134 | my(@m);
|
---|
1135 |
|
---|
1136 | push @m, q[
|
---|
1137 | install :: all pure_install doc_install
|
---|
1138 | $(NOECHO) $(NOOP)
|
---|
1139 |
|
---|
1140 | install_perl :: all pure_perl_install doc_perl_install
|
---|
1141 | $(NOECHO) $(NOOP)
|
---|
1142 |
|
---|
1143 | install_site :: all pure_site_install doc_site_install
|
---|
1144 | $(NOECHO) $(NOOP)
|
---|
1145 |
|
---|
1146 | pure_install :: pure_$(INSTALLDIRS)_install
|
---|
1147 | $(NOECHO) $(NOOP)
|
---|
1148 |
|
---|
1149 | doc_install :: doc_$(INSTALLDIRS)_install
|
---|
1150 | $(NOECHO) $(NOOP)
|
---|
1151 |
|
---|
1152 | pure__install : pure_site_install
|
---|
1153 | $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
|
---|
1154 |
|
---|
1155 | doc__install : doc_site_install
|
---|
1156 | $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
|
---|
1157 |
|
---|
1158 | # This hack brought to you by DCL's 255-character command line limit
|
---|
1159 | pure_perl_install ::
|
---|
1160 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
|
---|
1161 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
|
---|
1162 | $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp
|
---|
1163 | $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp
|
---|
1164 | $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp
|
---|
1165 | $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
|
---|
1166 | $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
|
---|
1167 | $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp
|
---|
1168 | $(NOECHO) $(MOD_INSTALL) <.MM_tmp
|
---|
1169 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1170 | $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
|
---|
1171 |
|
---|
1172 | # Likewise
|
---|
1173 | pure_site_install ::
|
---|
1174 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
|
---|
1175 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
|
---|
1176 | $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp
|
---|
1177 | $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp
|
---|
1178 | $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp
|
---|
1179 | $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
|
---|
1180 | $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp
|
---|
1181 | $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp
|
---|
1182 | $(NOECHO) $(MOD_INSTALL) <.MM_tmp
|
---|
1183 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1184 | $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
|
---|
1185 |
|
---|
1186 | pure_vendor_install ::
|
---|
1187 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
|
---|
1188 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
|
---|
1189 | $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp
|
---|
1190 | $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp
|
---|
1191 | $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp
|
---|
1192 | $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
|
---|
1193 | $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp
|
---|
1194 | $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp
|
---|
1195 | $(NOECHO) $(MOD_INSTALL) <.MM_tmp
|
---|
1196 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1197 |
|
---|
1198 | # Ditto
|
---|
1199 | doc_perl_install ::
|
---|
1200 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
|
---|
1201 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
|
---|
1202 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
|
---|
1203 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
|
---|
1204 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
|
---|
1205 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1206 |
|
---|
1207 | # And again
|
---|
1208 | doc_site_install ::
|
---|
1209 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
|
---|
1210 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
|
---|
1211 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
|
---|
1212 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
|
---|
1213 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
|
---|
1214 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1215 |
|
---|
1216 | doc_vendor_install ::
|
---|
1217 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
|
---|
1218 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
|
---|
1219 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
|
---|
1220 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
|
---|
1221 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
|
---|
1222 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1223 |
|
---|
1224 | ];
|
---|
1225 |
|
---|
1226 | push @m, q[
|
---|
1227 | uninstall :: uninstall_from_$(INSTALLDIRS)dirs
|
---|
1228 | $(NOECHO) $(NOOP)
|
---|
1229 |
|
---|
1230 | uninstall_from_perldirs ::
|
---|
1231 | $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
|
---|
1232 | $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
|
---|
1233 | $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
|
---|
1234 | $(NOECHO) $(ECHO) "the appropriate files. Sorry for the inconvenience."
|
---|
1235 |
|
---|
1236 | uninstall_from_sitedirs ::
|
---|
1237 | $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
|
---|
1238 | $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
|
---|
1239 | $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
|
---|
1240 | $(NOECHO) $(ECHO) "the appropriate files. Sorry for the inconvenience."
|
---|
1241 | ];
|
---|
1242 |
|
---|
1243 | join('',@m);
|
---|
1244 | }
|
---|
1245 |
|
---|
1246 | =item perldepend (override)
|
---|
1247 |
|
---|
1248 | Use VMS-style syntax for files; it's cheaper to just do it directly here
|
---|
1249 | than to have the MM_Unix method call C<catfile> repeatedly. Also, if
|
---|
1250 | we have to rebuild Config.pm, use MM[SK] to do it.
|
---|
1251 |
|
---|
1252 | =cut
|
---|
1253 |
|
---|
1254 | sub perldepend {
|
---|
1255 | my($self) = @_;
|
---|
1256 | my(@m);
|
---|
1257 |
|
---|
1258 | push @m, '
|
---|
1259 | $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
|
---|
1260 | $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
|
---|
1261 | $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
|
---|
1262 | $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
|
---|
1263 | $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
|
---|
1264 | $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
|
---|
1265 | $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
|
---|
1266 | $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
|
---|
1267 | $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
|
---|
1268 | $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
|
---|
1269 | $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
|
---|
1270 | $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
|
---|
1271 | $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
|
---|
1272 | $(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h
|
---|
1273 | $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h
|
---|
1274 |
|
---|
1275 | ' if $self->{OBJECT};
|
---|
1276 |
|
---|
1277 | if ($self->{PERL_SRC}) {
|
---|
1278 | my(@macros);
|
---|
1279 | my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
|
---|
1280 | push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
|
---|
1281 | push(@macros,'DECC=1') if $Config{'vms_cc_type'} eq 'decc';
|
---|
1282 | push(@macros,'GNUC=1') if $Config{'vms_cc_type'} eq 'gcc';
|
---|
1283 | push(@macros,'SOCKET=1') if $Config{'d_has_sockets'};
|
---|
1284 | push(@macros,qq["CC=$Config{'cc'}"]) if $Config{'cc'} =~ m!/!;
|
---|
1285 | $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
|
---|
1286 | push(@m,q[
|
---|
1287 | # Check for unpropagated config.sh changes. Should never happen.
|
---|
1288 | # We do NOT just update config.h because that is not sufficient.
|
---|
1289 | # An out of date config.h is not fatal but complains loudly!
|
---|
1290 | $(PERL_INC)config.h : $(PERL_SRC)config.sh
|
---|
1291 | $(NOOP)
|
---|
1292 |
|
---|
1293 | $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
|
---|
1294 | $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
|
---|
1295 | olddef = F$Environment("Default")
|
---|
1296 | Set Default $(PERL_SRC)
|
---|
1297 | $(MMS)],$mmsquals,);
|
---|
1298 | if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
|
---|
1299 | my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
|
---|
1300 | $target =~ s/\Q$prefix/[/;
|
---|
1301 | push(@m," $target");
|
---|
1302 | }
|
---|
1303 | else { push(@m,' $(MMS$TARGET)'); }
|
---|
1304 | push(@m,q[
|
---|
1305 | Set Default 'olddef'
|
---|
1306 | ]);
|
---|
1307 | }
|
---|
1308 |
|
---|
1309 | push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
|
---|
1310 | if %{$self->{XS}};
|
---|
1311 |
|
---|
1312 | join('',@m);
|
---|
1313 | }
|
---|
1314 |
|
---|
1315 |
|
---|
1316 | =item makeaperl (override)
|
---|
1317 |
|
---|
1318 | Undertake to build a new set of Perl images using VMS commands. Since
|
---|
1319 | VMS does dynamic loading, it's not necessary to statically link each
|
---|
1320 | extension into the Perl image, so this isn't the normal build path.
|
---|
1321 | Consequently, it hasn't really been tested, and may well be incomplete.
|
---|
1322 |
|
---|
1323 | =cut
|
---|
1324 |
|
---|
1325 | use vars qw(%olbs);
|
---|
1326 |
|
---|
1327 | sub makeaperl {
|
---|
1328 | my($self, %attribs) = @_;
|
---|
1329 | my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) =
|
---|
1330 | @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
|
---|
1331 | my(@m);
|
---|
1332 | push @m, "
|
---|
1333 | # --- MakeMaker makeaperl section ---
|
---|
1334 | MAP_TARGET = $target
|
---|
1335 | ";
|
---|
1336 | return join '', @m if $self->{PARENT};
|
---|
1337 |
|
---|
1338 | my($dir) = join ":", @{$self->{DIR}};
|
---|
1339 |
|
---|
1340 | unless ($self->{MAKEAPERL}) {
|
---|
1341 | push @m, q{
|
---|
1342 | $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
|
---|
1343 | $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
|
---|
1344 | $(NOECHO) $(PERLRUNINST) \
|
---|
1345 | Makefile.PL DIR=}, $dir, q{ \
|
---|
1346 | FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
|
---|
1347 | MAKEAPERL=1 NORECURS=1 };
|
---|
1348 |
|
---|
1349 | push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
|
---|
1350 |
|
---|
1351 | $(MAP_TARGET) :: $(MAKE_APERL_FILE)
|
---|
1352 | $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
|
---|
1353 | };
|
---|
1354 | push @m, "\n";
|
---|
1355 |
|
---|
1356 | return join '', @m;
|
---|
1357 | }
|
---|
1358 |
|
---|
1359 |
|
---|
1360 | my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
|
---|
1361 | local($_);
|
---|
1362 |
|
---|
1363 | # The front matter of the linkcommand...
|
---|
1364 | $linkcmd = join ' ', $Config{'ld'},
|
---|
1365 | grep($_, @Config{qw(large split ldflags ccdlflags)});
|
---|
1366 | $linkcmd =~ s/\s+/ /g;
|
---|
1367 |
|
---|
1368 | # Which *.olb files could we make use of...
|
---|
1369 | local(%olbs); # XXX can this be lexical?
|
---|
1370 | $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
|
---|
1371 | require File::Find;
|
---|
1372 | File::Find::find(sub {
|
---|
1373 | return unless m/\Q$self->{LIB_EXT}\E$/;
|
---|
1374 | return if m/^libperl/;
|
---|
1375 |
|
---|
1376 | if( exists $self->{INCLUDE_EXT} ){
|
---|
1377 | my $found = 0;
|
---|
1378 | my $incl;
|
---|
1379 | my $xx;
|
---|
1380 |
|
---|
1381 | ($xx = $File::Find::name) =~ s,.*?/auto/,,;
|
---|
1382 | $xx =~ s,/?$_,,;
|
---|
1383 | $xx =~ s,/,::,g;
|
---|
1384 |
|
---|
1385 | # Throw away anything not explicitly marked for inclusion.
|
---|
1386 | # DynaLoader is implied.
|
---|
1387 | foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
|
---|
1388 | if( $xx eq $incl ){
|
---|
1389 | $found++;
|
---|
1390 | last;
|
---|
1391 | }
|
---|
1392 | }
|
---|
1393 | return unless $found;
|
---|
1394 | }
|
---|
1395 | elsif( exists $self->{EXCLUDE_EXT} ){
|
---|
1396 | my $excl;
|
---|
1397 | my $xx;
|
---|
1398 |
|
---|
1399 | ($xx = $File::Find::name) =~ s,.*?/auto/,,;
|
---|
1400 | $xx =~ s,/?$_,,;
|
---|
1401 | $xx =~ s,/,::,g;
|
---|
1402 |
|
---|
1403 | # Throw away anything explicitly marked for exclusion
|
---|
1404 | foreach $excl (@{$self->{EXCLUDE_EXT}}){
|
---|
1405 | return if( $xx eq $excl );
|
---|
1406 | }
|
---|
1407 | }
|
---|
1408 |
|
---|
1409 | $olbs{$ENV{DEFAULT}} = $_;
|
---|
1410 | }, grep( -d $_, @{$searchdirs || []}));
|
---|
1411 |
|
---|
1412 | # We trust that what has been handed in as argument will be buildable
|
---|
1413 | $static = [] unless $static;
|
---|
1414 | @olbs{@{$static}} = (1) x @{$static};
|
---|
1415 |
|
---|
1416 | $extra = [] unless $extra && ref $extra eq 'ARRAY';
|
---|
1417 | # Sort the object libraries in inverse order of
|
---|
1418 | # filespec length to try to insure that dependent extensions
|
---|
1419 | # will appear before their parents, so the linker will
|
---|
1420 | # search the parent library to resolve references.
|
---|
1421 | # (e.g. Intuit::DWIM will precede Intuit, so unresolved
|
---|
1422 | # references from [.intuit.dwim]dwim.obj can be found
|
---|
1423 | # in [.intuit]intuit.olb).
|
---|
1424 | for (sort { length($a) <=> length($b) } keys %olbs) {
|
---|
1425 | next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
|
---|
1426 | my($dir) = $self->fixpath($_,1);
|
---|
1427 | my($extralibs) = $dir . "extralibs.ld";
|
---|
1428 | my($extopt) = $dir . $olbs{$_};
|
---|
1429 | $extopt =~ s/$self->{LIB_EXT}$/.opt/;
|
---|
1430 | push @optlibs, "$dir$olbs{$_}";
|
---|
1431 | # Get external libraries this extension will need
|
---|
1432 | if (-f $extralibs ) {
|
---|
1433 | my %seenthis;
|
---|
1434 | open LIST,$extralibs or warn $!,next;
|
---|
1435 | while (<LIST>) {
|
---|
1436 | chomp;
|
---|
1437 | # Include a library in the link only once, unless it's mentioned
|
---|
1438 | # multiple times within a single extension's options file, in which
|
---|
1439 | # case we assume the builder needed to search it again later in the
|
---|
1440 | # link.
|
---|
1441 | my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
|
---|
1442 | $libseen{$_}++; $seenthis{$_}++;
|
---|
1443 | next if $skip;
|
---|
1444 | push @$extra,$_;
|
---|
1445 | }
|
---|
1446 | close LIST;
|
---|
1447 | }
|
---|
1448 | # Get full name of extension for ExtUtils::Miniperl
|
---|
1449 | if (-f $extopt) {
|
---|
1450 | open OPT,$extopt or die $!;
|
---|
1451 | while (<OPT>) {
|
---|
1452 | next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
|
---|
1453 | my $pkg = $1;
|
---|
1454 | $pkg =~ s#__*#::#g;
|
---|
1455 | push @staticpkgs,$pkg;
|
---|
1456 | }
|
---|
1457 | }
|
---|
1458 | }
|
---|
1459 | # Place all of the external libraries after all of the Perl extension
|
---|
1460 | # libraries in the final link, in order to maximize the opportunity
|
---|
1461 | # for XS code from multiple extensions to resolve symbols against the
|
---|
1462 | # same external library while only including that library once.
|
---|
1463 | push @optlibs, @$extra;
|
---|
1464 |
|
---|
1465 | $target = "Perl$Config{'exe_ext'}" unless $target;
|
---|
1466 | my $shrtarget;
|
---|
1467 | ($shrtarget,$targdir) = fileparse($target);
|
---|
1468 | $shrtarget =~ s/^([^.]*)/$1Shr/;
|
---|
1469 | $shrtarget = $targdir . $shrtarget;
|
---|
1470 | $target = "Perlshr.$Config{'dlext'}" unless $target;
|
---|
1471 | $tmpdir = "[]" unless $tmpdir;
|
---|
1472 | $tmpdir = $self->fixpath($tmpdir,1);
|
---|
1473 | if (@optlibs) { $extralist = join(' ',@optlibs); }
|
---|
1474 | else { $extralist = ''; }
|
---|
1475 | # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
|
---|
1476 | # that's what we're building here).
|
---|
1477 | push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
|
---|
1478 | if ($libperl) {
|
---|
1479 | unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
|
---|
1480 | print STDOUT "Warning: $libperl not found\n";
|
---|
1481 | undef $libperl;
|
---|
1482 | }
|
---|
1483 | }
|
---|
1484 | unless ($libperl) {
|
---|
1485 | if (defined $self->{PERL_SRC}) {
|
---|
1486 | $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
|
---|
1487 | } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
|
---|
1488 | } else {
|
---|
1489 | print STDOUT "Warning: $libperl not found
|
---|
1490 | If you're going to build a static perl binary, make sure perl is installed
|
---|
1491 | otherwise ignore this warning\n";
|
---|
1492 | }
|
---|
1493 | }
|
---|
1494 | $libperldir = $self->fixpath((fileparse($libperl))[1],1);
|
---|
1495 |
|
---|
1496 | push @m, '
|
---|
1497 | # Fill in the target you want to produce if it\'s not perl
|
---|
1498 | MAP_TARGET = ',$self->fixpath($target,0),'
|
---|
1499 | MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
|
---|
1500 | MAP_LINKCMD = $linkcmd
|
---|
1501 | MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
|
---|
1502 | MAP_EXTRA = $extralist
|
---|
1503 | MAP_LIBPERL = ",$self->fixpath($libperl,0),'
|
---|
1504 | ';
|
---|
1505 |
|
---|
1506 |
|
---|
1507 | push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
|
---|
1508 | foreach (@optlibs) {
|
---|
1509 | push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
|
---|
1510 | }
|
---|
1511 | push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
|
---|
1512 | push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
|
---|
1513 |
|
---|
1514 | push @m,'
|
---|
1515 | $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
|
---|
1516 | $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
|
---|
1517 | $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
|
---|
1518 | $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
|
---|
1519 | $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
|
---|
1520 | $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
|
---|
1521 | $(NOECHO) $(ECHO) "To remove the intermediate files, say
|
---|
1522 | $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
|
---|
1523 | ';
|
---|
1524 | push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
|
---|
1525 | push @m, "# More from the 255-char line length limit\n";
|
---|
1526 | foreach (@staticpkgs) {
|
---|
1527 | push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
|
---|
1528 | }
|
---|
1529 |
|
---|
1530 | push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
|
---|
1531 | $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
|
---|
1532 | $(NOECHO) $(RM_F) %sWritemain.tmp
|
---|
1533 | MAKE_FRAG
|
---|
1534 |
|
---|
1535 | push @m, q[
|
---|
1536 | # Still more from the 255-char line length limit
|
---|
1537 | doc_inst_perl :
|
---|
1538 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
|
---|
1539 | $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
|
---|
1540 | $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
|
---|
1541 | $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
|
---|
1542 | $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
|
---|
1543 | $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
|
---|
1544 | $(NOECHO) $(RM_F) .MM_tmp
|
---|
1545 | ];
|
---|
1546 |
|
---|
1547 | push @m, "
|
---|
1548 | inst_perl : pure_inst_perl doc_inst_perl
|
---|
1549 | \$(NOECHO) \$(NOOP)
|
---|
1550 |
|
---|
1551 | pure_inst_perl : \$(MAP_TARGET)
|
---|
1552 | $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
|
---|
1553 | $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
|
---|
1554 |
|
---|
1555 | clean :: map_clean
|
---|
1556 | \$(NOECHO) \$(NOOP)
|
---|
1557 |
|
---|
1558 | map_clean :
|
---|
1559 | \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
|
---|
1560 | \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
|
---|
1561 | ";
|
---|
1562 |
|
---|
1563 | join '', @m;
|
---|
1564 | }
|
---|
1565 |
|
---|
1566 | # --- Output postprocessing section ---
|
---|
1567 |
|
---|
1568 | =item nicetext (override)
|
---|
1569 |
|
---|
1570 | Insure that colons marking targets are preceded by space, in order
|
---|
1571 | to distinguish the target delimiter from a colon appearing as
|
---|
1572 | part of a filespec.
|
---|
1573 |
|
---|
1574 | =cut
|
---|
1575 |
|
---|
1576 | sub nicetext {
|
---|
1577 | my($self,$text) = @_;
|
---|
1578 | return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone
|
---|
1579 | $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
|
---|
1580 | $text;
|
---|
1581 | }
|
---|
1582 |
|
---|
1583 | =item prefixify (override)
|
---|
1584 |
|
---|
1585 | prefixifying on VMS is simple. Each should simply be:
|
---|
1586 |
|
---|
1587 | perl_root:[some.dir]
|
---|
1588 |
|
---|
1589 | which can just be converted to:
|
---|
1590 |
|
---|
1591 | volume:[your.prefix.some.dir]
|
---|
1592 |
|
---|
1593 | otherwise you get the default layout.
|
---|
1594 |
|
---|
1595 | In effect, your search prefix is ignored and $Config{vms_prefix} is
|
---|
1596 | used instead.
|
---|
1597 |
|
---|
1598 | =cut
|
---|
1599 |
|
---|
1600 | sub prefixify {
|
---|
1601 | my($self, $var, $sprefix, $rprefix, $default) = @_;
|
---|
1602 |
|
---|
1603 | # Translate $(PERLPREFIX) to a real path.
|
---|
1604 | $rprefix = $self->eliminate_macros($rprefix);
|
---|
1605 | $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
|
---|
1606 | $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
|
---|
1607 |
|
---|
1608 | $default = VMS::Filespec::vmsify($default)
|
---|
1609 | unless $default =~ /\[.*\]/;
|
---|
1610 |
|
---|
1611 | (my $var_no_install = $var) =~ s/^install//;
|
---|
1612 | my $path = $self->{uc $var} ||
|
---|
1613 | $ExtUtils::MM_Unix::Config_Override{lc $var} ||
|
---|
1614 | $Config{lc $var} || $Config{lc $var_no_install};
|
---|
1615 |
|
---|
1616 | if( !$path ) {
|
---|
1617 | print STDERR " no Config found for $var.\n" if $Verbose >= 2;
|
---|
1618 | $path = $self->_prefixify_default($rprefix, $default);
|
---|
1619 | }
|
---|
1620 | elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
|
---|
1621 | # do nothing if there's no prefix or if its relative
|
---|
1622 | }
|
---|
1623 | elsif( $sprefix eq $rprefix ) {
|
---|
1624 | print STDERR " no new prefix.\n" if $Verbose >= 2;
|
---|
1625 | }
|
---|
1626 | else {
|
---|
1627 |
|
---|
1628 | print STDERR " prefixify $var => $path\n" if $Verbose >= 2;
|
---|
1629 | print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2;
|
---|
1630 |
|
---|
1631 | my($path_vol, $path_dirs) = $self->splitpath( $path );
|
---|
1632 | if( $path_vol eq $Config{vms_prefix}.':' ) {
|
---|
1633 | print STDERR " $Config{vms_prefix}: seen\n" if $Verbose >= 2;
|
---|
1634 |
|
---|
1635 | $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
|
---|
1636 | $path = $self->_catprefix($rprefix, $path_dirs);
|
---|
1637 | }
|
---|
1638 | else {
|
---|
1639 | $path = $self->_prefixify_default($rprefix, $default);
|
---|
1640 | }
|
---|
1641 | }
|
---|
1642 |
|
---|
1643 | print " now $path\n" if $Verbose >= 2;
|
---|
1644 | return $self->{uc $var} = $path;
|
---|
1645 | }
|
---|
1646 |
|
---|
1647 |
|
---|
1648 | sub _prefixify_default {
|
---|
1649 | my($self, $rprefix, $default) = @_;
|
---|
1650 |
|
---|
1651 | print STDERR " cannot prefix, using default.\n" if $Verbose >= 2;
|
---|
1652 |
|
---|
1653 | if( !$default ) {
|
---|
1654 | print STDERR "No default!\n" if $Verbose >= 1;
|
---|
1655 | return;
|
---|
1656 | }
|
---|
1657 | if( !$rprefix ) {
|
---|
1658 | print STDERR "No replacement prefix!\n" if $Verbose >= 1;
|
---|
1659 | return '';
|
---|
1660 | }
|
---|
1661 |
|
---|
1662 | return $self->_catprefix($rprefix, $default);
|
---|
1663 | }
|
---|
1664 |
|
---|
1665 | sub _catprefix {
|
---|
1666 | my($self, $rprefix, $default) = @_;
|
---|
1667 |
|
---|
1668 | my($rvol, $rdirs) = $self->splitpath($rprefix);
|
---|
1669 | if( $rvol ) {
|
---|
1670 | return $self->catpath($rvol,
|
---|
1671 | $self->catdir($rdirs, $default),
|
---|
1672 | ''
|
---|
1673 | )
|
---|
1674 | }
|
---|
1675 | else {
|
---|
1676 | return $self->catdir($rdirs, $default);
|
---|
1677 | }
|
---|
1678 | }
|
---|
1679 |
|
---|
1680 |
|
---|
1681 | =item cd
|
---|
1682 |
|
---|
1683 | =cut
|
---|
1684 |
|
---|
1685 | sub cd {
|
---|
1686 | my($self, $dir, @cmds) = @_;
|
---|
1687 |
|
---|
1688 | $dir = vmspath($dir);
|
---|
1689 |
|
---|
1690 | my $cmd = join "\n\t", map "$_", @cmds;
|
---|
1691 |
|
---|
1692 | # No leading tab makes it look right when embedded
|
---|
1693 | my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
|
---|
1694 | startdir = F$Environment("Default")
|
---|
1695 | Set Default %s
|
---|
1696 | %s
|
---|
1697 | Set Default 'startdir'
|
---|
1698 | MAKE_FRAG
|
---|
1699 |
|
---|
1700 | # No trailing newline makes this easier to embed
|
---|
1701 | chomp $make_frag;
|
---|
1702 |
|
---|
1703 | return $make_frag;
|
---|
1704 | }
|
---|
1705 |
|
---|
1706 |
|
---|
1707 | =item oneliner
|
---|
1708 |
|
---|
1709 | =cut
|
---|
1710 |
|
---|
1711 | sub oneliner {
|
---|
1712 | my($self, $cmd, $switches) = @_;
|
---|
1713 | $switches = [] unless defined $switches;
|
---|
1714 |
|
---|
1715 | # Strip leading and trailing newlines
|
---|
1716 | $cmd =~ s{^\n+}{};
|
---|
1717 | $cmd =~ s{\n+$}{};
|
---|
1718 |
|
---|
1719 | $cmd = $self->quote_literal($cmd);
|
---|
1720 | $cmd = $self->escape_newlines($cmd);
|
---|
1721 |
|
---|
1722 | # Switches must be quoted else they will be lowercased.
|
---|
1723 | $switches = join ' ', map { qq{"$_"} } @$switches;
|
---|
1724 |
|
---|
1725 | return qq{\$(ABSPERLRUN) $switches -e $cmd};
|
---|
1726 | }
|
---|
1727 |
|
---|
1728 |
|
---|
1729 | =item B<echo>
|
---|
1730 |
|
---|
1731 | perl trips up on "<foo>" thinking it's an input redirect. So we use the
|
---|
1732 | native Write command instead. Besides, its faster.
|
---|
1733 |
|
---|
1734 | =cut
|
---|
1735 |
|
---|
1736 | sub echo {
|
---|
1737 | my($self, $text, $file, $appending) = @_;
|
---|
1738 | $appending ||= 0;
|
---|
1739 |
|
---|
1740 | my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
|
---|
1741 |
|
---|
1742 | my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
|
---|
1743 | push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) }
|
---|
1744 | split /\n/, $text;
|
---|
1745 | push @cmds, '$(NOECHO) Close MMECHOFILE';
|
---|
1746 | return @cmds;
|
---|
1747 | }
|
---|
1748 |
|
---|
1749 |
|
---|
1750 | =item quote_literal
|
---|
1751 |
|
---|
1752 | =cut
|
---|
1753 |
|
---|
1754 | sub quote_literal {
|
---|
1755 | my($self, $text) = @_;
|
---|
1756 |
|
---|
1757 | # I believe this is all we should need.
|
---|
1758 | $text =~ s{"}{""}g;
|
---|
1759 |
|
---|
1760 | return qq{"$text"};
|
---|
1761 | }
|
---|
1762 |
|
---|
1763 | =item escape_newlines
|
---|
1764 |
|
---|
1765 | =cut
|
---|
1766 |
|
---|
1767 | sub escape_newlines {
|
---|
1768 | my($self, $text) = @_;
|
---|
1769 |
|
---|
1770 | $text =~ s{\n}{-\n}g;
|
---|
1771 |
|
---|
1772 | return $text;
|
---|
1773 | }
|
---|
1774 |
|
---|
1775 | =item max_exec_len
|
---|
1776 |
|
---|
1777 | 256 characters.
|
---|
1778 |
|
---|
1779 | =cut
|
---|
1780 |
|
---|
1781 | sub max_exec_len {
|
---|
1782 | my $self = shift;
|
---|
1783 |
|
---|
1784 | return $self->{_MAX_EXEC_LEN} ||= 256;
|
---|
1785 | }
|
---|
1786 |
|
---|
1787 | =item init_linker
|
---|
1788 |
|
---|
1789 | =cut
|
---|
1790 |
|
---|
1791 | sub init_linker {
|
---|
1792 | my $self = shift;
|
---|
1793 | $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
|
---|
1794 |
|
---|
1795 | my $shr = $Config{dbgprefix} . 'PERLSHR';
|
---|
1796 | if ($self->{PERL_SRC}) {
|
---|
1797 | $self->{PERL_ARCHIVE} ||=
|
---|
1798 | $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
|
---|
1799 | }
|
---|
1800 | else {
|
---|
1801 | $self->{PERL_ARCHIVE} ||=
|
---|
1802 | $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
|
---|
1803 | }
|
---|
1804 |
|
---|
1805 | $self->{PERL_ARCHIVE_AFTER} ||= '';
|
---|
1806 | }
|
---|
1807 |
|
---|
1808 | =item eliminate_macros
|
---|
1809 |
|
---|
1810 | Expands MM[KS]/Make macros in a text string, using the contents of
|
---|
1811 | identically named elements of C<%$self>, and returns the result
|
---|
1812 | as a file specification in Unix syntax.
|
---|
1813 |
|
---|
1814 | NOTE: This is the canonical version of the method. The version in
|
---|
1815 | File::Spec::VMS is deprecated.
|
---|
1816 |
|
---|
1817 | =cut
|
---|
1818 |
|
---|
1819 | sub eliminate_macros {
|
---|
1820 | my($self,$path) = @_;
|
---|
1821 | return '' unless $path;
|
---|
1822 | $self = {} unless ref $self;
|
---|
1823 |
|
---|
1824 | if ($path =~ /\s/) {
|
---|
1825 | return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
|
---|
1826 | }
|
---|
1827 |
|
---|
1828 | my($npath) = unixify($path);
|
---|
1829 | # sometimes unixify will return a string with an off-by-one trailing null
|
---|
1830 | $npath =~ s{\0$}{};
|
---|
1831 |
|
---|
1832 | my($complex) = 0;
|
---|
1833 | my($head,$macro,$tail);
|
---|
1834 |
|
---|
1835 | # perform m##g in scalar context so it acts as an iterator
|
---|
1836 | while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
|
---|
1837 | if (defined $self->{$2}) {
|
---|
1838 | ($head,$macro,$tail) = ($1,$2,$3);
|
---|
1839 | if (ref $self->{$macro}) {
|
---|
1840 | if (ref $self->{$macro} eq 'ARRAY') {
|
---|
1841 | $macro = join ' ', @{$self->{$macro}};
|
---|
1842 | }
|
---|
1843 | else {
|
---|
1844 | print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
|
---|
1845 | "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
|
---|
1846 | $macro = "\cB$macro\cB";
|
---|
1847 | $complex = 1;
|
---|
1848 | }
|
---|
1849 | }
|
---|
1850 | else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
|
---|
1851 | $npath = "$head$macro$tail";
|
---|
1852 | }
|
---|
1853 | }
|
---|
1854 | if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
|
---|
1855 | $npath;
|
---|
1856 | }
|
---|
1857 |
|
---|
1858 | =item fixpath
|
---|
1859 |
|
---|
1860 | my $path = $mm->fixpath($path);
|
---|
1861 | my $path = $mm->fixpath($path, $is_dir);
|
---|
1862 |
|
---|
1863 | Catchall routine to clean up problem MM[SK]/Make macros. Expands macros
|
---|
1864 | in any directory specification, in order to avoid juxtaposing two
|
---|
1865 | VMS-syntax directories when MM[SK] is run. Also expands expressions which
|
---|
1866 | are all macro, so that we can tell how long the expansion is, and avoid
|
---|
1867 | overrunning DCL's command buffer when MM[KS] is running.
|
---|
1868 |
|
---|
1869 | fixpath() checks to see whether the result matches the name of a
|
---|
1870 | directory in the current default directory and returns a directory or
|
---|
1871 | file specification accordingly. C<$is_dir> can be set to true to
|
---|
1872 | force fixpath() to consider the path to be a directory or false to force
|
---|
1873 | it to be a file.
|
---|
1874 |
|
---|
1875 | NOTE: This is the canonical version of the method. The version in
|
---|
1876 | File::Spec::VMS is deprecated.
|
---|
1877 |
|
---|
1878 | =cut
|
---|
1879 |
|
---|
1880 | sub fixpath {
|
---|
1881 | my($self,$path,$force_path) = @_;
|
---|
1882 | return '' unless $path;
|
---|
1883 | $self = bless {} unless ref $self;
|
---|
1884 | my($fixedpath,$prefix,$name);
|
---|
1885 |
|
---|
1886 | if ($path =~ /[ \t]/) {
|
---|
1887 | return join ' ',
|
---|
1888 | map { $self->fixpath($_,$force_path) }
|
---|
1889 | split /[ \t]+/, $path;
|
---|
1890 | }
|
---|
1891 |
|
---|
1892 | if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
|
---|
1893 | if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
|
---|
1894 | $fixedpath = vmspath($self->eliminate_macros($path));
|
---|
1895 | }
|
---|
1896 | else {
|
---|
1897 | $fixedpath = vmsify($self->eliminate_macros($path));
|
---|
1898 | }
|
---|
1899 | }
|
---|
1900 | elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
|
---|
1901 | my($vmspre) = $self->eliminate_macros("\$($prefix)");
|
---|
1902 | # is it a dir or just a name?
|
---|
1903 | $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
|
---|
1904 | $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
|
---|
1905 | $fixedpath = vmspath($fixedpath) if $force_path;
|
---|
1906 | }
|
---|
1907 | else {
|
---|
1908 | $fixedpath = $path;
|
---|
1909 | $fixedpath = vmspath($fixedpath) if $force_path;
|
---|
1910 | }
|
---|
1911 | # No hints, so we try to guess
|
---|
1912 | if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
|
---|
1913 | $fixedpath = vmspath($fixedpath) if -d $fixedpath;
|
---|
1914 | }
|
---|
1915 |
|
---|
1916 | # Trim off root dirname if it's had other dirs inserted in front of it.
|
---|
1917 | $fixedpath =~ s/\.000000([\]>])/$1/;
|
---|
1918 | # Special case for VMS absolute directory specs: these will have had device
|
---|
1919 | # prepended during trip through Unix syntax in eliminate_macros(), since
|
---|
1920 | # Unix syntax has no way to express "absolute from the top of this device's
|
---|
1921 | # directory tree".
|
---|
1922 | if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
|
---|
1923 |
|
---|
1924 | return $fixedpath;
|
---|
1925 | }
|
---|
1926 |
|
---|
1927 |
|
---|
1928 | =item os_flavor
|
---|
1929 |
|
---|
1930 | VMS is VMS.
|
---|
1931 |
|
---|
1932 | =cut
|
---|
1933 |
|
---|
1934 | sub os_flavor {
|
---|
1935 | return('VMS');
|
---|
1936 | }
|
---|
1937 |
|
---|
1938 | =back
|
---|
1939 |
|
---|
1940 |
|
---|
1941 | =head1 AUTHOR
|
---|
1942 |
|
---|
1943 | Original author Charles Bailey F<[email protected]>
|
---|
1944 |
|
---|
1945 | Maintained by Michael G Schwern F<[email protected]>
|
---|
1946 |
|
---|
1947 | See L<ExtUtils::MakeMaker> for patching and contact information.
|
---|
1948 |
|
---|
1949 |
|
---|
1950 | =cut
|
---|
1951 |
|
---|
1952 | 1;
|
---|
1953 |
|
---|