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