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