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