Commit | Line | Data |
---|---|---|
684427cc | 1 | package ExtUtils::MM_VMS; |
2 | ||
b75c8c73 MS |
3 | use strict; |
4 | ||
7292dc67 | 5 | use ExtUtils::MakeMaker::Config; |
684427cc | 6 | require Exporter; |
479d2113 MS |
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 | ||
684427cc | 16 | use File::Basename; |
7292dc67 RGS |
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'; | |
9607fc9c | 22 | |
f6d6199c MS |
23 | require ExtUtils::MM_Any; |
24 | require ExtUtils::MM_Unix; | |
479d2113 | 25 | @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); |
f6d6199c MS |
26 | |
27 | use ExtUtils::MakeMaker qw($Verbose neatvalue); | |
7292dc67 | 28 | $Revision = $ExtUtils::MakeMaker::Revision; |
9607fc9c | 29 | |
684427cc | 30 | |
8e03a37c | 31 | =head1 NAME |
32 | ||
33 | ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker | |
34 | ||
35 | =head1 SYNOPSIS | |
36 | ||
f6d6199c MS |
37 | Do not use this directly. |
38 | Instead, use ExtUtils::MM and it will figure out which MM_* | |
39 | class to use for you. | |
8e03a37c | 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 | ||
bbc7dcd2 | 49 | =over 4 |
2ae324a7 | 50 | |
bbce6d69 | 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); | |
bbce6d69 | 60 | |
479d2113 | 61 | foreach my $word (@_) { |
bbce6d69 | 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/; | |
17f28c40 | 66 | $line .= ' ' if length($line); |
bbce6d69 | 67 | if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; } |
68 | $line .= $word; | |
69 | $hlen += length($word) + 2; | |
70 | } | |
71 | $line; | |
72 | } | |
73 | ||
55497cff | 74 | |
75 | # This isn't really an override. It's just here because ExtUtils::MM_VMS | |
e97e32e6 | 76 | # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext() |
55497cff | 77 | # in MM_VMS, then AUTOLOAD is called, and bad things happen. So, we just |
e97e32e6 | 78 | # mimic inheritance here and hand off to ExtUtils::Liblist::Kid. |
f6d6199c | 79 | # XXX This hackery will die soon. --Schwern |
55497cff | 80 | sub ext { |
f6d6199c MS |
81 | require ExtUtils::Liblist::Kid; |
82 | goto &ExtUtils::Liblist::Kid::ext; | |
55497cff | 83 | } |
84 | ||
2ae324a7 | 85 | =back |
55497cff | 86 | |
f6d6199c | 87 | =head2 Methods |
8e03a37c | 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 | ||
bbc7dcd2 | 95 | =over 4 |
2ae324a7 | 96 | |
8e03a37c | 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 | |
684427cc | 107 | |
684427cc | 108 | sub guess_name { |
109 | my($self) = @_; | |
55497cff | 110 | my($defname,$defpm,@pm,%xs,$pm); |
684427cc | 111 | local *PM; |
112 | ||
f1387719 | 113 | $defname = basename(fileify($ENV{'DEFAULT'})); |
114 | $defname =~ s![\d\-_]*\.dir.*$!!; # Clip off .dir;1 suffix, and package version | |
115 | $defpm = $defname; | |
55497cff | 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'); | |
f6d6199c MS |
125 | if (keys %xs) { |
126 | foreach $pm (@pm) { | |
127 | $defpm = $pm, last if exists $xs{$pm}; | |
128 | } | |
129 | } | |
55497cff | 130 | } |
131 | } | |
684427cc | 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 | } | |
f1387719 | 148 | $defname =~ s#[\d.\-_]+$##; |
684427cc | 149 | $defname; |
150 | } | |
151 | ||
8e03a37c | 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 | |
684427cc | 158 | |
5ab4150f | 159 | sub find_perl { |
684427cc | 160 | my($self, $ver, $names, $dirs, $trace) = @_; |
8e03a37c | 161 | my($name,$dir,$vmsfile,@sdirs,@snames,@cand); |
62ecdc92 | 162 | my($rslt); |
81ff29e3 | 163 | my($inabs) = 0; |
62ecdc92 | 164 | local *TCF; |
30361541 JH |
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 | ||
81ff29e3 | 192 | # Image names containing Perl version use '_' instead of '.' under VMS |
193 | foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; } | |
5ab4150f | 194 | if ($trace >= 2){ |
684427cc | 195 | print "Looking for perl $ver by these names:\n"; |
8e03a37c | 196 | print "\t@snames,\n"; |
684427cc | 197 | print "in these dirs:\n"; |
8e03a37c | 198 | print "\t@sdirs\n"; |
684427cc | 199 | } |
8e03a37c | 200 | foreach $dir (@sdirs){ |
684427cc | 201 | next unless defined $dir; # $self->{PERL_SRC} may be undefined |
479d2113 | 202 | $inabs++ if $self->file_name_is_absolute($dir); |
81ff29e3 | 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 | } | |
8e03a37c | 210 | foreach $name (@snames){ |
479d2113 | 211 | if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); } |
b7b1864f | 212 | else { push(@cand,$self->fixpath($name,0)); } |
684427cc | 213 | } |
214 | } | |
8e03a37c | 215 | foreach $name (@cand) { |
684427cc | 216 | print "Checking $name\n" if ($trace >= 2); |
81ff29e3 | 217 | # If it looks like a potential command, try it without the MCR |
62ecdc92 CB |
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/) { | |
479d2113 MS |
226 | print "Using PERL=$name\n" if $trace; |
227 | return $name; | |
228 | } | |
62ecdc92 | 229 | } |
684427cc | 230 | next unless $vmsfile = $self->maybe_command($name); |
f1387719 | 231 | $vmsfile =~ s/;[\d\-]*$//; # Clip off version number; we can use a newer version as well |
684427cc | 232 | print "Executing $vmsfile\n" if ($trace >= 2); |
62ecdc92 CB |
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/) { | |
684427cc | 240 | print "Using PERL=MCR $vmsfile\n" if $trace; |
81ff29e3 | 241 | return "MCR $vmsfile"; |
684427cc | 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 | ||
8e03a37c | 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, | |
ff0cee69 | 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. | |
8e03a37c | 256 | |
257 | =cut | |
a5f75d66 | 258 | |
684427cc | 259 | sub maybe_command { |
260 | my($self,$file) = @_; | |
261 | return $file if -x $file && ! -d _; | |
ff0cee69 | 262 | my(@dirs) = (''); |
263 | my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); | |
264 | my($dir,$ext); | |
684427cc | 265 | if ($file !~ m![/:>\]]!) { |
ff0cee69 | 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 | } | |
684427cc | 278 | } |
279 | return 0; | |
280 | } | |
281 | ||
7292dc67 RGS |
282 | |
283 | =item pasthru (override) | |
284 | ||
285 | VMS has $(MMSQUALIFIERS) which is a listing of all the original command line | |
3c4b39be | 286 | options. This is used in every invocation of make in the VMS Makefile so |
7292dc67 RGS |
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 | ||
8e03a37c | 327 | =item perl_script (override) |
328 | ||
ff0cee69 | 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 | |
8e03a37c | 331 | under VMS. |
332 | ||
333 | =cut | |
684427cc | 334 | |
335 | sub perl_script { | |
336 | my($self,$file) = @_; | |
337 | return $file if -r $file && ! -d _; | |
ff0cee69 | 338 | return "$file.com" if -r "$file.com"; |
339 | return "$file.pl" if -r "$file.pl"; | |
684427cc | 340 | return ''; |
341 | } | |
342 | ||
7292dc67 | 343 | |
8e03a37c | 344 | =item replace_manpage_separator |
345 | ||
346 | Use as separator a character which is legal in a VMS-syntax file name. | |
347 | ||
348 | =cut | |
684427cc | 349 | |
350 | sub replace_manpage_separator { | |
351 | my($self,$man) = @_; | |
352 | $man = unixify($man); | |
353 | $man =~ s#/+#__#g; | |
354 | $man; | |
355 | } | |
356 | ||
5e719f03 MS |
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 | ||
479d2113 MS |
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 | ||
e0678a30 MS |
391 | =item init_main (override) |
392 | ||
e0678a30 MS |
393 | |
394 | =cut | |
395 | ||
396 | sub init_main { | |
397 | my($self) = shift; | |
398 | ||
399 | $self->SUPER::init_main; | |
479d2113 MS |
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 | } | |
e0678a30 MS |
428 | } |
429 | ||
8e03a37c | 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 | ||
479d2113 MS |
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 | ||
8e03a37c | 442 | =cut |
684427cc | 443 | |
444 | sub init_others { | |
445 | my($self) = @_; | |
684427cc | 446 | |
479d2113 MS |
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 | ||
7292dc67 RGS |
455 | $self->{MACROSTART} ||= '/Macro=('; |
456 | $self->{MACROEND} ||= ')'; | |
457 | $self->{USEMAKEFILE} ||= '/Descrip='; | |
458 | ||
5dca256e RGS |
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])"'; | |
479d2113 MS |
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 | ||
7292dc67 RGS |
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 | ||
5ab4150f | 481 | $self->{UMASK_NULL} = '! '; |
479d2113 | 482 | |
7292dc67 RGS |
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} = ''; | |
479d2113 MS |
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}; | |
684427cc | 517 | } |
518 | ||
479d2113 MS |
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 | ||
8e03a37c | 556 | =item constants (override) |
557 | ||
558 | Fixes up numerous file and directory macros to insure VMS syntax | |
479d2113 MS |
559 | regardless of input syntax. Also makes lists of files |
560 | comma-separated. | |
8e03a37c | 561 | |
562 | =cut | |
a5f75d66 | 563 | |
684427cc | 564 | sub constants { |
565 | my($self) = @_; | |
684427cc | 566 | |
d5e3fa33 CB |
567 | # Be kind about case for pollution |
568 | for (@ARGV) { $_ = uc($_) if /POLLUTE/i; } | |
569 | ||
479d2113 MS |
570 | # Cleanup paths for directories in MMS macros. |
571 | foreach my $macro ( qw [ | |
5c161494 | 572 | INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB |
5c161494 | 573 | PERL_LIB PERL_ARCHLIB |
5e719f03 MS |
574 | PERL_INC PERL_SRC ], |
575 | (map { 'INSTALL'.$_ } $self->installvars) | |
576 | ) | |
479d2113 MS |
577 | { |
578 | next unless defined $self->{$macro}; | |
45bc4d3a | 579 | next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; |
479d2113 | 580 | $self->{$macro} = $self->fixpath($self->{$macro},1); |
a5f75d66 AD |
581 | } |
582 | ||
479d2113 MS |
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); | |
5ab4150f | 589 | } |
590 | ||
479d2113 MS |
591 | # Fixup files for MMS macros |
592 | # XXX is this list complete? | |
593 | for my $macro (qw/ | |
594 | FULLEXT VERSION_FROM OBJECT LDFROM | |
a5f75d66 | 595 | / ) { |
479d2113 MS |
596 | next unless defined $self->{$macro}; |
597 | $self->{$macro} = $self->fixpath($self->{$macro},0); | |
a5f75d66 AD |
598 | } |
599 | ||
f1387719 | 600 | |
479d2113 MS |
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; | |
f1387719 | 610 | } |
611 | ||
479d2113 MS |
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; | |
a5f75d66 | 619 | } |
684427cc | 620 | |
7292dc67 RGS |
621 | # mms/k does not define a $(MAKE) macro. |
622 | $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)'; | |
623 | ||
479d2113 MS |
624 | return $self->SUPER::constants; |
625 | } | |
9cae3221 | 626 | |
684427cc | 627 | |
479d2113 | 628 | =item special_targets |
684427cc | 629 | |
479d2113 | 630 | Clear the default .SUFFIXES and put in our own list. |
684427cc | 631 | |
479d2113 | 632 | =cut |
684427cc | 633 | |
479d2113 MS |
634 | sub special_targets { |
635 | my $self = shift; | |
684427cc | 636 | |
479d2113 MS |
637 | my $make_frag .= <<'MAKE_FRAG'; |
638 | .SUFFIXES : | |
639 | .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs | |
8e03a37c | 640 | |
479d2113 | 641 | MAKE_FRAG |
684427cc | 642 | |
479d2113 | 643 | return $make_frag; |
684427cc | 644 | } |
645 | ||
8e03a37c | 646 | =item cflags (override) |
684427cc | 647 | |
8e03a37c | 648 | Bypass shell script and produce qualifiers for CC directly (but warn |
649 | user if a shell script for this extension exists). Fold multiple | |
5ab4150f | 650 | /Defines into one, since some C compilers pay attention to only one |
651 | instance of this qualifier on the command line. | |
8e03a37c | 652 | |
653 | =cut | |
654 | ||
655 | sub cflags { | |
684427cc | 656 | my($self,$libperl) = @_; |
09b7f37c CB |
657 | my($quals) = $self->{CCFLAGS} || $Config{'ccflags'}; |
658 | my($definestr,$undefstr,$flagoptstr) = ('','',''); | |
659 | my($incstr) = '/Include=($(PERL_INC)'; | |
684427cc | 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 | ||
09b7f37c CB |
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",]; } | |
0c2a65fc | 679 | elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); } |
09b7f37c CB |
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 | } | |
d5e3fa33 | 687 | $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE}; |
09b7f37c CB |
688 | if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; } |
689 | if (length $undefstr) { chop($undefstr); $quals .= "/Undef=($undefstr)"; } | |
684427cc | 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 | |
09b7f37c | 692 | # conflate the ones from $Config{'ccflags'} and $self->{DEFINE} |
1f47e8e2 CB |
693 | # ($self->{DEFINE} has already been VMSified in constants() above) |
694 | if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; } | |
18541947 | 695 | for my $type (qw(Def Undef)) { |
1f47e8e2 CB |
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 | } | |
684427cc | 709 | } |
710 | ||
711 | $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb"; | |
684427cc | 712 | |
713 | # Likewise with $self->{INC} and /Include | |
684427cc | 714 | if ($self->{'INC'}) { |
715 | my(@includes) = split(/\s+/,$self->{INC}); | |
716 | foreach (@includes) { | |
717 | s/^-I//; | |
0c2a65fc | 718 | $incstr .= ','.$self->fixpath($_,1); |
684427cc | 719 | } |
720 | } | |
5ab4150f | 721 | $quals .= "$incstr)"; |
1f47e8e2 | 722 | # $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g; |
09b7f37c | 723 | $self->{CCFLAGS} = $quals; |
684427cc | 724 | |
e0678a30 MS |
725 | $self->{PERLTYPE} ||= ''; |
726 | ||
09b7f37c CB |
727 | $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; |
728 | if ($self->{OPTIMIZE} !~ m!/!) { | |
c1c69de6 | 729 | if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' } |
09b7f37c CB |
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 | } | |
8e03a37c | 738 | |
739 | return $self->{CFLAGS} = qq{ | |
09b7f37c CB |
740 | CCFLAGS = $self->{CCFLAGS} |
741 | OPTIMIZE = $self->{OPTIMIZE} | |
742 | PERLTYPE = $self->{PERLTYPE} | |
8e03a37c | 743 | }; |
744 | } | |
745 | ||
746 | =item const_cccmd (override) | |
747 | ||
748 | Adds directives to point C preprocessor to the right place when | |
81ff29e3 | 749 | handling #include E<lt>sys/foo.hE<gt> directives. Also constructs CC |
8e03a37c | 750 | command line a bit differently than MM_Unix method. |
684427cc | 751 | |
8e03a37c | 752 | =cut |
753 | ||
754 | sub const_cccmd { | |
755 | my($self,$libperl) = @_; | |
8e03a37c | 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') { | |
684427cc | 761 | push @m,' |
762 | .FIRST | |
8e03a37c | 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 ', | |
e0678a30 | 775 | ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),' |
8e03a37c | 776 | ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include'; |
777 | } | |
684427cc | 778 | |
8e03a37c | 779 | push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n"); |
684427cc | 780 | |
8e03a37c | 781 | $self->{CONST_CCCMD} = join('',@m); |
684427cc | 782 | } |
783 | ||
684427cc | 784 | |
8e03a37c | 785 | =item tools_other (override) |
786 | ||
479d2113 MS |
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. | |
8e03a37c | 790 | |
791 | =cut | |
684427cc | 792 | |
793 | sub tools_other { | |
794 | my($self) = @_; | |
479d2113 MS |
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 | ||
479d2113 | 800 | # Just in case anyone is using the old macro. |
7292dc67 | 801 | USEMACROS = $(MACROSTART) |
dedf98bc | 802 | SAY = $(ECHO) |
479d2113 MS |
803 | |
804 | EXTRA_TOOLS | |
805 | ||
806 | return $self->SUPER::tools_other . $extra_tools; | |
684427cc | 807 | } |
808 | ||
479d2113 | 809 | =item init_dist (override) |
8e03a37c | 810 | |
479d2113 | 811 | VMSish defaults for some values. |
8e03a37c | 812 | |
479d2113 | 813 | macro description default |
684427cc | 814 | |
479d2113 | 815 | ZIPFLAGS flags to pass to ZIP -Vu |
8e03a37c | 816 | |
479d2113 MS |
817 | COMPRESS compression command to gzip |
818 | use for tarfiles | |
819 | SUFFIX suffix to put on -gz | |
820 | compressed files | |
2ae324a7 | 821 | |
479d2113 | 822 | SHAR shar command to use vms_share |
e0678a30 | 823 | |
479d2113 MS |
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}"; | |
684427cc | 843 | } |
844 | ||
8e03a37c | 845 | =item c_o (override) |
684427cc | 846 | |
8e03a37c | 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 | |
684427cc | 851 | |
852 | sub c_o { | |
853 | my($self) = @_; | |
684427cc | 854 | return '' unless $self->needs_linking(); |
855 | ' | |
856 | .c$(OBJ_EXT) : | |
857 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c | |
8e03a37c | 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 | ||
684427cc | 865 | '; |
866 | } | |
867 | ||
8e03a37c | 868 | =item xs_c (override) |
869 | ||
870 | Use MM[SK] macros. | |
871 | ||
872 | =cut | |
873 | ||
684427cc | 874 | sub xs_c { |
875 | my($self) = @_; | |
684427cc | 876 | return '' unless $self->needs_linking(); |
877 | ' | |
878 | .xs.c : | |
7292dc67 | 879 | $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET) |
684427cc | 880 | '; |
881 | } | |
882 | ||
8e03a37c | 883 | =item xs_o (override) |
884 | ||
885 | Use MM[SK] macros, and VMS command line for C compiler. | |
886 | ||
887 | =cut | |
888 | ||
684427cc | 889 | sub xs_o { # many makes are too dumb to use xs_c then c_o |
890 | my($self) = @_; | |
684427cc | 891 | return '' unless $self->needs_linking(); |
892 | ' | |
893 | .xs$(OBJ_EXT) : | |
7292dc67 | 894 | $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c |
684427cc | 895 | $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c |
896 | '; | |
897 | } | |
898 | ||
684427cc | 899 | |
8e03a37c | 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 | |
684427cc | 907 | |
908 | sub dlsyms { | |
909 | my($self,%attribs) = @_; | |
0d8023a2 | 910 | |
911 | return '' unless $self->needs_linking(); | |
912 | ||
684427cc | 913 | my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}; |
a5f75d66 | 914 | my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || []; |
762efda7 | 915 | my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || []; |
684427cc | 916 | my(@m); |
917 | ||
a5f75d66 AD |
918 | unless ($self->{SKIPHASH}{'dynamic'}) { |
919 | push(@m,' | |
09b7f37c | 920 | dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt |
5ab4150f | 921 | $(NOECHO) $(NOOP) |
a5f75d66 | 922 | '); |
a5f75d66 | 923 | } |
684427cc | 924 | |
925 | push(@m,' | |
926 | static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt | |
5ab4150f | 927 | $(NOECHO) $(NOOP) |
684427cc | 928 | ') unless $self->{SKIPHASH}{'static'}; |
929 | ||
f0585323 | 930 | push @m,' |
684427cc | 931 | $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt |
932 | $(CP) $(MMS$SOURCE) $(MMS$TARGET) | |
684427cc | 933 | |
c07a80fd | 934 | $(BASEEXT).opt : Makefile.PL |
f6d6199c | 935 | $(PERLRUN) -e "use ExtUtils::Mksymlists;" - |
c07a80fd | 936 | ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ], |
762efda7 | 937 | neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars), |
f0585323 CB |
938 | q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n]; |
939 | ||
940 | push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include='; | |
941 | if ($self->{OBJECT} =~ /\bBASEEXT\b/ or | |
b6837a3b CB |
942 | $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) { |
943 | push @m, ($Config{d_vms_case_sensitive_symbols} | |
944 | ? uc($self->{BASEEXT}) :'$(BASEEXT)'); | |
945 | } | |
f0585323 | 946 | else { # We don't have a "main" object file, so pull 'em all in |
b6837a3b CB |
947 | # Upcase module names if linker is being case-sensitive |
948 | my($upcase) = $Config{d_vms_case_sensitive_symbols}; | |
f0585323 CB |
949 | my(@omods) = map { s/\.[^.]*$//; # Trim off file type |
950 | s[\$\(\w+_EXT\)][]; # even as a macro | |
951 | s/.*[:>\/\]]//; # Trim off dir spec | |
b6837a3b CB |
952 | $upcase ? uc($_) : $_; |
953 | } split ' ', $self->eliminate_macros($self->{OBJECT}); | |
e3830a4e | 954 | my($tmp,@lines,$elt) = ''; |
62ecdc92 | 955 | $tmp = shift @omods; |
f0585323 CB |
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"; | |
684427cc | 964 | |
55497cff | 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) { | |
9607fc9c | 970 | push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n"; |
55497cff | 971 | $line = $lib . '\n'; |
972 | } | |
973 | else { $line .= $lib . '\n'; } | |
974 | } | |
9607fc9c | 975 | push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line; |
55497cff | 976 | } |
977 | ||
684427cc | 978 | join('',@m); |
55497cff | 979 | |
684427cc | 980 | } |
981 | ||
8e03a37c | 982 | =item dynamic_lib (override) |
983 | ||
984 | Use VMS Link command. | |
684427cc | 985 | |
8e03a37c | 986 | =cut |
684427cc | 987 | |
988 | sub dynamic_lib { | |
989 | my($self, %attribs) = @_; | |
684427cc | 990 | return '' unless $self->needs_linking(); #might be because of a subdir |
991 | ||
0d8023a2 | 992 | return '' unless $self->has_link_code(); |
684427cc | 993 | |
c07a80fd | 994 | my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; |
995 | my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; | |
17f28c40 | 996 | my $shr = $Config{'dbgprefix'} . 'PerlShr'; |
684427cc | 997 | my(@m); |
998 | push @m," | |
999 | ||
1000 | OTHERLDFLAGS = $otherldflags | |
c07a80fd | 1001 | INST_DYNAMIC_DEP = $inst_dynamic_dep |
684427cc | 1002 | |
1003 | "; | |
1004 | push @m, ' | |
7292dc67 | 1005 | $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) |
0c2a65fc | 1006 | If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",' |
09b7f37c | 1007 | Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option |
684427cc | 1008 | '; |
1009 | ||
684427cc | 1010 | join('',@m); |
1011 | } | |
1012 | ||
8e03a37c | 1013 | |
1014 | =item static_lib (override) | |
1015 | ||
1016 | Use VMS commands to manipulate object library. | |
1017 | ||
1018 | =cut | |
684427cc | 1019 | |
1020 | sub static_lib { | |
1021 | my($self) = @_; | |
684427cc | 1022 | return '' unless $self->needs_linking(); |
1023 | ||
1024 | return ' | |
1025 | $(INST_STATIC) : | |
5ab4150f | 1026 | $(NOECHO) $(NOOP) |
684427cc | 1027 | ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}); |
1028 | ||
0c2a65fc | 1029 | my(@m,$lib); |
684427cc | 1030 | push @m,' |
1031 | # Rely on suffix rule for update action | |
7292dc67 | 1032 | $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists |
684427cc | 1033 | |
1034 | $(INST_STATIC) : $(OBJECT) $(MYEXTLIB) | |
1035 | '; | |
022735b4 | 1036 | # If this extension has its own library (eg SDBM_File) |
684427cc | 1037 | # then copy that to $(INST_STATIC) and add $(OBJECT) into it. |
17f28c40 CB |
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"); | |
684427cc | 1041 | |
bf99883d HM |
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}) { | |
7292dc67 | 1046 | push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); |
bf99883d | 1047 | } else { |
17f28c40 | 1048 | push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n"); |
bf99883d HM |
1049 | } |
1050 | ||
562a7b0c CB |
1051 | push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n"; |
1052 | foreach $lib (split ' ', $self->{EXTRALIBS}) { | |
0c2a65fc CB |
1053 | push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n"); |
1054 | } | |
684427cc | 1055 | join('',@m); |
1056 | } | |
1057 | ||
1058 | ||
7292dc67 | 1059 | =item extra_clean_files |
479d2113 | 1060 | |
7292dc67 RGS |
1061 | Clean up some OS specific files. Plus the temp file used to shorten |
1062 | a lot of commands. | |
479d2113 MS |
1063 | |
1064 | =cut | |
1065 | ||
7292dc67 RGS |
1066 | sub extra_clean_files { |
1067 | return qw( | |
1068 | *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso | |
1069 | .MM_Tmp | |
1070 | ); | |
479d2113 MS |
1071 | } |
1072 | ||
1073 | ||
7292dc67 | 1074 | =item zipfile_target |
684427cc | 1075 | |
7292dc67 | 1076 | =item tarfile_target |
8e03a37c | 1077 | |
7292dc67 | 1078 | =item shdist_target |
8e03a37c | 1079 | |
479d2113 | 1080 | Syntax for invoking shar, tar and zip differs from that for Unix. |
684427cc | 1081 | |
479d2113 | 1082 | =cut |
684427cc | 1083 | |
479d2113 MS |
1084 | sub zipfile_target { |
1085 | my($self) = shift; | |
62ecdc92 | 1086 | |
479d2113 | 1087 | return <<'MAKE_FRAG'; |
8e03a37c | 1088 | $(DISTVNAME).zip : distdir |
684427cc | 1089 | $(PREOP) |
2ae324a7 | 1090 | $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*; |
684427cc | 1091 | $(RM_RF) $(DISTVNAME) |
1092 | $(POSTOP) | |
479d2113 MS |
1093 | MAKE_FRAG |
1094 | } | |
684427cc | 1095 | |
479d2113 MS |
1096 | sub tarfile_target { |
1097 | my($self) = shift; | |
1098 | ||
1099 | return <<'MAKE_FRAG'; | |
f1387719 | 1100 | $(DISTVNAME).tar$(SUFFIX) : distdir |
1101 | $(PREOP) | |
1102 | $(TO_UNIX) | |
62ecdc92 | 1103 | $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...] |
f1387719 | 1104 | $(RM_RF) $(DISTVNAME) |
1105 | $(COMPRESS) $(DISTVNAME).tar | |
1106 | $(POSTOP) | |
479d2113 MS |
1107 | MAKE_FRAG |
1108 | } | |
1109 | ||
1110 | sub shdist_target { | |
1111 | my($self) = shift; | |
f1387719 | 1112 | |
479d2113 | 1113 | return <<'MAKE_FRAG'; |
684427cc | 1114 | shdist : distdir |
1115 | $(PREOP) | |
479d2113 | 1116 | $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share |
684427cc | 1117 | $(RM_RF) $(DISTVNAME) |
1118 | $(POSTOP) | |
479d2113 | 1119 | MAKE_FRAG |
684427cc | 1120 | } |
1121 | ||
684427cc | 1122 | |
684427cc | 1123 | # --- Test and Installation Sections --- |
1124 | ||
8e03a37c | 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. | |
684427cc | 1129 | |
8e03a37c | 1130 | =cut |
684427cc | 1131 | |
1132 | sub install { | |
1133 | my($self, %attribs) = @_; | |
7292dc67 | 1134 | my(@m); |
c07a80fd | 1135 | |
1136 | push @m, q[ | |
a5f75d66 | 1137 | install :: all pure_install doc_install |
5ab4150f | 1138 | $(NOECHO) $(NOOP) |
a5f75d66 AD |
1139 | |
1140 | install_perl :: all pure_perl_install doc_perl_install | |
5ab4150f | 1141 | $(NOECHO) $(NOOP) |
a5f75d66 AD |
1142 | |
1143 | install_site :: all pure_site_install doc_site_install | |
5ab4150f | 1144 | $(NOECHO) $(NOOP) |
a5f75d66 | 1145 | |
a5f75d66 | 1146 | pure_install :: pure_$(INSTALLDIRS)_install |
5ab4150f | 1147 | $(NOECHO) $(NOOP) |
a5f75d66 AD |
1148 | |
1149 | doc_install :: doc_$(INSTALLDIRS)_install | |
479d2113 | 1150 | $(NOECHO) $(NOOP) |
a5f75d66 AD |
1151 | |
1152 | pure__install : pure_site_install | |
479d2113 | 1153 | $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" |
a5f75d66 AD |
1154 | |
1155 | doc__install : doc_site_install | |
479d2113 | 1156 | $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" |
a5f75d66 AD |
1157 | |
1158 | # This hack brought to you by DCL's 255-character command line limit | |
1159 | pure_perl_install :: | |
e0678a30 | 1160 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp |
5e719f03 MS |
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 | |
479d2113 MS |
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[ | |
a5f75d66 AD |
1171 | |
1172 | # Likewise | |
1173 | pure_site_install :: | |
e0678a30 | 1174 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp |
5e719f03 MS |
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 | |
479d2113 MS |
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[ | |
a5f75d66 | 1185 | |
5c161494 | 1186 | pure_vendor_install :: |
479d2113 | 1187 | $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp |
5e719f03 MS |
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 | |
479d2113 MS |
1195 | $(NOECHO) $(MOD_INSTALL) <.MM_tmp |
1196 | $(NOECHO) $(RM_F) .MM_tmp | |
5c161494 | 1197 | |
a5f75d66 AD |
1198 | # Ditto |
1199 | doc_perl_install :: | |
5e719f03 MS |
1200 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" |
1201 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
e3aa3ecb MS |
1202 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp |
1203 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
7292dc67 | 1204 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ |
479d2113 | 1205 | $(NOECHO) $(RM_F) .MM_tmp |
a5f75d66 AD |
1206 | |
1207 | # And again | |
1208 | doc_site_install :: | |
5e719f03 MS |
1209 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" |
1210 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
e3aa3ecb MS |
1211 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp |
1212 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
7292dc67 | 1213 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ |
479d2113 | 1214 | $(NOECHO) $(RM_F) .MM_tmp |
a5f75d66 | 1215 | |
5c161494 | 1216 | doc_vendor_install :: |
5e719f03 MS |
1217 | $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q[" |
1218 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) | |
e3aa3ecb MS |
1219 | $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp |
1220 | $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp | |
7292dc67 | 1221 | $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[ |
479d2113 | 1222 | $(NOECHO) $(RM_F) .MM_tmp |
5c161494 | 1223 | |
c07a80fd | 1224 | ]; |
1225 | ||
a5f75d66 AD |
1226 | push @m, q[ |
1227 | uninstall :: uninstall_from_$(INSTALLDIRS)dirs | |
5ab4150f | 1228 | $(NOECHO) $(NOOP) |
a5f75d66 AD |
1229 | |
1230 | uninstall_from_perldirs :: | |
479d2113 MS |
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." | |
a5f75d66 AD |
1235 | |
1236 | uninstall_from_sitedirs :: | |
431b0fc4 | 1237 | $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[ |
479d2113 MS |
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." | |
774d564b | 1241 | ]; |
684427cc | 1242 | |
a5f75d66 | 1243 | join('',@m); |
684427cc | 1244 | } |
1245 | ||
8e03a37c | 1246 | =item perldepend (override) |
1247 | ||
1248 | Use VMS-style syntax for files; it's cheaper to just do it directly here | |
97abc6ad | 1249 | than to have the MM_Unix method call C<catfile> repeatedly. Also, if |
8e03a37c | 1250 | we have to rebuild Config.pm, use MM[SK] to do it. |
1251 | ||
1252 | =cut | |
684427cc | 1253 | |
1254 | sub perldepend { | |
1255 | my($self) = @_; | |
684427cc | 1256 | my(@m); |
1257 | ||
1258 | push @m, ' | |
8c7f0036 CB |
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 | |
2530b651 | 1262 | $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h |
8c7f0036 CB |
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 | |
2530b651 MS |
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 | |
8c7f0036 CB |
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 | |
2530b651 MS |
1272 | $(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h |
1273 | $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h | |
684427cc | 1274 | |
1275 | ' if $self->{OBJECT}; | |
1276 | ||
8e03a37c | 1277 | if ($self->{PERL_SRC}) { |
1278 | my(@macros); | |
479d2113 | 1279 | my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)'; |
e0678a30 | 1280 | push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP'; |
8e03a37c | 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[ | |
684427cc | 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! | |
97abc6ad | 1290 | $(PERL_INC)config.h : $(PERL_SRC)config.sh |
22d4bb9c | 1291 | $(NOOP) |
684427cc | 1292 | |
97abc6ad HM |
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" | |
684427cc | 1295 | olddef = F$Environment("Default") |
1296 | Set Default $(PERL_SRC) | |
aa689395 | 1297 | $(MMS)],$mmsquals,); |
1298 | if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) { | |
b7b1864f | 1299 | my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0)); |
aa689395 | 1300 | $target =~ s/\Q$prefix/[/; |
1301 | push(@m," $target"); | |
1302 | } | |
1303 | else { push(@m,' $(MMS$TARGET)'); } | |
1304 | push(@m,q[ | |
8e03a37c | 1305 | Set Default 'olddef' |
1306 | ]); | |
1307 | } | |
684427cc | 1308 | |
b7b1864f | 1309 | push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n") |
684427cc | 1310 | if %{$self->{XS}}; |
1311 | ||
1312 | join('',@m); | |
1313 | } | |
1314 | ||
684427cc | 1315 | |
8e03a37c | 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 | |
684427cc | 1324 | |
57b1a898 | 1325 | use vars qw(%olbs); |
18541947 | 1326 | |
684427cc | 1327 | sub makeaperl { |
1328 | my($self, %attribs) = @_; | |
479d2113 | 1329 | my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) = |
684427cc | 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 | |
684427cc | 1335 | "; |
1336 | return join '', @m if $self->{PARENT}; | |
1337 | ||
1338 | my($dir) = join ":", @{$self->{DIR}}; | |
1339 | ||
1340 | unless ($self->{MAKEAPERL}) { | |
1341 | push @m, q{ | |
684427cc | 1342 | $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) |
479d2113 | 1343 | $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)" |
f6d6199c | 1344 | $(NOECHO) $(PERLRUNINST) \ |
684427cc | 1345 | Makefile.PL DIR=}, $dir, q{ \ |
479d2113 | 1346 | FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ |
d5e3fa33 CB |
1347 | MAKEAPERL=1 NORECURS=1 }; |
1348 | ||
1349 | push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{ | |
684427cc | 1350 | |
0d8023a2 | 1351 | $(MAP_TARGET) :: $(MAKE_APERL_FILE) |
7292dc67 | 1352 | $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET) |
0d8023a2 | 1353 | }; |
684427cc | 1354 | push @m, "\n"; |
1355 | ||
1356 | return join '', @m; | |
1357 | } | |
1358 | ||
1359 | ||
0c2a65fc CB |
1360 | my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen); |
1361 | local($_); | |
684427cc | 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... | |
18541947 | 1369 | local(%olbs); # XXX can this be lexical? |
684427cc | 1370 | $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)"; |
8e03a37c | 1371 | require File::Find; |
684427cc | 1372 | File::Find::find(sub { |
1373 | return unless m/\Q$self->{LIB_EXT}\E$/; | |
1374 | return if m/^libperl/; | |
f1387719 | 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 | ||
684427cc | 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). | |
0c2a65fc | 1424 | for (sort { length($a) <=> length($b) } keys %olbs) { |
684427cc | 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/; | |
0c2a65fc CB |
1430 | push @optlibs, "$dir$olbs{$_}"; |
1431 | # Get external libraries this extension will need | |
684427cc | 1432 | if (-f $extralibs ) { |
0c2a65fc | 1433 | my %seenthis; |
684427cc | 1434 | open LIST,$extralibs or warn $!,next; |
0c2a65fc CB |
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 | } | |
684427cc | 1446 | close LIST; |
1447 | } | |
0c2a65fc | 1448 | # Get full name of extension for ExtUtils::Miniperl |
684427cc | 1449 | if (-f $extopt) { |
1450 | open OPT,$extopt or die $!; | |
1451 | while (<OPT>) { | |
1452 | next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/; | |
0c2a65fc CB |
1453 | my $pkg = $1; |
1454 | $pkg =~ s#__*#::#g; | |
684427cc | 1455 | push @staticpkgs,$pkg; |
1456 | } | |
684427cc | 1457 | } |
1458 | } | |
0c2a65fc CB |
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; | |
684427cc | 1464 | |
ff0cee69 | 1465 | $target = "Perl$Config{'exe_ext'}" unless $target; |
18541947 | 1466 | my $shrtarget; |
684427cc | 1467 | ($shrtarget,$targdir) = fileparse($target); |
1468 | $shrtarget =~ s/^([^.]*)/$1Shr/; | |
1469 | $shrtarget = $targdir . $shrtarget; | |
1470 | $target = "Perlshr.$Config{'dlext'}" unless $target; | |
479d2113 MS |
1471 | $tmpdir = "[]" unless $tmpdir; |
1472 | $tmpdir = $self->fixpath($tmpdir,1); | |
0c2a65fc CB |
1473 | if (@optlibs) { $extralist = join(' ',@optlibs); } |
1474 | else { $extralist = ''; } | |
562a7b0c | 1475 | # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr) |
0c2a65fc | 1476 | # that's what we're building here). |
adeacccf | 1477 | push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2]; |
684427cc | 1478 | if ($libperl) { |
479d2113 | 1479 | unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) { |
684427cc | 1480 | print STDOUT "Warning: $libperl not found\n"; |
1481 | undef $libperl; | |
1482 | } | |
1483 | } | |
1484 | unless ($libperl) { | |
1485 | if (defined $self->{PERL_SRC}) { | |
479d2113 MS |
1486 | $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}"); |
1487 | } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) { | |
684427cc | 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 | |
b7b1864f CB |
1498 | MAP_TARGET = ',$self->fixpath($target,0),' |
1499 | MAP_SHRTARGET = ',$self->fixpath($shrtarget,0)," | |
684427cc | 1500 | MAP_LINKCMD = $linkcmd |
0c2a65fc | 1501 | MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : ''," |
684427cc | 1502 | MAP_EXTRA = $extralist |
b7b1864f | 1503 | MAP_LIBPERL = ",$self->fixpath($libperl,0),' |
684427cc | 1504 | '; |
1505 | ||
1506 | ||
479d2113 | 1507 | push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n"; |
0c2a65fc CB |
1508 | foreach (@optlibs) { |
1509 | push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n"; | |
1510 | } | |
479d2113 | 1511 | push @m,"\n${tmpdir}PerlShr.Opt :\n\t"; |
0c2a65fc CB |
1512 | push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n"; |
1513 | ||
479d2113 | 1514 | push @m,' |
0c2a65fc CB |
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",' | |
479d2113 MS |
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" | |
7292dc67 | 1520 | $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)" |
479d2113 | 1521 | $(NOECHO) $(ECHO) "To remove the intermediate files, say |
7292dc67 | 1522 | $(NOECHO) $(ECHO) " $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean" |
684427cc | 1523 | '; |
479d2113 | 1524 | push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n"; |
0c2a65fc CB |
1525 | push @m, "# More from the 255-char line length limit\n"; |
1526 | foreach (@staticpkgs) { | |
479d2113 | 1527 | push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n]; |
0c2a65fc | 1528 | } |
479d2113 MS |
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 | |
684427cc | 1534 | |
a5f75d66 | 1535 | push @m, q[ |
0c2a65fc | 1536 | # Still more from the 255-char line length limit |
684427cc | 1537 | doc_inst_perl : |
5e719f03 | 1538 | $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB) |
479d2113 MS |
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 | |
5e719f03 | 1543 | $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[ |
479d2113 | 1544 | $(NOECHO) $(RM_F) .MM_tmp |
a5f75d66 | 1545 | ]; |
684427cc | 1546 | |
1547 | push @m, " | |
1548 | inst_perl : pure_inst_perl doc_inst_perl | |
5ab4150f | 1549 | \$(NOECHO) \$(NOOP) |
684427cc | 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 | |
5ab4150f | 1556 | \$(NOECHO) \$(NOOP) |
684427cc | 1557 | |
1558 | map_clean : | |
479d2113 MS |
1559 | \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE) |
1560 | \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET) | |
684427cc | 1561 | "; |
1562 | ||
1563 | join '', @m; | |
1564 | } | |
1565 | ||
8e03a37c | 1566 | # --- Output postprocessing section --- |
684427cc | 1567 | |
8e03a37c | 1568 | =item nicetext (override) |
684427cc | 1569 | |
8e03a37c | 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. | |
684427cc | 1573 | |
8e03a37c | 1574 | =cut |
684427cc | 1575 | |
1576 | sub nicetext { | |
684427cc | 1577 | my($self,$text) = @_; |
45bc4d3a | 1578 | return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone |
684427cc | 1579 | $text =~ s/([^\s:])(:+\s)/$1 $2/gs; |
1580 | $text; | |
1581 | } | |
1582 | ||
45bc4d3a JH |
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) = @_; | |
479d2113 MS |
1602 | |
1603 | # Translate $(PERLPREFIX) to a real path. | |
1604 | $rprefix = $self->eliminate_macros($rprefix); | |
1605 | $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix; | |
5e719f03 | 1606 | $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix; |
479d2113 | 1607 | |
45bc4d3a JH |
1608 | $default = VMS::Filespec::vmsify($default) |
1609 | unless $default =~ /\[.*\]/; | |
1610 | ||
1611 | (my $var_no_install = $var) =~ s/^install//; | |
5e719f03 MS |
1612 | my $path = $self->{uc $var} || |
1613 | $ExtUtils::MM_Unix::Config_Override{lc $var} || | |
1614 | $Config{lc $var} || $Config{lc $var_no_install}; | |
45bc4d3a JH |
1615 | |
1616 | if( !$path ) { | |
1617 | print STDERR " no Config found for $var.\n" if $Verbose >= 2; | |
1618 | $path = $self->_prefixify_default($rprefix, $default); | |
1619 | } | |
a7d1454b RGS |
1620 | elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) { |
1621 | # do nothing if there's no prefix or if its relative | |
1622 | } | |
45bc4d3a JH |
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 | ||
479d2113 | 1631 | my($path_vol, $path_dirs) = $self->splitpath( $path ); |
45bc4d3a JH |
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 | ||
479d2113 | 1668 | my($rvol, $rdirs) = $self->splitpath($rprefix); |
45bc4d3a | 1669 | if( $rvol ) { |
479d2113 MS |
1670 | return $self->catpath($rvol, |
1671 | $self->catdir($rdirs, $default), | |
45bc4d3a JH |
1672 | '' |
1673 | ) | |
1674 | } | |
1675 | else { | |
479d2113 | 1676 | return $self->catdir($rdirs, $default); |
45bc4d3a JH |
1677 | } |
1678 | } | |
1679 | ||
684427cc | 1680 | |
7292dc67 RGS |
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 | |
479d2113 MS |
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 | ||
5dca256e | 1725 | return qq{\$(ABSPERLRUN) $switches -e $cmd}; |
479d2113 MS |
1726 | } |
1727 | ||
1728 | ||
7292dc67 | 1729 | =item B<echo> |
479d2113 | 1730 | |
dedf98bc MS |
1731 | perl trips up on "<foo>" thinking it's an input redirect. So we use the |
1732 | native Write command instead. Besides, its faster. | |
479d2113 MS |
1733 | |
1734 | =cut | |
1735 | ||
1736 | sub echo { | |
1737 | my($self, $text, $file, $appending) = @_; | |
1738 | $appending ||= 0; | |
1739 | ||
dedf98bc | 1740 | my $opencmd = $appending ? 'Open/Append' : 'Open/Write'; |
479d2113 | 1741 | |
dedf98bc MS |
1742 | my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file "); |
1743 | push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) } | |
479d2113 | 1744 | split /\n/, $text; |
dedf98bc | 1745 | push @cmds, '$(NOECHO) Close MMECHOFILE'; |
479d2113 MS |
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 | ||
7292dc67 | 1787 | =item init_linker |
479d2113 MS |
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'; | |
431b0fc4 MS |
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 | } | |
479d2113 MS |
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 | ||
dedf98bc | 1814 | NOTE: This is the canonical version of the method. The version in |
479d2113 MS |
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 | ||
7292dc67 RGS |
1860 | my $path = $mm->fixpath($path); |
1861 | my $path = $mm->fixpath($path, $is_dir); | |
1862 | ||
479d2113 MS |
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 | ||
7292dc67 RGS |
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. | |
479d2113 | 1874 | |
dedf98bc | 1875 | NOTE: This is the canonical version of the method. The version in |
479d2113 MS |
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 | ||
5dca256e | 1886 | if ($path =~ /[ \t]/) { |
479d2113 MS |
1887 | return join ' ', |
1888 | map { $self->fixpath($_,$force_path) } | |
5dca256e | 1889 | split /[ \t]+/, $path; |
479d2113 MS |
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 | ||
dedf98bc MS |
1928 | =item os_flavor |
1929 | ||
1930 | VMS is VMS. | |
1931 | ||
1932 | =cut | |
1933 | ||
1934 | sub os_flavor { | |
1935 | return('VMS'); | |
1936 | } | |
1937 | ||
2ae324a7 | 1938 | =back |
1939 | ||
7292dc67 RGS |
1940 | |
1941 | =head1 AUTHOR | |
1942 | ||
1943 | Original author Charles Bailey F<bailey@newman.upenn.edu> | |
1944 | ||
1945 | Maintained by Michael G Schwern F<schwern@pobox.com> | |
1946 | ||
1947 | See L<ExtUtils::MakeMaker> for patching and contact information. | |
1948 | ||
1949 | ||
2ae324a7 | 1950 | =cut |
1951 | ||
45bc4d3a | 1952 | 1; |
f1387719 | 1953 |