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