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