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