lib/ExtUtils/MM_VMS.pm

   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 = '5.73_03';
  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)thrdvar.h, $(PERL_INC)thread.h
1283 $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h
1284
1285 ' if $self->{OBJECT};
1286
1287     if ($self->{PERL_SRC}) {
1288         my(@macros);
1289         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
1290         push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
1291         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1292         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1293         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1294         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1295         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1296         push(@m,q[
1297 # Check for unpropagated config.sh changes. Should never happen.
1298 # We do NOT just update config.h because that is not sufficient.
1299 # An out of date config.h is not fatal but complains loudly!
1300 $(PERL_INC)config.h : $(PERL_SRC)config.sh
1301         $(NOOP)
1302
1303 $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
1304         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
1305         olddef = F$Environment("Default")
1306         Set Default $(PERL_SRC)
1307         $(MMS)],$mmsquals,);
1308         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
1309             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
1310             $target =~ s/\Q$prefix/[/;
1311             push(@m," $target");
1312         }
1313         else { push(@m,' $(MMS$TARGET)'); }
1314         push(@m,q[
1315         Set Default 'olddef'
1316 ]);
1317     }
1318
1319     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
1320       if %{$self->{XS}};
1321
1322     join('',@m);
1323 }
1324
1325
1326 =item makeaperl (override)
1327
1328 Undertake to build a new set of Perl images using VMS commands.  Since
1329 VMS does dynamic loading, it's not necessary to statically link each
1330 extension into the Perl image, so this isn't the normal build path.
1331 Consequently, it hasn't really been tested, and may well be incomplete.
1332
1333 =cut
1334
1335 use vars qw(%olbs);
1336
1337 sub makeaperl {
1338     my($self, %attribs) = @_;
1339     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) =
1340       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
1341     my(@m);
1342     push @m, "
1343 # --- MakeMaker makeaperl section ---
1344 MAP_TARGET    = $target
1345 ";
1346     return join '', @m if $self->{PARENT};
1347
1348     my($dir) = join ":", @{$self->{DIR}};
1349
1350     unless ($self->{MAKEAPERL}) {
1351         push @m, q{
1352 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
1353         $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
1354         $(NOECHO) $(PERLRUNINST) \
1355                 Makefile.PL DIR=}, $dir, q{ \
1356                 FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
1357                 MAKEAPERL=1 NORECURS=1 };
1358
1359         push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
1360
1361 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
1362         $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
1363 };
1364         push @m, "\n";
1365
1366         return join '', @m;
1367     }
1368
1369
1370     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
1371     local($_);
1372
1373     # The front matter of the linkcommand...
1374     $linkcmd = join ' ', $Config{'ld'},
1375             grep($_, @Config{qw(large split ldflags ccdlflags)});
1376     $linkcmd =~ s/\s+/ /g;
1377
1378     # Which *.olb files could we make use of...
1379     local(%olbs);       # XXX can this be lexical?
1380     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
1381     require File::Find;
1382     File::Find::find(sub {
1383         return unless m/\Q$self->{LIB_EXT}\E$/;
1384         return if m/^libperl/;
1385
1386         if( exists $self->{INCLUDE_EXT} ){
1387                 my $found = 0;
1388                 my $incl;
1389                 my $xx;
1390
1391                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1392                 $xx =~ s,/?$_,,;
1393                 $xx =~ s,/,::,g;
1394
1395                 # Throw away anything not explicitly marked for inclusion.
1396                 # DynaLoader is implied.
1397                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
1398                         if( $xx eq $incl ){
1399                                 $found++;
1400                                 last;
1401                         }
1402                 }
1403                 return unless $found;
1404         }
1405         elsif( exists $self->{EXCLUDE_EXT} ){
1406                 my $excl;
1407                 my $xx;
1408
1409                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1410                 $xx =~ s,/?$_,,;
1411                 $xx =~ s,/,::,g;
1412
1413                 # Throw away anything explicitly marked for exclusion
1414                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
1415                         return if( $xx eq $excl );
1416                 }
1417         }
1418
1419         $olbs{$ENV{DEFAULT}} = $_;
1420     }, grep( -d $_, @{$searchdirs || []}));
1421
1422     # We trust that what has been handed in as argument will be buildable
1423     $static = [] unless $static;
1424     @olbs{@{$static}} = (1) x @{$static};
1425
1426     $extra = [] unless $extra && ref $extra eq 'ARRAY';
1427     # Sort the object libraries in inverse order of
1428     # filespec length to try to insure that dependent extensions
1429     # will appear before their parents, so the linker will
1430     # search the parent library to resolve references.
1431     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
1432     # references from [.intuit.dwim]dwim.obj can be found
1433     # in [.intuit]intuit.olb).
1434     for (sort { length($a) <=> length($b) } keys %olbs) {
1435         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
1436         my($dir) = $self->fixpath($_,1);
1437         my($extralibs) = $dir . "extralibs.ld";
1438         my($extopt) = $dir . $olbs{$_};
1439         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
1440         push @optlibs, "$dir$olbs{$_}";
1441         # Get external libraries this extension will need
1442         if (-f $extralibs ) {
1443             my %seenthis;
1444             open LIST,$extralibs or warn $!,next;
1445             while (<LIST>) {
1446                 chomp;
1447                 # Include a library in the link only once, unless it's mentioned
1448                 # multiple times within a single extension's options file, in which
1449                 # case we assume the builder needed to search it again later in the
1450                 # link.
1451                 my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
1452                 $libseen{$_}++;  $seenthis{$_}++;
1453                 next if $skip;
1454                 push @$extra,$_;
1455             }
1456             close LIST;
1457         }
1458         # Get full name of extension for ExtUtils::Miniperl
1459         if (-f $extopt) {
1460             open OPT,$extopt or die $!;
1461             while (<OPT>) {
1462                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
1463                 my $pkg = $1;
1464                 $pkg =~ s#__*#::#g;
1465                 push @staticpkgs,$pkg;
1466             }
1467         }
1468     }
1469     # Place all of the external libraries after all of the Perl extension
1470     # libraries in the final link, in order to maximize the opportunity
1471     # for XS code from multiple extensions to resolve symbols against the
1472     # same external library while only including that library once.
1473     push @optlibs, @$extra;
1474
1475     $target = "Perl$Config{'exe_ext'}" unless $target;
1476     my $shrtarget;
1477     ($shrtarget,$targdir) = fileparse($target);
1478     $shrtarget =~ s/^([^.]*)/$1Shr/;
1479     $shrtarget = $targdir . $shrtarget;
1480     $target = "Perlshr.$Config{'dlext'}" unless $target;
1481     $tmpdir = "[]" unless $tmpdir;
1482     $tmpdir = $self->fixpath($tmpdir,1);
1483     if (@optlibs) { $extralist = join(' ',@optlibs); }
1484     else          { $extralist = ''; }
1485     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
1486     # that's what we're building here).
1487     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
1488     if ($libperl) {
1489         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
1490             print STDOUT "Warning: $libperl not found\n";
1491             undef $libperl;
1492         }
1493     }
1494     unless ($libperl) {
1495         if (defined $self->{PERL_SRC}) {
1496             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
1497         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
1498         } else {
1499             print STDOUT "Warning: $libperl not found
1500     If you're going to build a static perl binary, make sure perl is installed
1501     otherwise ignore this warning\n";
1502         }
1503     }
1504     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
1505
1506     push @m, '
1507 # Fill in the target you want to produce if it\'s not perl
1508 MAP_TARGET    = ',$self->fixpath($target,0),'
1509 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
1510 MAP_LINKCMD   = $linkcmd
1511 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
1512 MAP_EXTRA     = $extralist
1513 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
1514 ';
1515
1516
1517     push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
1518     foreach (@optlibs) {
1519         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
1520     }
1521     push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
1522     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
1523
1524     push @m,'
1525 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
1526         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
1527 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
1528         $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
1529         $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
1530         $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
1531         $(NOECHO) $(ECHO) "To remove the intermediate files, say
1532         $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
1533 ';
1534     push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
1535     push @m, "# More from the 255-char line length limit\n";
1536     foreach (@staticpkgs) {
1537         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
1538     }
1539
1540     push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
1541         $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
1542         $(NOECHO) $(RM_F) %sWritemain.tmp
1543 MAKE_FRAG
1544
1545     push @m, q[
1546 # Still more from the 255-char line length limit
1547 doc_inst_perl :
1548         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1549         $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
1550         $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
1551         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
1552         $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
1553         $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
1554         $(NOECHO) $(RM_F) .MM_tmp
1555 ];
1556
1557     push @m, "
1558 inst_perl : pure_inst_perl doc_inst_perl
1559         \$(NOECHO) \$(NOOP)
1560
1561 pure_inst_perl : \$(MAP_TARGET)
1562         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
1563         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
1564
1565 clean :: map_clean
1566         \$(NOECHO) \$(NOOP)
1567
1568 map_clean :
1569         \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
1570         \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
1571 ";
1572
1573     join '', @m;
1574 }
1575
1576 # --- Output postprocessing section ---
1577
1578 =item nicetext (override)
1579
1580 Insure that colons marking targets are preceded by space, in order
1581 to distinguish the target delimiter from a colon appearing as
1582 part of a filespec.
1583
1584 =cut
1585
1586 sub nicetext {
1587     my($self,$text) = @_;
1588     return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone
1589     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
1590     $text;
1591 }
1592
1593 =item prefixify (override)
1594
1595 prefixifying on VMS is simple.  Each should simply be:
1596
1597     perl_root:[some.dir]
1598
1599 which can just be converted to:
1600
1601     volume:[your.prefix.some.dir]
1602
1603 otherwise you get the default layout.
1604
1605 In effect, your search prefix is ignored and $Config{vms_prefix} is
1606 used instead.
1607
1608 =cut
1609
1610 sub prefixify {
1611     my($self, $var, $sprefix, $rprefix, $default) = @_;
1612
1613     # Translate $(PERLPREFIX) to a real path.
1614     $rprefix = $self->eliminate_macros($rprefix);
1615     $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
1616     $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
1617
1618     $default = VMS::Filespec::vmsify($default)
1619       unless $default =~ /\[.*\]/;
1620
1621     (my $var_no_install = $var) =~ s/^install//;
1622     my $path = $self->{uc $var} ||
1623                $ExtUtils::MM_Unix::Config_Override{lc $var} ||
1624                $Config{lc $var} || $Config{lc $var_no_install};
1625
1626     if( !$path ) {
1627         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
1628         $path = $self->_prefixify_default($rprefix, $default);
1629     }
1630     elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
1631         # do nothing if there's no prefix or if its relative
1632     }
1633     elsif( $sprefix eq $rprefix ) {
1634         print STDERR "  no new prefix.\n" if $Verbose >= 2;
1635     }
1636     else {
1637
1638         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
1639         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
1640
1641         my($path_vol, $path_dirs) = $self->splitpath( $path );
1642         if( $path_vol eq $Config{vms_prefix}.':' ) {
1643             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
1644
1645             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
1646             $path = $self->_catprefix($rprefix, $path_dirs);
1647         }
1648         else {
1649             $path = $self->_prefixify_default($rprefix, $default);
1650         }
1651     }
1652
1653     print "    now $path\n" if $Verbose >= 2;
1654     return $self->{uc $var} = $path;
1655 }
1656
1657
1658 sub _prefixify_default {
1659     my($self, $rprefix, $default) = @_;
1660
1661     print STDERR "  cannot prefix, using default.\n" if $Verbose >= 2;
1662
1663     if( !$default ) {
1664         print STDERR "No default!\n" if $Verbose >= 1;
1665         return;
1666     }
1667     if( !$rprefix ) {
1668         print STDERR "No replacement prefix!\n" if $Verbose >= 1;
1669         return '';
1670     }
1671
1672     return $self->_catprefix($rprefix, $default);
1673 }
1674
1675 sub _catprefix {
1676     my($self, $rprefix, $default) = @_;
1677
1678     my($rvol, $rdirs) = $self->splitpath($rprefix);
1679     if( $rvol ) {
1680         return $self->catpath($rvol,
1681                                    $self->catdir($rdirs, $default),
1682                                    ''
1683                                   )
1684     }
1685     else {
1686         return $self->catdir($rdirs, $default);
1687     }
1688 }
1689
1690
1691 =item cd
1692
1693 =cut
1694
1695 sub cd {
1696     my($self, $dir, @cmds) = @_;
1697
1698     $dir = vmspath($dir);
1699
1700     my $cmd = join "\n\t", map "$_", @cmds;
1701
1702     # No leading tab makes it look right when embedded
1703     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
1704 startdir = F$Environment("Default")
1705         Set Default %s
1706         %s
1707         Set Default 'startdir'
1708 MAKE_FRAG
1709
1710     # No trailing newline makes this easier to embed
1711     chomp $make_frag;
1712
1713     return $make_frag;
1714 }
1715
1716
1717 =item oneliner
1718
1719 =cut
1720
1721 sub oneliner {
1722     my($self, $cmd, $switches) = @_;
1723     $switches = [] unless defined $switches;
1724
1725     # Strip leading and trailing newlines
1726     $cmd =~ s{^\n+}{};
1727     $cmd =~ s{\n+$}{};
1728
1729     $cmd = $self->quote_literal($cmd);
1730     $cmd = $self->escape_newlines($cmd);
1731
1732     # Switches must be quoted else they will be lowercased.
1733     $switches = join ' ', map { qq{"$_"} } @$switches;
1734
1735     return qq{\$(ABSPERLRUN) $switches -e $cmd \"--\"};
1736 }
1737
1738
1739 =item B<echo>
1740
1741 perl trips up on "<foo>" thinking it's an input redirect.  So we use the
1742 native Write command instead.  Besides, its faster.
1743
1744 =cut
1745
1746 sub echo {
1747     my($self, $text, $file, $appending) = @_;
1748     $appending ||= 0;
1749
1750     my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
1751
1752     my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
1753     push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) }
1754                 split /\n/, $text;
1755     push @cmds, '$(NOECHO) Close MMECHOFILE';
1756     return @cmds;
1757 }
1758
1759
1760 =item quote_literal
1761
1762 =cut
1763
1764 sub quote_literal {
1765     my($self, $text) = @_;
1766
1767     # I believe this is all we should need.
1768     $text =~ s{"}{""}g;
1769
1770     return qq{"$text"};
1771 }
1772
1773 =item escape_newlines
1774
1775 =cut
1776
1777 sub escape_newlines {
1778     my($self, $text) = @_;
1779
1780     $text =~ s{\n}{-\n}g;
1781
1782     return $text;
1783 }
1784
1785 =item max_exec_len
1786
1787 256 characters.
1788
1789 =cut
1790
1791 sub max_exec_len {
1792     my $self = shift;
1793
1794     return $self->{_MAX_EXEC_LEN} ||= 256;
1795 }
1796
1797 =item init_linker
1798
1799 =cut
1800
1801 sub init_linker {
1802     my $self = shift;
1803     $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
1804
1805     my $shr = $Config{dbgprefix} . 'PERLSHR';
1806     if ($self->{PERL_SRC}) {
1807         $self->{PERL_ARCHIVE} ||=
1808           $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
1809     }
1810     else {
1811         $self->{PERL_ARCHIVE} ||=
1812           $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
1813     }
1814
1815     $self->{PERL_ARCHIVE_AFTER} ||= '';
1816 }
1817
1818 =item eliminate_macros
1819
1820 Expands MM[KS]/Make macros in a text string, using the contents of
1821 identically named elements of C<%$self>, and returns the result
1822 as a file specification in Unix syntax.
1823
1824 NOTE:  This is the canonical version of the method.  The version in
1825 File::Spec::VMS is deprecated.
1826
1827 =cut
1828
1829 sub eliminate_macros {
1830     my($self,$path) = @_;
1831     return '' unless $path;
1832     $self = {} unless ref $self;
1833
1834     if ($path =~ /\s/) {
1835       return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
1836     }
1837
1838     my($npath) = unixify($path);
1839     # sometimes unixify will return a string with an off-by-one trailing null
1840     $npath =~ s{\0$}{};
1841
1842     my($complex) = 0;
1843     my($head,$macro,$tail);
1844
1845     # perform m##g in scalar context so it acts as an iterator
1846     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
1847         if (defined $self->{$2}) {
1848             ($head,$macro,$tail) = ($1,$2,$3);
1849             if (ref $self->{$macro}) {
1850                 if (ref $self->{$macro} eq 'ARRAY') {
1851                     $macro = join ' ', @{$self->{$macro}};
1852                 }
1853                 else {
1854                     print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
1855                           "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
1856                     $macro = "\cB$macro\cB";
1857                     $complex = 1;
1858                 }
1859             }
1860             else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
1861             $npath = "$head$macro$tail";
1862         }
1863     }
1864     if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
1865     $npath;
1866 }
1867
1868 =item fixpath
1869
1870    my $path = $mm->fixpath($path);
1871    my $path = $mm->fixpath($path, $is_dir);
1872
1873 Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
1874 in any directory specification, in order to avoid juxtaposing two
1875 VMS-syntax directories when MM[SK] is run.  Also expands expressions which
1876 are all macro, so that we can tell how long the expansion is, and avoid
1877 overrunning DCL's command buffer when MM[KS] is running.
1878
1879 fixpath() checks to see whether the result matches the name of a
1880 directory in the current default directory and returns a directory or
1881 file specification accordingly.  C<$is_dir> can be set to true to
1882 force fixpath() to consider the path to be a directory or false to force
1883 it to be a file.
1884
1885 NOTE:  This is the canonical version of the method.  The version in
1886 File::Spec::VMS is deprecated.
1887
1888 =cut
1889
1890 sub fixpath {
1891     my($self,$path,$force_path) = @_;
1892     return '' unless $path;
1893     $self = bless {} unless ref $self;
1894     my($fixedpath,$prefix,$name);
1895
1896     if ($path =~ /[ \t]/) {
1897       return join ' ',
1898              map { $self->fixpath($_,$force_path) }
1899              split /[ \t]+/, $path;
1900     }
1901
1902     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
1903         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
1904             $fixedpath = vmspath($self->eliminate_macros($path));
1905         }
1906         else {
1907             $fixedpath = vmsify($self->eliminate_macros($path));
1908         }
1909     }
1910     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
1911         my($vmspre) = $self->eliminate_macros("\$($prefix)");
1912         # is it a dir or just a name?
1913         $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
1914         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
1915         $fixedpath = vmspath($fixedpath) if $force_path;
1916     }
1917     else {
1918         $fixedpath = $path;
1919         $fixedpath = vmspath($fixedpath) if $force_path;
1920     }
1921     # No hints, so we try to guess
1922     if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
1923         $fixedpath = vmspath($fixedpath) if -d $fixedpath;
1924     }
1925
1926     # Trim off root dirname if it's had other dirs inserted in front of it.
1927     $fixedpath =~ s/\.000000([\]>])/$1/;
1928     # Special case for VMS absolute directory specs: these will have had device
1929     # prepended during trip through Unix syntax in eliminate_macros(), since
1930     # Unix syntax has no way to express "absolute from the top of this device's
1931     # directory tree".
1932     if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
1933
1934     return $fixedpath;
1935 }
1936
1937
1938 =item os_flavor
1939
1940 VMS is VMS.
1941
1942 =cut
1943
1944 sub os_flavor {
1945     return('VMS');
1946 }
1947
1948 =back
1949
1950
1951 =head1 AUTHOR
1952
1953 Original author Charles Bailey F<bailey@newman.upenn.edu>
1954
1955 Maintained by Michael G Schwern F<schwern@pobox.com>
1956
1957 See L<ExtUtils::MakeMaker> for patching and contact information.
1958
1959
1960 =cut
1961
1962 1;
1963