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