lib/ExtUtils/MM_VMS.pm

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