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.69';
  24 ($Revision) = q$Revision: 1.107 $ =~ /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) extralibs.ld
1233                           perlmain.c pm_to_blib pm_to_blib.ts ]);
1234     push(@otherfiles, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
1235
1236     # Occasionally files are repeated several times from different sources
1237     { my(%of) = map { ($_ => 1) } @otherfiles; @otherfiles = keys %of; }
1238
1239     my $line = '';
1240     foreach my $file (@otherfiles) {
1241         $file = $self->fixpath($file);
1242         if (length($line) + length($file) > 80) {
1243             push @m, "\t\$(RM_RF) $line\n";
1244             $line = "$file";
1245         }
1246         else { $line .= " $file"; }
1247     }
1248     push @m, "\t\$(RM_RF) $line\n" if $line;
1249     push(@m, "  $attribs{POSTOP}\n") if $attribs{POSTOP};
1250     join('', @m);
1251 }
1252
1253
1254 =item clean_subdirs_target
1255
1256   my $make_frag = $MM->clean_subdirs_target;
1257
1258 VMS semantics for changing directories and rerunning make very different.
1259
1260 =cut
1261
1262 sub clean_subdirs_target {
1263     my($self) = shift;
1264
1265     # No subdirectories, no cleaning.
1266     return <<'NOOP_FRAG' unless @{$self->{DIR}};
1267 clean_subdirs :
1268         $(NOECHO) $(NOOP)
1269 NOOP_FRAG
1270
1271
1272     my $clean = "clean_subdirs :\n";
1273
1274     foreach my $dir (@{$self->{DIR}}) { # clean subdirectories first
1275         $dir = $self->fixpath($dir,1);
1276
1277         $clean .= sprintf <<'MAKE_FRAG', $dir, $dir;
1278         If F$Search("%s$(FIRST_MAKEFILE)").nes."" Then $(PERLRUN) -e "chdir '%s'; print `$(MMS)$(MMSQUALIFIERS) clean`;"
1279 MAKE_FRAG
1280     }
1281
1282     return $clean;
1283 }
1284
1285
1286 =item realclean (override)
1287
1288 Guess what we're working around?  Also, use MM[SK] for subdirectories.
1289
1290 =cut
1291
1292 sub realclean {
1293     my($self, %attribs) = @_;
1294     my(@m);
1295     push(@m,'
1296 # Delete temporary files (via clean) and also delete installed files
1297 realclean :: clean
1298 ');
1299     foreach(@{$self->{DIR}}){
1300         my($vmsdir) = $self->fixpath($_,1);
1301         push(@m, '      If F$Search("'."$vmsdir".'$(FIRST_MAKEFILE)").nes."" Then \\',"\n\t",
1302               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
1303     }
1304     push @m, "  \$(RM_RF) \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n";
1305     push @m, "  \$(RM_RF) \$(DISTVNAME)\n";
1306     # We can't expand several of the MMS macros here, since they don't have
1307     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
1308     # combination of macros).  In order to stay below DCL's 255 char limit,
1309     # we put only 2 on a line.
1310     my($file,$fcnt);
1311     my(@files) = values %{$self->{PM}};
1312     push @files, qw{ $(FIRST_MAKEFILE) $(MAKEFILE_OLD) };
1313     if ($self->has_link_code) {
1314         push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
1315     }
1316
1317     # Occasionally files are repeated several times from different sources
1318     { my(%f) = map { ($_,1) } @files; @files = keys %f; }
1319
1320     my $line = '';
1321     foreach $file (@files) {
1322         if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
1323             push @m, "\t\$(RM_F) $line\n";
1324             $line = "$file";
1325             $fcnt = 0;
1326         }
1327         else { $line .= " $file"; }
1328     }
1329     push @m, "\t\$(RM_F) $line\n" if $line;
1330     if ($attribs{FILES}) {
1331         my($word,$key,@filist,@allfiles);
1332         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1333         else { @filist = split /\s+/, $attribs{FILES}; }
1334         foreach $word (@filist) {
1335             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1336                 push(@allfiles, @{$self->{$key}});
1337             }
1338             else { push(@allfiles, $word); }
1339         }
1340         $line = '';
1341         # Occasionally files are repeated several times from different sources
1342         { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
1343         foreach $file (@allfiles) {
1344             $file = $self->fixpath($file);
1345             if (length($line) + length($file) > 80) {
1346                 push @m, "\t\$(RM_RF) $line\n";
1347                 $line = "$file";
1348             }
1349             else { $line .= " $file"; }
1350         }
1351         push @m, "\t\$(RM_RF) $line\n" if $line;
1352     }
1353     push(@m, "  $attribs{POSTOP}\n")                     if $attribs{POSTOP};
1354     join('', @m);
1355 }
1356
1357 =item zipfile_target (o)
1358
1359 =item tarfile_target (o)
1360
1361 =item shdist_target (o)
1362
1363 Syntax for invoking shar, tar and zip differs from that for Unix.
1364
1365 =cut
1366
1367 sub zipfile_target {
1368     my($self) = shift;
1369
1370     return <<'MAKE_FRAG';
1371 $(DISTVNAME).zip : distdir
1372         $(PREOP)
1373         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
1374         $(RM_RF) $(DISTVNAME)
1375         $(POSTOP)
1376 MAKE_FRAG
1377 }
1378
1379 sub tarfile_target {
1380     my($self) = shift;
1381
1382     return <<'MAKE_FRAG';
1383 $(DISTVNAME).tar$(SUFFIX) : distdir
1384         $(PREOP)
1385         $(TO_UNIX)
1386         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
1387         $(RM_RF) $(DISTVNAME)
1388         $(COMPRESS) $(DISTVNAME).tar
1389         $(POSTOP)
1390 MAKE_FRAG
1391 }
1392
1393 sub shdist_target {
1394     my($self) = shift;
1395
1396     return <<'MAKE_FRAG';
1397 shdist : distdir
1398         $(PREOP)
1399         $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
1400         $(RM_RF) $(DISTVNAME)
1401         $(POSTOP)
1402 MAKE_FRAG
1403 }
1404
1405 =item dist_test (override)
1406
1407 Use VMS commands to change default directory, and use VMS-style
1408 quoting on command line.
1409
1410 =cut
1411
1412 sub dist_test {
1413     my($self) = @_;
1414 q{
1415 disttest : distdir
1416         startdir = F$Environment("Default")
1417         Set Default [.$(DISTVNAME)]
1418         $(ABSPERLRUN) Makefile.PL
1419         $(MMS)$(MMSQUALIFIERS)
1420         $(MMS)$(MMSQUALIFIERS) test
1421         Set Default 'startdir'
1422 };
1423 }
1424
1425 # --- Test and Installation Sections ---
1426
1427 =item install (override)
1428
1429 Work around DCL's 255 character limit several times,and use
1430 VMS-style command line quoting in a few cases.
1431
1432 =cut
1433
1434 sub install {
1435     my($self, %attribs) = @_;
1436     my(@m,@exe_files);
1437
1438     if ($self->{EXE_FILES}) {
1439         my($line,$file) = ('','');
1440         foreach $file (@{$self->{EXE_FILES}}) {
1441             $line .= "$file ";
1442             if (length($line) > 128) {
1443                 push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]);
1444                 $line = '';
1445             }
1446         }
1447         push(@exe_files,qq[\t\$(NOECHO) \$(ECHO) "$line" >>.MM_tmp\n]) if $line;
1448     }
1449
1450     push @m, q[
1451 install :: all pure_install doc_install
1452         $(NOECHO) $(NOOP)
1453
1454 install_perl :: all pure_perl_install doc_perl_install
1455         $(NOECHO) $(NOOP)
1456
1457 install_site :: all pure_site_install doc_site_install
1458         $(NOECHO) $(NOOP)
1459
1460 pure_install :: pure_$(INSTALLDIRS)_install
1461         $(NOECHO) $(NOOP)
1462
1463 doc_install :: doc_$(INSTALLDIRS)_install
1464         $(NOECHO) $(NOOP)
1465
1466 pure__install : pure_site_install
1467         $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1468
1469 doc__install : doc_site_install
1470         $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1471
1472 # This hack brought to you by DCL's 255-character command line limit
1473 pure_perl_install ::
1474         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1475         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1476         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp
1477         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp
1478         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp
1479         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1480         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
1481         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp
1482         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1483         $(NOECHO) $(RM_F) .MM_tmp
1484         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
1485
1486 # Likewise
1487 pure_site_install ::
1488         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1489         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1490         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp
1491         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp
1492         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp
1493         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1494         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp
1495         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp
1496         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1497         $(NOECHO) $(RM_F) .MM_tmp
1498         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1499
1500 pure_vendor_install ::
1501         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1502         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1503         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp
1504         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp
1505         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp
1506         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1507         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp
1508         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp
1509         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1510         $(NOECHO) $(RM_F) .MM_tmp
1511
1512 # Ditto
1513 doc_perl_install ::
1514         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1515         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1516         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
1517         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1518 ],@exe_files,
1519 q[      $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1520         $(NOECHO) $(RM_F) .MM_tmp
1521
1522 # And again
1523 doc_site_install ::
1524         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1525         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1526         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
1527         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1528 ],@exe_files,
1529 q[      $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1530         $(NOECHO) $(RM_F) .MM_tmp
1531
1532 doc_vendor_install ::
1533         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1534         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1535         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
1536         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1537 ],@exe_files,
1538 q[      $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1539         $(NOECHO) $(RM_F) .MM_tmp
1540
1541 ];
1542
1543     push @m, q[
1544 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1545         $(NOECHO) $(NOOP)
1546
1547 uninstall_from_perldirs ::
1548         $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1549         $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
1550         $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
1551         $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
1552
1553 uninstall_from_sitedirs ::
1554         $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
1555         $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
1556         $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
1557         $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
1558 ];
1559
1560     join('',@m);
1561 }
1562
1563 =item perldepend (override)
1564
1565 Use VMS-style syntax for files; it's cheaper to just do it directly here
1566 than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
1567 we have to rebuild Config.pm, use MM[SK] to do it.
1568
1569 =cut
1570
1571 sub perldepend {
1572     my($self) = @_;
1573     my(@m);
1574
1575     push @m, '
1576 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
1577 $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
1578 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
1579 $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
1580 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
1581 $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
1582 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
1583 $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
1584 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
1585 $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
1586 $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
1587 $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
1588 $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1589 $(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h
1590 $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h
1591
1592 ' if $self->{OBJECT};
1593
1594     if ($self->{PERL_SRC}) {
1595         my(@macros);
1596         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
1597         push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
1598         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1599         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1600         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1601         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1602         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1603         push(@m,q[
1604 # Check for unpropagated config.sh changes. Should never happen.
1605 # We do NOT just update config.h because that is not sufficient.
1606 # An out of date config.h is not fatal but complains loudly!
1607 $(PERL_INC)config.h : $(PERL_SRC)config.sh
1608         $(NOOP)
1609
1610 $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
1611         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
1612         olddef = F$Environment("Default")
1613         Set Default $(PERL_SRC)
1614         $(MMS)],$mmsquals,);
1615         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
1616             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
1617             $target =~ s/\Q$prefix/[/;
1618             push(@m," $target");
1619         }
1620         else { push(@m,' $(MMS$TARGET)'); }
1621         push(@m,q[
1622         Set Default 'olddef'
1623 ]);
1624     }
1625
1626     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
1627       if %{$self->{XS}};
1628
1629     join('',@m);
1630 }
1631
1632 =item makefile (override)
1633
1634 Use VMS commands and quoting.
1635
1636 =cut
1637
1638 sub makefile {
1639     my($self) = @_;
1640     my(@m,@cmd);
1641     # We do not know what target was originally specified so we
1642     # must force a manual rerun to be sure. But as it should only
1643     # happen very rarely it is not a significant problem.
1644     push @m, q[
1645 $(OBJECT) : $(FIRST_MAKEFILE)
1646 ] if $self->{OBJECT};
1647
1648     push @m,q[
1649 # We take a very conservative approach here, but it's worth it.
1650 # We move $(FIRST_MAKEFILE) to $(MAKEFILE_OLD) here to avoid gnu make looping.
1651 $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
1652         $(NOECHO) $(ECHO) "$(FIRST_MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
1653         $(NOECHO) $(ECHO) "Cleaning current config before rebuilding $(FIRST_MAKEFILE) ..."
1654         - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
1655         - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE_OLD) clean
1656         $(PERLRUN) Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
1657         $(NOECHO) $(ECHO) "$(FIRST_MAKEFILE) has been rebuilt."
1658         $(NOECHO) $(ECHO) "Please run $(MMS) to build the extension."
1659 ];
1660
1661     join('',@m);
1662 }
1663
1664 =item find_tests (override)
1665
1666 =cut
1667
1668 sub find_tests {
1669     my $self = shift;
1670     return -d 't' ? 't/*.t' : '';
1671 }
1672
1673 =item test (override)
1674
1675 Use VMS commands for handling subdirectories.
1676
1677 =cut
1678
1679 sub test {
1680     my($self, %attribs) = @_;
1681     my($tests) = $attribs{TESTS} || $self->find_tests;
1682     my(@m);
1683     push @m,"
1684 TEST_VERBOSE = 0
1685 TEST_TYPE = test_\$(LINKTYPE)
1686 TEST_FILE = test.pl
1687 TESTDB_SW = -d
1688
1689 test :: \$(TEST_TYPE)
1690         \$(NOECHO) \$(NOOP)
1691
1692 testdb :: testdb_\$(LINKTYPE)
1693         \$(NOECHO) \$(NOOP)
1694
1695 ";
1696     foreach(@{$self->{DIR}}){
1697       my($vmsdir) = $self->fixpath($_,1);
1698       push(@m, '        If F$Search("',$vmsdir,'$(FIRST_MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
1699            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
1700     }
1701     push(@m, "\t\$(NOECHO) \$(ECHO) \"No tests defined for \$(NAME) extension.\"\n")
1702         unless $tests or -f "test.pl" or @{$self->{DIR}};
1703     push(@m, "\n");
1704
1705     push(@m, "test_dynamic :: pure_all\n");
1706     push(@m, $self->test_via_harness('$(FULLPERLRUN)', $tests)) if $tests;
1707     push(@m, $self->test_via_script('$(FULLPERLRUN)', 'test.pl')) if -f "test.pl";
1708     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
1709     push(@m, "\n");
1710
1711     push(@m, "testdb_dynamic :: pure_all\n");
1712     push(@m, $self->test_via_script('$(FULLPERLRUN) "$(TESTDB_SW)"', '$(TEST_FILE)'));
1713     push(@m, "\n");
1714
1715     # Occasionally we may face this degenerate target:
1716     push @m, "test_ : test_dynamic\n\n";
1717
1718     if ($self->needs_linking()) {
1719         push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
1720         push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
1721         push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
1722         push(@m, "\n");
1723         push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
1724         push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
1725         push(@m, "\n");
1726     }
1727     else {
1728         push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
1729         push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
1730     }
1731
1732     join('',@m);
1733 }
1734
1735 =item makeaperl (override)
1736
1737 Undertake to build a new set of Perl images using VMS commands.  Since
1738 VMS does dynamic loading, it's not necessary to statically link each
1739 extension into the Perl image, so this isn't the normal build path.
1740 Consequently, it hasn't really been tested, and may well be incomplete.
1741
1742 =cut
1743
1744 use vars qw(%olbs);
1745
1746 sub makeaperl {
1747     my($self, %attribs) = @_;
1748     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) =
1749       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
1750     my(@m);
1751     push @m, "
1752 # --- MakeMaker makeaperl section ---
1753 MAP_TARGET    = $target
1754 ";
1755     return join '', @m if $self->{PARENT};
1756
1757     my($dir) = join ":", @{$self->{DIR}};
1758
1759     unless ($self->{MAKEAPERL}) {
1760         push @m, q{
1761 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
1762         $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
1763         $(NOECHO) $(PERLRUNINST) \
1764                 Makefile.PL DIR=}, $dir, q{ \
1765                 FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
1766                 MAKEAPERL=1 NORECURS=1 };
1767
1768         push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
1769
1770 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
1771         $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
1772 };
1773         push @m, "\n";
1774
1775         return join '', @m;
1776     }
1777
1778
1779     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
1780     local($_);
1781
1782     # The front matter of the linkcommand...
1783     $linkcmd = join ' ', $Config{'ld'},
1784             grep($_, @Config{qw(large split ldflags ccdlflags)});
1785     $linkcmd =~ s/\s+/ /g;
1786
1787     # Which *.olb files could we make use of...
1788     local(%olbs);       # XXX can this be lexical?
1789     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
1790     require File::Find;
1791     File::Find::find(sub {
1792         return unless m/\Q$self->{LIB_EXT}\E$/;
1793         return if m/^libperl/;
1794
1795         if( exists $self->{INCLUDE_EXT} ){
1796                 my $found = 0;
1797                 my $incl;
1798                 my $xx;
1799
1800                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1801                 $xx =~ s,/?$_,,;
1802                 $xx =~ s,/,::,g;
1803
1804                 # Throw away anything not explicitly marked for inclusion.
1805                 # DynaLoader is implied.
1806                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
1807                         if( $xx eq $incl ){
1808                                 $found++;
1809                                 last;
1810                         }
1811                 }
1812                 return unless $found;
1813         }
1814         elsif( exists $self->{EXCLUDE_EXT} ){
1815                 my $excl;
1816                 my $xx;
1817
1818                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1819                 $xx =~ s,/?$_,,;
1820                 $xx =~ s,/,::,g;
1821
1822                 # Throw away anything explicitly marked for exclusion
1823                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
1824                         return if( $xx eq $excl );
1825                 }
1826         }
1827
1828         $olbs{$ENV{DEFAULT}} = $_;
1829     }, grep( -d $_, @{$searchdirs || []}));
1830
1831     # We trust that what has been handed in as argument will be buildable
1832     $static = [] unless $static;
1833     @olbs{@{$static}} = (1) x @{$static};
1834
1835     $extra = [] unless $extra && ref $extra eq 'ARRAY';
1836     # Sort the object libraries in inverse order of
1837     # filespec length to try to insure that dependent extensions
1838     # will appear before their parents, so the linker will
1839     # search the parent library to resolve references.
1840     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
1841     # references from [.intuit.dwim]dwim.obj can be found
1842     # in [.intuit]intuit.olb).
1843     for (sort { length($a) <=> length($b) } keys %olbs) {
1844         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
1845         my($dir) = $self->fixpath($_,1);
1846         my($extralibs) = $dir . "extralibs.ld";
1847         my($extopt) = $dir . $olbs{$_};
1848         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
1849         push @optlibs, "$dir$olbs{$_}";
1850         # Get external libraries this extension will need
1851         if (-f $extralibs ) {
1852             my %seenthis;
1853             open LIST,$extralibs or warn $!,next;
1854             while (<LIST>) {
1855                 chomp;
1856                 # Include a library in the link only once, unless it's mentioned
1857                 # multiple times within a single extension's options file, in which
1858                 # case we assume the builder needed to search it again later in the
1859                 # link.
1860                 my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
1861                 $libseen{$_}++;  $seenthis{$_}++;
1862                 next if $skip;
1863                 push @$extra,$_;
1864             }
1865             close LIST;
1866         }
1867         # Get full name of extension for ExtUtils::Miniperl
1868         if (-f $extopt) {
1869             open OPT,$extopt or die $!;
1870             while (<OPT>) {
1871                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
1872                 my $pkg = $1;
1873                 $pkg =~ s#__*#::#g;
1874                 push @staticpkgs,$pkg;
1875             }
1876         }
1877     }
1878     # Place all of the external libraries after all of the Perl extension
1879     # libraries in the final link, in order to maximize the opportunity
1880     # for XS code from multiple extensions to resolve symbols against the
1881     # same external library while only including that library once.
1882     push @optlibs, @$extra;
1883
1884     $target = "Perl$Config{'exe_ext'}" unless $target;
1885     my $shrtarget;
1886     ($shrtarget,$targdir) = fileparse($target);
1887     $shrtarget =~ s/^([^.]*)/$1Shr/;
1888     $shrtarget = $targdir . $shrtarget;
1889     $target = "Perlshr.$Config{'dlext'}" unless $target;
1890     $tmpdir = "[]" unless $tmpdir;
1891     $tmpdir = $self->fixpath($tmpdir,1);
1892     if (@optlibs) { $extralist = join(' ',@optlibs); }
1893     else          { $extralist = ''; }
1894     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
1895     # that's what we're building here).
1896     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
1897     if ($libperl) {
1898         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
1899             print STDOUT "Warning: $libperl not found\n";
1900             undef $libperl;
1901         }
1902     }
1903     unless ($libperl) {
1904         if (defined $self->{PERL_SRC}) {
1905             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
1906         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
1907         } else {
1908             print STDOUT "Warning: $libperl not found
1909     If you're going to build a static perl binary, make sure perl is installed
1910     otherwise ignore this warning\n";
1911         }
1912     }
1913     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
1914
1915     push @m, '
1916 # Fill in the target you want to produce if it\'s not perl
1917 MAP_TARGET    = ',$self->fixpath($target,0),'
1918 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
1919 MAP_LINKCMD   = $linkcmd
1920 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
1921 MAP_EXTRA     = $extralist
1922 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
1923 ';
1924
1925
1926     push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
1927     foreach (@optlibs) {
1928         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
1929     }
1930     push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
1931     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
1932
1933     push @m,'
1934 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
1935         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
1936 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
1937         $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
1938         $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
1939         $(NOECHO) $(ECHO) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
1940         $(NOECHO) $(ECHO) "To remove the intermediate files, say
1941         $(NOECHO) $(ECHO) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
1942 ';
1943     push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
1944     push @m, "# More from the 255-char line length limit\n";
1945     foreach (@staticpkgs) {
1946         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
1947     }
1948
1949     push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
1950         $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
1951         $(NOECHO) $(RM_F) %sWritemain.tmp
1952 MAKE_FRAG
1953
1954     push @m, q[
1955 # Still more from the 255-char line length limit
1956 doc_inst_perl :
1957         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1958         $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
1959         $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
1960         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
1961         $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
1962         $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
1963         $(NOECHO) $(RM_F) .MM_tmp
1964 ];
1965
1966     push @m, "
1967 inst_perl : pure_inst_perl doc_inst_perl
1968         \$(NOECHO) \$(NOOP)
1969
1970 pure_inst_perl : \$(MAP_TARGET)
1971         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
1972         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
1973
1974 clean :: map_clean
1975         \$(NOECHO) \$(NOOP)
1976
1977 map_clean :
1978         \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
1979         \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
1980 ";
1981
1982     join '', @m;
1983 }
1984
1985 # --- Output postprocessing section ---
1986
1987 =item nicetext (override)
1988
1989 Insure that colons marking targets are preceded by space, in order
1990 to distinguish the target delimiter from a colon appearing as
1991 part of a filespec.
1992
1993 =cut
1994
1995 sub nicetext {
1996     my($self,$text) = @_;
1997     return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone
1998     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
1999     $text;
2000 }
2001
2002 =item prefixify (override)
2003
2004 prefixifying on VMS is simple.  Each should simply be:
2005
2006     perl_root:[some.dir]
2007
2008 which can just be converted to:
2009
2010     volume:[your.prefix.some.dir]
2011
2012 otherwise you get the default layout.
2013
2014 In effect, your search prefix is ignored and $Config{vms_prefix} is
2015 used instead.
2016
2017 =cut
2018
2019 sub prefixify {
2020     my($self, $var, $sprefix, $rprefix, $default) = @_;
2021
2022     # Translate $(PERLPREFIX) to a real path.
2023     $rprefix = $self->eliminate_macros($rprefix);
2024     $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
2025     $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
2026
2027     $default = VMS::Filespec::vmsify($default)
2028       unless $default =~ /\[.*\]/;
2029
2030     (my $var_no_install = $var) =~ s/^install//;
2031     my $path = $self->{uc $var} ||
2032                $ExtUtils::MM_Unix::Config_Override{lc $var} ||
2033                $Config{lc $var} || $Config{lc $var_no_install};
2034
2035     if( !$path ) {
2036         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
2037         $path = $self->_prefixify_default($rprefix, $default);
2038     }
2039     elsif( $sprefix eq $rprefix ) {
2040         print STDERR "  no new prefix.\n" if $Verbose >= 2;
2041     }
2042     else {
2043
2044         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
2045         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
2046
2047         my($path_vol, $path_dirs) = $self->splitpath( $path );
2048         if( $path_vol eq $Config{vms_prefix}.':' ) {
2049             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
2050
2051             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
2052             $path = $self->_catprefix($rprefix, $path_dirs);
2053         }
2054         else {
2055             $path = $self->_prefixify_default($rprefix, $default);
2056         }
2057     }
2058
2059     print "    now $path\n" if $Verbose >= 2;
2060     return $self->{uc $var} = $path;
2061 }
2062
2063
2064 sub _prefixify_default {
2065     my($self, $rprefix, $default) = @_;
2066
2067     print STDERR "  cannot prefix, using default.\n" if $Verbose >= 2;
2068
2069     if( !$default ) {
2070         print STDERR "No default!\n" if $Verbose >= 1;
2071         return;
2072     }
2073     if( !$rprefix ) {
2074         print STDERR "No replacement prefix!\n" if $Verbose >= 1;
2075         return '';
2076     }
2077
2078     return $self->_catprefix($rprefix, $default);
2079 }
2080
2081 sub _catprefix {
2082     my($self, $rprefix, $default) = @_;
2083
2084     my($rvol, $rdirs) = $self->splitpath($rprefix);
2085     if( $rvol ) {
2086         return $self->catpath($rvol,
2087                                    $self->catdir($rdirs, $default),
2088                                    ''
2089                                   )
2090     }
2091     else {
2092         return $self->catdir($rdirs, $default);
2093     }
2094 }
2095
2096
2097 =item oneliner (o)
2098
2099 =cut
2100
2101 sub oneliner {
2102     my($self, $cmd, $switches) = @_;
2103     $switches = [] unless defined $switches;
2104
2105     # Strip leading and trailing newlines
2106     $cmd =~ s{^\n+}{};
2107     $cmd =~ s{\n+$}{};
2108
2109     $cmd = $self->quote_literal($cmd);
2110     $cmd = $self->escape_newlines($cmd);
2111
2112     # Switches must be quoted else they will be lowercased.
2113     $switches = join ' ', map { qq{"$_"} } @$switches;
2114
2115     return qq{\$(PERLRUN) $switches -e $cmd};
2116 }
2117
2118
2119 =item B<echo> (o)
2120
2121 perl trips up on "<foo>" thinking it's an input redirect.  So we use the
2122 native Write command instead.  Besides, its faster.
2123
2124 =cut
2125
2126 sub echo {
2127     my($self, $text, $file, $appending) = @_;
2128     $appending ||= 0;
2129
2130     my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
2131
2132     my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
2133     push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) }
2134                 split /\n/, $text;
2135     push @cmds, '$(NOECHO) Close MMECHOFILE';
2136     return @cmds;
2137 }
2138
2139
2140 =item quote_literal
2141
2142 =cut
2143
2144 sub quote_literal {
2145     my($self, $text) = @_;
2146
2147     # I believe this is all we should need.
2148     $text =~ s{"}{""}g;
2149
2150     return qq{"$text"};
2151 }
2152
2153 =item escape_newlines
2154
2155 =cut
2156
2157 sub escape_newlines {
2158     my($self, $text) = @_;
2159
2160     $text =~ s{\n}{-\n}g;
2161
2162     return $text;
2163 }
2164
2165 =item max_exec_len
2166
2167 256 characters.
2168
2169 =cut
2170
2171 sub max_exec_len {
2172     my $self = shift;
2173
2174     return $self->{_MAX_EXEC_LEN} ||= 256;
2175 }
2176
2177 =item init_linker (o)
2178
2179 =cut
2180
2181 sub init_linker {
2182     my $self = shift;
2183     $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
2184
2185     my $shr = $Config{dbgprefix} . 'PERLSHR';
2186     if ($self->{PERL_SRC}) {
2187         $self->{PERL_ARCHIVE} ||=
2188           $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
2189     }
2190     else {
2191         $self->{PERL_ARCHIVE} ||=
2192           $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
2193     }
2194
2195     $self->{PERL_ARCHIVE_AFTER} ||= '';
2196 }
2197
2198 =item eliminate_macros
2199
2200 Expands MM[KS]/Make macros in a text string, using the contents of
2201 identically named elements of C<%$self>, and returns the result
2202 as a file specification in Unix syntax.
2203
2204 NOTE:  This is the canonical version of the method.  The version in
2205 File::Spec::VMS is deprecated.
2206
2207 =cut
2208
2209 sub eliminate_macros {
2210     my($self,$path) = @_;
2211     return '' unless $path;
2212     $self = {} unless ref $self;
2213
2214     if ($path =~ /\s/) {
2215       return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
2216     }
2217
2218     my($npath) = unixify($path);
2219     # sometimes unixify will return a string with an off-by-one trailing null
2220     $npath =~ s{\0$}{};
2221
2222     my($complex) = 0;
2223     my($head,$macro,$tail);
2224
2225     # perform m##g in scalar context so it acts as an iterator
2226     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
2227         if (defined $self->{$2}) {
2228             ($head,$macro,$tail) = ($1,$2,$3);
2229             if (ref $self->{$macro}) {
2230                 if (ref $self->{$macro} eq 'ARRAY') {
2231                     $macro = join ' ', @{$self->{$macro}};
2232                 }
2233                 else {
2234                     print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
2235                           "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
2236                     $macro = "\cB$macro\cB";
2237                     $complex = 1;
2238                 }
2239             }
2240             else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
2241             $npath = "$head$macro$tail";
2242         }
2243     }
2244     if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
2245     $npath;
2246 }
2247
2248 =item fixpath
2249
2250 Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
2251 in any directory specification, in order to avoid juxtaposing two
2252 VMS-syntax directories when MM[SK] is run.  Also expands expressions which
2253 are all macro, so that we can tell how long the expansion is, and avoid
2254 overrunning DCL's command buffer when MM[KS] is running.
2255
2256 If optional second argument has a TRUE value, then the return string is
2257 a VMS-syntax directory specification, if it is FALSE, the return string
2258 is a VMS-syntax file specification, and if it is not specified, fixpath()
2259 checks to see whether it matches the name of a directory in the current
2260 default directory, and returns a directory or file specification accordingly.
2261
2262 NOTE:  This is the canonical version of the method.  The version in
2263 File::Spec::VMS is deprecated.
2264
2265 =cut
2266
2267 sub fixpath {
2268     my($self,$path,$force_path) = @_;
2269     return '' unless $path;
2270     $self = bless {} unless ref $self;
2271     my($fixedpath,$prefix,$name);
2272
2273     if ($path =~ /\s/) {
2274       return join ' ',
2275              map { $self->fixpath($_,$force_path) }
2276              split /\s+/, $path;
2277     }
2278
2279     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
2280         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
2281             $fixedpath = vmspath($self->eliminate_macros($path));
2282         }
2283         else {
2284             $fixedpath = vmsify($self->eliminate_macros($path));
2285         }
2286     }
2287     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
2288         my($vmspre) = $self->eliminate_macros("\$($prefix)");
2289         # is it a dir or just a name?
2290         $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
2291         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
2292         $fixedpath = vmspath($fixedpath) if $force_path;
2293     }
2294     else {
2295         $fixedpath = $path;
2296         $fixedpath = vmspath($fixedpath) if $force_path;
2297     }
2298     # No hints, so we try to guess
2299     if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
2300         $fixedpath = vmspath($fixedpath) if -d $fixedpath;
2301     }
2302
2303     # Trim off root dirname if it's had other dirs inserted in front of it.
2304     $fixedpath =~ s/\.000000([\]>])/$1/;
2305     # Special case for VMS absolute directory specs: these will have had device
2306     # prepended during trip through Unix syntax in eliminate_macros(), since
2307     # Unix syntax has no way to express "absolute from the top of this device's
2308     # directory tree".
2309     if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
2310
2311     return $fixedpath;
2312 }
2313
2314
2315 =item os_flavor
2316
2317 VMS is VMS.
2318
2319 =cut
2320
2321 sub os_flavor {
2322     return('VMS');
2323 }
2324
2325 =back
2326
2327 =cut
2328
2329 1;
2330