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