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