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