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