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 # As always, keep under DCL's 255-char limit
 749 pm_to_blib.ts : $(TO_INST_PM)
 750 };
 751
 752     if (scalar(@files) > 0) {  # protect ourselves from empty PM_TO_BLIB
 753
 754       push(@m,qq[\t\$(NOECHO) \$(RM_F) .MM_tmp\n]);
 755       $line = '';  # avoid uninitialized var warning
 756       while ($from = shift(@files),$to = shift(@files)) {
 757         $line .= " $from $to";
 758         if (length($line) > 128) {
 759             push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
 760             $line = '';
 761         }
 762       }
 763       push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
 764
 765       push(@m,q[        $(PERLRUN) "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]);
 766       push(@m,qq[\n\t\$(NOECHO) \$(RM_F) .MM_tmp\n]);
 767
 768     }
 769     push(@m,qq[\t\$(NOECHO) \$(TOUCH) pm_to_blib.ts]);
 770
 771     join('',@m);
 772 }
 773
 774 =item tool_autosplit (override)
 775
 776 Use VMS-style quoting on command line.
 777
 778 =cut
 779
 780 sub tool_autosplit {
 781     my($self, %attribs) = @_;
 782     my($asl) = "";
 783     $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
 784     q{
 785 # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
 786 AUTOSPLITFILE = $(PERLRUN) -e "use AutoSplit;}.$asl.q{autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
 787 };
 788 }
 789
 790 =item tool_sxubpp (override)
 791
 792 Use VMS-style quoting on xsubpp command line.
 793
 794 =cut
 795
 796 sub tool_xsubpp {
 797     my($self) = @_;
 798     return '' unless $self->needs_linking;
 799     my($xsdir) = File::Spec->catdir($self->{PERL_LIB},'ExtUtils');
 800     # drop back to old location if xsubpp is not in new location yet
 801     $xsdir = File::Spec->catdir($self->{PERL_SRC},'ext') unless (-f File::Spec->catfile($xsdir,'xsubpp'));
 802     my(@tmdeps) = '$(XSUBPPDIR)typemap';
 803     if( $self->{TYPEMAPS} ){
 804         my $typemap;
 805         foreach $typemap (@{$self->{TYPEMAPS}}){
 806                 if( ! -f  $typemap ){
 807                         warn "Typemap $typemap not found.\n";
 808                 }
 809                 else{
 810                         push(@tmdeps, $self->fixpath($typemap,0));
 811                 }
 812         }
 813     }
 814     push(@tmdeps, "typemap") if -f "typemap";
 815     my(@tmargs) = map("-typemap $_", @tmdeps);
 816     if( exists $self->{XSOPT} ){
 817         unshift( @tmargs, $self->{XSOPT} );
 818     }
 819
 820     if ($Config{'ldflags'} &&
 821         $Config{'ldflags'} =~ m!/Debug!i &&
 822         (!exists($self->{XSOPT}) || $self->{XSOPT} !~ /linenumbers/)) {
 823         unshift(@tmargs,'-nolinenumbers');
 824     }
 825     my $xsubpp_version = $self->xsubpp_version(File::Spec->catfile($xsdir,'xsubpp'));
 826
 827     # What are the correct thresholds for version 1 && 2 Paul?
 828     if ( $xsubpp_version > 1.923 ){
 829         $self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
 830     } else {
 831         if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
 832             print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
 833         Your version of xsubpp is $xsubpp_version and cannot handle this.
 834         Please upgrade to a more recent version of xsubpp.
 835 };
 836         } else {
 837             $self->{XSPROTOARG} = "";
 838         }
 839     }
 840
 841     "
 842 XSUBPPDIR = $xsdir
 843 XSUBPP = \$(PERLRUN) \$(XSUBPPDIR)xsubpp
 844 XSPROTOARG = $self->{XSPROTOARG}
 845 XSUBPPDEPS = @tmdeps
 846 XSUBPPARGS = @tmargs
 847 ";
 848 }
 849
 850 =item xsubpp_version (override)
 851
 852 Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good)
 853 rather than Unix rules ($sts == 0 ==E<gt> good).
 854
 855 =cut
 856
 857 sub xsubpp_version
 858 {
 859     my($self,$xsubpp) = @_;
 860     my ($version) ;
 861     return '' unless $self->needs_linking;
 862
 863     # try to figure out the version number of the xsubpp on the system
 864
 865     # first try the -v flag, introduced in 1.921 & 2.000a2
 866
 867     my $command = qq{$self->{PERL} "-I$self->{PERL_LIB}" $xsubpp -v};
 868     print "Running: $command\n" if $Verbose;
 869     $version = `$command` ;
 870     if ($?) {
 871         use vmsish 'status';
 872         warn "Running '$command' exits with status $?";
 873     }
 874     chop $version ;
 875
 876     return $1 if $version =~ /^xsubpp version (.*)/ ;
 877
 878     # nope, then try something else
 879
 880     my $counter = '000';
 881     my ($file) = 'temp' ;
 882     $counter++ while -e "$file$counter"; # don't overwrite anything
 883     $file .= $counter;
 884
 885     local(*F);
 886     open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
 887     print F <<EOM ;
 888 MODULE = fred PACKAGE = fred
 889
 890 int
 891 fred(a)
 892         int     a;
 893 EOM
 894
 895     close F ;
 896
 897     $command = "$self->{PERLRUN} $xsubpp $file";
 898     print "Running: $command\n" if $Verbose;
 899     my $text = `$command` ;
 900     if ($?) {
 901         use vmsish 'status';
 902         warn "Running '$command' exits with status $?";
 903     }
 904     unlink $file ;
 905
 906     # gets 1.2 -> 1.92 and 2.000a1
 907     return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
 908
 909     # it is either 1.0 or 1.1
 910     return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
 911
 912     # none of the above, so 1.0
 913     return "1.0" ;
 914 }
 915
 916 =item tools_other (override)
 917
 918 Adds a few MM[SK] macros, and shortens some the installatin commands,
 919 in order to stay under DCL's 255-character limit.  Also changes
 920 EQUALIZE_TIMESTAMP to set revision date of target file to one second
 921 later than source file, since MMK interprets precisely equal revision
 922 dates for a source and target file as a sign that the target needs
 923 to be updated.
 924
 925 =cut
 926
 927 sub tools_other {
 928     my($self) = @_;
 929     qq!
 930 # Assumes \$(MMS) invokes MMS or MMK
 931 # (It is assumed in some cases later that the default makefile name
 932 # (Descrip.MMS for MM[SK]) is used.)
 933 USEMAKEFILE = /Descrip=
 934 USEMACROS = /Macro=(
 935 MACROEND = )
 936 MAKEFILE = Descrip.MMS
 937 SHELL = Posix
 938 TOUCH = $self->{TOUCH}
 939 CHMOD = $self->{CHMOD}
 940 CP = $self->{CP}
 941 MV = $self->{MV}
 942 RM_F  = $self->{RM_F}
 943 RM_RF = $self->{RM_RF}
 944 SAY = Write Sys\$Output
 945 UMASK_NULL = $self->{UMASK_NULL}
 946 MKPATH = Create/Directory
 947 EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
 948 !. ($self->{PARENT} ? '' :
 949 qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
 950 MOD_INSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
 951 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]"
 952 UNINSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
 953 !);
 954 }
 955
 956 =item dist (override)
 957
 958 Provide VMSish defaults for some values, then hand off to
 959 default MM_Unix method.
 960
 961 =cut
 962
 963 sub dist {
 964     my($self, %attribs) = @_;
 965     $attribs{VERSION}      ||= $self->{VERSION_SYM};
 966     $attribs{NAME}         ||= $self->{DISTNAME};
 967     $attribs{ZIPFLAGS}     ||= '-Vu';
 968     $attribs{COMPRESS}     ||= 'gzip';
 969     $attribs{SUFFIX}       ||= '-gz';
 970     $attribs{SHAR}         ||= 'vms_share';
 971     $attribs{DIST_DEFAULT} ||= 'zipdist';
 972
 973     # Sanitize these for use in $(DISTVNAME) filespec
 974     $attribs{VERSION} =~ s/[^\w\$]/_/g;
 975     $attribs{NAME} =~ s/[^\w\$]/-/g;
 976
 977     $attribs{DISTVNAME} ||= '$(DISTNAME)-$(VERSION_SYM)';
 978
 979     return $self->SUPER::dist(%attribs);
 980 }
 981
 982 =item c_o (override)
 983
 984 Use VMS syntax on command line.  In particular, $(DEFINE) and
 985 $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
 986
 987 =cut
 988
 989 sub c_o {
 990     my($self) = @_;
 991     return '' unless $self->needs_linking();
 992     '
 993 .c$(OBJ_EXT) :
 994         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
 995
 996 .cpp$(OBJ_EXT) :
 997         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
 998
 999 .cxx$(OBJ_EXT) :
1000         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
1001
1002 ';
1003 }
1004
1005 =item xs_c (override)
1006
1007 Use MM[SK] macros.
1008
1009 =cut
1010
1011 sub xs_c {
1012     my($self) = @_;
1013     return '' unless $self->needs_linking();
1014     '
1015 .xs.c :
1016         $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
1017 ';
1018 }
1019
1020 =item xs_o (override)
1021
1022 Use MM[SK] macros, and VMS command line for C compiler.
1023
1024 =cut
1025
1026 sub xs_o {      # many makes are too dumb to use xs_c then c_o
1027     my($self) = @_;
1028     return '' unless $self->needs_linking();
1029     '
1030 .xs$(OBJ_EXT) :
1031         $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
1032         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
1033 ';
1034 }
1035
1036 =item top_targets (override)
1037
1038 Path seperator differences.
1039
1040 =cut
1041
1042 sub top_targets {
1043     my($self) = shift;
1044     my(@m);
1045     push @m, '
1046 all :: pure_all manifypods
1047         $(NOECHO) $(NOOP)
1048
1049 pure_all :: config pm_to_blib subdirs linkext
1050         $(NOECHO) $(NOOP)
1051
1052 subdirs :: $(MYEXTLIB)
1053         $(NOECHO) $(NOOP)
1054
1055 config :: $(MAKEFILE) $(INST_LIBDIR).exists
1056         $(NOECHO) $(NOOP)
1057
1058 config :: $(INST_ARCHAUTODIR).exists
1059         $(NOECHO) $(NOOP)
1060
1061 config :: $(INST_AUTODIR).exists
1062         $(NOECHO) $(NOOP)
1063 ';
1064
1065     push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
1066     if (%{$self->{MAN1PODS}}) {
1067         push @m, q[
1068 config :: $(INST_MAN1DIR).exists
1069         $(NOECHO) $(NOOP)
1070 ];
1071         push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
1072     }
1073     if (%{$self->{MAN3PODS}}) {
1074         push @m, q[
1075 config :: $(INST_MAN3DIR).exists
1076         $(NOECHO) $(NOOP)
1077 ];
1078         push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
1079     }
1080
1081     push @m, '
1082 $(O_FILES) : $(H_FILES)
1083 ' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
1084
1085     push @m, q{
1086 help :
1087         perldoc ExtUtils::MakeMaker
1088 };
1089
1090     join('',@m);
1091 }
1092
1093 =item dlsyms (override)
1094
1095 Create VMS linker options files specifying universal symbols for this
1096 extension's shareable image, and listing other shareable images or
1097 libraries to which it should be linked.
1098
1099 =cut
1100
1101 sub dlsyms {
1102     my($self,%attribs) = @_;
1103
1104     return '' unless $self->needs_linking();
1105
1106     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
1107     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
1108     my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
1109     my(@m);
1110
1111     unless ($self->{SKIPHASH}{'dynamic'}) {
1112         push(@m,'
1113 dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
1114         $(NOECHO) $(NOOP)
1115 ');
1116     }
1117
1118     push(@m,'
1119 static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
1120         $(NOECHO) $(NOOP)
1121 ') unless $self->{SKIPHASH}{'static'};
1122
1123     push @m,'
1124 $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
1125         $(CP) $(MMS$SOURCE) $(MMS$TARGET)
1126
1127 $(BASEEXT).opt : Makefile.PL
1128         $(PERLRUN) -e "use ExtUtils::Mksymlists;" -
1129         ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
1130         neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
1131         q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
1132
1133     push @m, '  $(PERL) -e "print ""$(INST_STATIC)/Include=';
1134     if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
1135         $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) {
1136         push @m, ($Config{d_vms_case_sensitive_symbols}
1137                    ? uc($self->{BASEEXT}) :'$(BASEEXT)');
1138     }
1139     else {  # We don't have a "main" object file, so pull 'em all in
1140        # Upcase module names if linker is being case-sensitive
1141        my($upcase) = $Config{d_vms_case_sensitive_symbols};
1142         my(@omods) = map { s/\.[^.]*$//;         # Trim off file type
1143                            s[\$\(\w+_EXT\)][];   # even as a macro
1144                            s/.*[:>\/\]]//;       # Trim off dir spec
1145                            $upcase ? uc($_) : $_;
1146                          } split ' ', $self->eliminate_macros($self->{OBJECT});
1147         my($tmp,@lines,$elt) = '';
1148         $tmp = shift @omods;
1149         foreach $elt (@omods) {
1150             $tmp .= ",$elt";
1151                 if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }
1152         }
1153         push @lines, $tmp;
1154         push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
1155     }
1156         push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
1157
1158     if (length $self->{LDLOADLIBS}) {
1159         my($lib); my($line) = '';
1160         foreach $lib (split ' ', $self->{LDLOADLIBS}) {
1161             $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
1162             if (length($line) + length($lib) > 160) {
1163                 push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
1164                 $line = $lib . '\n';
1165             }
1166             else { $line .= $lib . '\n'; }
1167         }
1168         push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
1169     }
1170
1171     join('',@m);
1172
1173 }
1174
1175 =item dynamic_lib (override)
1176
1177 Use VMS Link command.
1178
1179 =cut
1180
1181 sub dynamic_lib {
1182     my($self, %attribs) = @_;
1183     return '' unless $self->needs_linking(); #might be because of a subdir
1184
1185     return '' unless $self->has_link_code();
1186
1187     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
1188     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
1189     my $shr = $Config{'dbgprefix'} . 'PerlShr';
1190     my(@m);
1191     push @m,"
1192
1193 OTHERLDFLAGS = $otherldflags
1194 INST_DYNAMIC_DEP = $inst_dynamic_dep
1195
1196 ";
1197     push @m, '
1198 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
1199         $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
1200         If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
1201         Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
1202 ';
1203
1204     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1205     join('',@m);
1206 }
1207
1208 =item dynamic_bs (override)
1209
1210 Use VMS-style quoting on Mkbootstrap command line.
1211
1212 =cut
1213
1214 sub dynamic_bs {
1215     my($self, %attribs) = @_;
1216     return '
1217 BOOTSTRAP =
1218 ' unless $self->has_link_code();
1219     '
1220 BOOTSTRAP = '."$self->{BASEEXT}.bs".'
1221
1222 # As MakeMaker mkbootstrap might not write a file (if none is required)
1223 # we use touch to prevent make continually trying to remake it.
1224 # The DynaLoader only reads a non-empty file.
1225 $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
1226         $(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
1227         $(NOECHO) $(PERLRUN) -
1228         -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
1229         $(NOECHO) $(TOUCH) $(MMS$TARGET)
1230
1231 $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
1232         $(NOECHO) $(RM_RF) $(INST_BOOT)
1233         - $(CP) $(BOOTSTRAP) $(INST_BOOT)
1234 ';
1235 }
1236
1237 =item static_lib (override)
1238
1239 Use VMS commands to manipulate object library.
1240
1241 =cut
1242
1243 sub static_lib {
1244     my($self) = @_;
1245     return '' unless $self->needs_linking();
1246
1247     return '
1248 $(INST_STATIC) :
1249         $(NOECHO) $(NOOP)
1250 ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
1251
1252     my(@m,$lib);
1253     push @m,'
1254 # Rely on suffix rule for update action
1255 $(OBJECT) : $(INST_ARCHAUTODIR).exists
1256
1257 $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
1258 ';
1259     # If this extension has its own library (eg SDBM_File)
1260     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
1261     push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
1262
1263     push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
1264
1265     # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
1266     # 'cause it's a library and you can't stick them in other libraries.
1267     # In that case, we use $OBJECT instead and hope for the best
1268     if ($self->{MYEXTLIB}) {
1269       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
1270     } else {
1271       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
1272     }
1273
1274     push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
1275     foreach $lib (split ' ', $self->{EXTRALIBS}) {
1276       push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
1277     }
1278     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1279     join('',@m);
1280 }
1281
1282
1283 =item manifypods (override)
1284
1285 Use VMS-style quoting on command line, and VMS logical name
1286 to specify fallback location at build time if we can't find pod2man.
1287
1288 =cut
1289
1290
1291 sub manifypods {
1292     my($self, %attribs) = @_;
1293     return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
1294     my($dist);
1295     my($pod2man_exe);
1296     if (defined $self->{PERL_SRC}) {
1297         $pod2man_exe = File::Spec->catfile($self->{PERL_SRC},'pod','pod2man');
1298     } else {
1299         $pod2man_exe = File::Spec->catfile($Config{scriptdirexp},'pod2man');
1300     }
1301     if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
1302         # No pod2man but some MAN3PODS to be installed
1303         print <<END;
1304
1305 Warning: I could not locate your pod2man program.  As a last choice,
1306          I will look for the file to which the logical name POD2MAN
1307          points when MMK is invoked.
1308
1309 END
1310         $pod2man_exe = "pod2man";
1311     }
1312     my(@m);
1313     push @m,
1314 qq[POD2MAN_EXE = $pod2man_exe\n],
1315 q[POD2MAN = $(PERLRUN) "-MPod::Man" -we "%m=@ARGV;for(keys %m){" -
1316 -e "Pod::Man->new->parse_from_file($_,$m{$_}) }"
1317 ];
1318     push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
1319     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
1320         my($pod);
1321         foreach $pod (sort keys %{$self->{MAN1PODS}}) {
1322             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1323             push @m, "$pod $self->{MAN1PODS}{$pod}\n";
1324         }
1325         foreach $pod (sort keys %{$self->{MAN3PODS}}) {
1326             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1327             push @m, "$pod $self->{MAN3PODS}{$pod}\n";
1328         }
1329     }
1330     join('', @m);
1331 }
1332
1333 =item processPL (override)
1334
1335 Use VMS-style quoting on command line.
1336
1337 =cut
1338
1339 sub processPL {
1340     my($self) = @_;
1341     return "" unless $self->{PL_FILES};
1342     my(@m, $plfile);
1343     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
1344         my $list = ref($self->{PL_FILES}->{$plfile})
1345                 ? $self->{PL_FILES}->{$plfile}
1346                 : [$self->{PL_FILES}->{$plfile}];
1347         foreach my $target (@$list) {
1348             my $vmsplfile = vmsify($plfile);
1349             my $vmsfile = vmsify($target);
1350             push @m, "
1351 all :: $vmsfile
1352         \$(NOECHO) \$(NOOP)
1353
1354 $vmsfile :: $vmsplfile
1355 ",'     $(PERLRUNINST) '," $vmsplfile $vmsfile
1356 ";
1357         }
1358     }
1359     join "", @m;
1360 }
1361
1362 =item installbin (override)
1363
1364 Stay under DCL's 255 character command line limit once again by
1365 splitting potentially long list of files across multiple lines
1366 in C<realclean> target.
1367
1368 =cut
1369
1370 sub installbin {
1371     my($self) = @_;
1372     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
1373     return '' unless @{$self->{EXE_FILES}};
1374     my(@m, $from, $to, %fromto, @to, $line);
1375     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
1376     for $from (@exefiles) {
1377         my($path) = '$(INST_SCRIPT)' . basename($from);
1378         local($_) = $path;  # backward compatibility
1379         $to = $self->libscan($path);
1380         print "libscan($from) => '$to'\n" if ($Verbose >=2);
1381         $fromto{$from} = vmsify($to);
1382     }
1383     @to = values %fromto;
1384     push @m, "
1385 EXE_FILES = @exefiles
1386
1387 realclean ::
1388 ";
1389     $line = '';  #avoid unitialized var warning
1390     foreach $to (@to) {
1391         if (length($line) + length($to) > 80) {
1392             push @m, "\t\$(RM_F) $line\n";
1393             $line = $to;
1394         }
1395         else { $line .= " $to"; }
1396     }
1397     push @m, "\t\$(RM_F) $line\n\n" if $line;
1398
1399     while (($from,$to) = each %fromto) {
1400         last unless defined $from;
1401         my $todir;
1402         if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
1403         else                   { ($todir = $to) =~ s/[^\)]+$//; }
1404         $todir = $self->fixpath($todir,1);
1405         push @m, "
1406 $to : $from \$(MAKEFILE) ${todir}.exists
1407         \$(CP) $from $to
1408
1409 ", $self->dir_target($todir);
1410     }
1411     join "", @m;
1412 }
1413
1414 =item subdir_x (override)
1415
1416 Use VMS commands to change default directory.
1417
1418 =cut
1419
1420 sub subdir_x {
1421     my($self, $subdir) = @_;
1422     my(@m,$key);
1423     $subdir = $self->fixpath($subdir,1);
1424     push @m, '
1425
1426 subdirs ::
1427         olddef = F$Environment("Default")
1428         Set Default ',$subdir,'
1429         - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
1430         Set Default \'olddef\'
1431 ';
1432     join('',@m);
1433 }
1434
1435 =item clean (override)
1436
1437 Split potentially long list of files across multiple commands (in
1438 order to stay under the magic command line limit).  Also use MM[SK]
1439 commands for handling subdirectories.
1440
1441 =cut
1442
1443 sub clean {
1444     my($self, %attribs) = @_;
1445     my(@m,$dir);
1446     push @m, '
1447 # Delete temporary files but do not touch installed files. We don\'t delete
1448 # the Descrip.MMS here so that a later make realclean still has it to use.
1449 clean ::
1450 ';
1451     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
1452         my($vmsdir) = $self->fixpath($dir,1);
1453         push( @m, '     If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
1454               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
1455     }
1456     push @m, '  $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
1457 ';
1458
1459     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
1460     # Unlink realclean, $attribs{FILES} is a string here; it may contain
1461     # a list or a macro that expands to a list.
1462     if ($attribs{FILES}) {
1463         my($word,$key,@filist);
1464         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1465         else { @filist = split /\s+/, $attribs{FILES}; }
1466         foreach $word (@filist) {
1467             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1468                 push(@otherfiles, @{$self->{$key}});
1469             }
1470             else { push(@otherfiles, $word); }
1471         }
1472     }
1473     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
1474     push(@otherfiles,File::Spec->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
1475     my($file,$line);
1476     $line = '';  #avoid unitialized var warning
1477     # Occasionally files are repeated several times from different sources
1478     { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
1479
1480     foreach $file (@otherfiles) {
1481         $file = $self->fixpath($file);
1482         if (length($line) + length($file) > 80) {
1483             push @m, "\t\$(RM_RF) $line\n";
1484             $line = "$file";
1485         }
1486         else { $line .= " $file"; }
1487     }
1488     push @m, "\t\$(RM_RF) $line\n" if $line;
1489     push(@m, "  $attribs{POSTOP}\n") if $attribs{POSTOP};
1490     join('', @m);
1491 }
1492
1493 =item realclean (override)
1494
1495 Guess what we're working around?  Also, use MM[SK] for subdirectories.
1496
1497 =cut
1498
1499 sub realclean {
1500     my($self, %attribs) = @_;
1501     my(@m);
1502     push(@m,'
1503 # Delete temporary files (via clean) and also delete installed files
1504 realclean :: clean
1505 ');
1506     foreach(@{$self->{DIR}}){
1507         my($vmsdir) = $self->fixpath($_,1);
1508         push(@m, '      If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
1509               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
1510     }
1511     push @m, "  \$(RM_RF) \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n";
1512     push @m, "  \$(RM_RF) \$(DISTVNAME)\n";
1513     # We can't expand several of the MMS macros here, since they don't have
1514     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
1515     # combination of macros).  In order to stay below DCL's 255 char limit,
1516     # we put only 2 on a line.
1517     my($file,$line,$fcnt);
1518     my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
1519     if ($self->has_link_code) {
1520         push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
1521     }
1522     push(@files, values %{$self->{PM}});
1523     $line = '';  #avoid unitialized var warning
1524     # Occasionally files are repeated several times from different sources
1525     { my(%f) = map { ($_,1) } @files; @files = keys %f; }
1526     foreach $file (@files) {
1527         $file = $self->fixpath($file);
1528         if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
1529             push @m, "\t\$(RM_F) $line\n";
1530             $line = "$file";
1531             $fcnt = 0;
1532         }
1533         else { $line .= " $file"; }
1534     }
1535     push @m, "\t\$(RM_F) $line\n" if $line;
1536     if ($attribs{FILES}) {
1537         my($word,$key,@filist,@allfiles);
1538         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1539         else { @filist = split /\s+/, $attribs{FILES}; }
1540         foreach $word (@filist) {
1541             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1542                 push(@allfiles, @{$self->{$key}});
1543             }
1544             else { push(@allfiles, $word); }
1545         }
1546         $line = '';
1547         # Occasionally files are repeated several times from different sources
1548         { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
1549         foreach $file (@allfiles) {
1550             $file = $self->fixpath($file);
1551             if (length($line) + length($file) > 80) {
1552                 push @m, "\t\$(RM_RF) $line\n";
1553                 $line = "$file";
1554             }
1555             else { $line .= " $file"; }
1556         }
1557         push @m, "\t\$(RM_RF) $line\n" if $line;
1558     }
1559     push(@m, "  $attribs{POSTOP}\n")                     if $attribs{POSTOP};
1560     join('', @m);
1561 }
1562
1563
1564 =item dist_core (override)
1565
1566 Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
1567 so C<shdist> target actions are VMS-specific.
1568
1569 =cut
1570
1571 sub dist_core {
1572     my($self) = @_;
1573 q[
1574 dist : $(DIST_DEFAULT)
1575         $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
1576
1577 zipdist : $(DISTVNAME).zip
1578         $(NOECHO) $(NOOP)
1579
1580 tardist : $(DISTVNAME).tar$(SUFFIX)
1581         $(NOECHO) $(NOOP)
1582
1583 $(DISTVNAME).zip : distdir
1584         $(PREOP)
1585         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
1586         $(RM_RF) $(DISTVNAME)
1587         $(POSTOP)
1588
1589 $(DISTVNAME).tar$(SUFFIX) : distdir
1590         $(PREOP)
1591         $(TO_UNIX)
1592         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
1593         $(RM_RF) $(DISTVNAME)
1594         $(COMPRESS) $(DISTVNAME).tar
1595         $(POSTOP)
1596
1597 shdist : distdir
1598         $(PREOP)
1599         $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
1600         $(RM_RF) $(DISTVNAME)
1601         $(POSTOP)
1602 ];
1603 }
1604
1605 =item dist_test (override)
1606
1607 Use VMS commands to change default directory, and use VMS-style
1608 quoting on command line.
1609
1610 =cut
1611
1612 sub dist_test {
1613     my($self) = @_;
1614 q{
1615 disttest : distdir
1616         startdir = F$Environment("Default")
1617         Set Default [.$(DISTVNAME)]
1618         $(ABSPERLRUN) Makefile.PL
1619         $(MMS)$(MMSQUALIFIERS)
1620         $(MMS)$(MMSQUALIFIERS) test
1621         Set Default 'startdir'
1622 };
1623 }
1624
1625 # --- Test and Installation Sections ---
1626
1627 =item install (override)
1628
1629 Work around DCL's 255 character limit several times,and use
1630 VMS-style command line quoting in a few cases.
1631
1632 =cut
1633
1634 sub install {
1635     my($self, %attribs) = @_;
1636     my(@m,@docfiles);
1637
1638     if ($self->{EXE_FILES}) {
1639         my($line,$file) = ('','');
1640         foreach $file (@{$self->{EXE_FILES}}) {
1641             $line .= "$file ";
1642             if (length($line) > 128) {
1643                 push(@docfiles,qq[\t\$(NOECHO) \$(PERL) -e "print '$line'" >>.MM_tmp\n]);
1644                 $line = '';
1645             }
1646         }
1647         push(@docfiles,qq[\t\$(NOECHO) \$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
1648     }
1649
1650     push @m, q[
1651 install :: all pure_install doc_install
1652         $(NOECHO) $(NOOP)
1653
1654 install_perl :: all pure_perl_install doc_perl_install
1655         $(NOECHO) $(NOOP)
1656
1657 install_site :: all pure_site_install doc_site_install
1658         $(NOECHO) $(NOOP)
1659
1660 pure_install :: pure_$(INSTALLDIRS)_install
1661         $(NOECHO) $(NOOP)
1662
1663 doc_install :: doc_$(INSTALLDIRS)_install
1664         $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
1665
1666 pure__install : pure_site_install
1667         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1668
1669 doc__install : doc_site_install
1670         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1671
1672 # This hack brought to you by DCL's 255-character command line limit
1673 pure_perl_install ::
1674         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1675         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1676         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
1677         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
1678         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1679         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1680         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1681         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1682         $(MOD_INSTALL) <.MM_tmp
1683         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1684         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].File::Spec->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
1685
1686 # Likewise
1687 pure_site_install ::
1688         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1689         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1690         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
1691         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
1692         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLSITEBIN) '" >>.MM_tmp
1693         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1694         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLSITEMAN1DIR) '" >>.MM_tmp
1695         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLSITEMAN3DIR) '" >>.MM_tmp
1696         $(MOD_INSTALL) <.MM_tmp
1697         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1698         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].File::Spec->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1699
1700 pure_vendor_install ::
1701         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLVENDORLIB) '" >>.MM_tmp
1702         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLVENDORARCH) '" >>.MM_tmp
1703         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLVENDORBIN) '" >>.MM_tmp
1704         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1705         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLVENDORMAN1DIR) '" >>.MM_tmp
1706         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLVENDORMAN3DIR) '" >>.MM_tmp
1707         $(MOD_INSTALL) <.MM_tmp
1708         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1709
1710 # Ditto
1711 doc_perl_install ::
1712         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
1713         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1714 ],@docfiles,
1715 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1716         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1717         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1718         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1719         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.File::Spec->catfile($self->{INSTALLARCHLIB},'perllocal.pod').q[
1720         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1721
1722 # And again
1723 doc_site_install ::
1724         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
1725         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1726 ],@docfiles,
1727 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1728         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1729         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1730         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1731         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.File::Spec->catfile($self->{INSTALLARCHLIB},'perllocal.pod').q[
1732         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1733
1734 doc_vendor_install ::
1735
1736 ];
1737
1738     push @m, q[
1739 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1740         $(NOECHO) $(NOOP)
1741
1742 uninstall_from_perldirs ::
1743         $(NOECHO) $(UNINSTALL) ].File::Spec->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1744         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1745         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1746         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1747
1748 uninstall_from_sitedirs ::
1749         $(NOECHO) $(UNINSTALL) ],File::Spec->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist'),"\n",q[
1750         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1751         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1752         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1753 ];
1754
1755     join('',@m);
1756 }
1757
1758 =item perldepend (override)
1759
1760 Use VMS-style syntax for files; it's cheaper to just do it directly here
1761 than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
1762 we have to rebuild Config.pm, use MM[SK] to do it.
1763
1764 =cut
1765
1766 sub perldepend {
1767     my($self) = @_;
1768     my(@m);
1769
1770     push @m, '
1771 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
1772 $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
1773 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
1774 $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)fakethr.h, $(PERL_INC)form.h
1775 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
1776 $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
1777 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
1778 $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)opnames.h, $(PERL_INC)patchlevel.h
1779 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlapi.h, $(PERL_INC)perlio.h
1780 $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlsfio.h, $(PERL_INC)perlvars.h
1781 $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
1782 $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
1783 $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1784 $(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h, $(PERL_INC)utf8.h
1785 $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h, $(PERL_INC)warnings.h
1786
1787 ' if $self->{OBJECT};
1788
1789     if ($self->{PERL_SRC}) {
1790         my(@macros);
1791         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
1792         push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
1793         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1794         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1795         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1796         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1797         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1798         push(@m,q[
1799 # Check for unpropagated config.sh changes. Should never happen.
1800 # We do NOT just update config.h because that is not sufficient.
1801 # An out of date config.h is not fatal but complains loudly!
1802 $(PERL_INC)config.h : $(PERL_SRC)config.sh
1803         $(NOOP)
1804
1805 $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
1806         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
1807         olddef = F$Environment("Default")
1808         Set Default $(PERL_SRC)
1809         $(MMS)],$mmsquals,);
1810         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
1811             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
1812             $target =~ s/\Q$prefix/[/;
1813             push(@m," $target");
1814         }
1815         else { push(@m,' $(MMS$TARGET)'); }
1816         push(@m,q[
1817         Set Default 'olddef'
1818 ]);
1819     }
1820
1821     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
1822       if %{$self->{XS}};
1823
1824     join('',@m);
1825 }
1826
1827 =item makefile (override)
1828
1829 Use VMS commands and quoting.
1830
1831 =cut
1832
1833 sub makefile {
1834     my($self) = @_;
1835     my(@m,@cmd);
1836     # We do not know what target was originally specified so we
1837     # must force a manual rerun to be sure. But as it should only
1838     # happen very rarely it is not a significant problem.
1839     push @m, q[
1840 $(OBJECT) : $(FIRST_MAKEFILE)
1841 ] if $self->{OBJECT};
1842
1843     push @m,q[
1844 # We take a very conservative approach here, but it\'s worth it.
1845 # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
1846 $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
1847         $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
1848         $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
1849         - $(MV) $(MAKEFILE) $(MAKEFILE)_old
1850         - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
1851         $(PERLRUN) Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
1852         $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
1853         $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
1854 ];
1855
1856     join('',@m);
1857 }
1858
1859 =item find_tests (override)
1860
1861 =cut
1862
1863 sub find_tests {
1864     my $self = shift;
1865     return -d 't' ? 't/*.t' : '';
1866 }
1867
1868 =item test (override)
1869
1870 Use VMS commands for handling subdirectories.
1871
1872 =cut
1873
1874 sub test {
1875     my($self, %attribs) = @_;
1876     my($tests) = $attribs{TESTS} || $self->find_tests;
1877     my(@m);
1878     push @m,"
1879 TEST_VERBOSE = 0
1880 TEST_TYPE = test_\$(LINKTYPE)
1881 TEST_FILE = test.pl
1882 TESTDB_SW = -d
1883
1884 test :: \$(TEST_TYPE)
1885         \$(NOECHO) \$(NOOP)
1886
1887 testdb :: testdb_\$(LINKTYPE)
1888         \$(NOECHO) \$(NOOP)
1889
1890 ";
1891     foreach(@{$self->{DIR}}){
1892       my($vmsdir) = $self->fixpath($_,1);
1893       push(@m, '        If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
1894            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
1895     }
1896     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
1897         unless $tests or -f "test.pl" or @{$self->{DIR}};
1898     push(@m, "\n");
1899
1900     push(@m, "test_dynamic :: pure_all\n");
1901     push(@m, $self->test_via_harness('$(FULLPERLRUN)', $tests)) if $tests;
1902     push(@m, $self->test_via_script('$(FULLPERLRUN)', 'test.pl')) if -f "test.pl";
1903     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
1904     push(@m, "\n");
1905
1906     push(@m, "testdb_dynamic :: pure_all\n");
1907     push(@m, $self->test_via_script('$(FULLPERLRUN) "$(TESTDB_SW)"', '$(TEST_FILE)'));
1908     push(@m, "\n");
1909
1910     # Occasionally we may face this degenerate target:
1911     push @m, "test_ : test_dynamic\n\n";
1912
1913     if ($self->needs_linking()) {
1914         push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
1915         push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
1916         push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
1917         push(@m, "\n");
1918         push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
1919         push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
1920         push(@m, "\n");
1921     }
1922     else {
1923         push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
1924         push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
1925     }
1926
1927     join('',@m);
1928 }
1929
1930 =item makeaperl (override)
1931
1932 Undertake to build a new set of Perl images using VMS commands.  Since
1933 VMS does dynamic loading, it's not necessary to statically link each
1934 extension into the Perl image, so this isn't the normal build path.
1935 Consequently, it hasn't really been tested, and may well be incomplete.
1936
1937 =cut
1938
1939 our %olbs;
1940
1941 sub makeaperl {
1942     my($self, %attribs) = @_;
1943     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
1944       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
1945     my(@m);
1946     push @m, "
1947 # --- MakeMaker makeaperl section ---
1948 MAP_TARGET    = $target
1949 ";
1950     return join '', @m if $self->{PARENT};
1951
1952     my($dir) = join ":", @{$self->{DIR}};
1953
1954     unless ($self->{MAKEAPERL}) {
1955         push @m, q{
1956 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
1957         $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
1958         $(NOECHO) $(PERLRUNINST) \
1959                 Makefile.PL DIR=}, $dir, q{ \
1960                 MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
1961                 MAKEAPERL=1 NORECURS=1 };
1962
1963         push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
1964
1965 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
1966         $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
1967 };
1968         push @m, "\n";
1969
1970         return join '', @m;
1971     }
1972
1973
1974     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
1975     local($_);
1976
1977     # The front matter of the linkcommand...
1978     $linkcmd = join ' ', $Config{'ld'},
1979             grep($_, @Config{qw(large split ldflags ccdlflags)});
1980     $linkcmd =~ s/\s+/ /g;
1981
1982     # Which *.olb files could we make use of...
1983     local(%olbs);       # XXX can this be lexical?
1984     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
1985     require File::Find;
1986     File::Find::find(sub {
1987         return unless m/\Q$self->{LIB_EXT}\E$/;
1988         return if m/^libperl/;
1989
1990         if( exists $self->{INCLUDE_EXT} ){
1991                 my $found = 0;
1992                 my $incl;
1993                 my $xx;
1994
1995                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1996                 $xx =~ s,/?$_,,;
1997                 $xx =~ s,/,::,g;
1998
1999                 # Throw away anything not explicitly marked for inclusion.
2000                 # DynaLoader is implied.
2001                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
2002                         if( $xx eq $incl ){
2003                                 $found++;
2004                                 last;
2005                         }
2006                 }
2007                 return unless $found;
2008         }
2009         elsif( exists $self->{EXCLUDE_EXT} ){
2010                 my $excl;
2011                 my $xx;
2012
2013                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2014                 $xx =~ s,/?$_,,;
2015                 $xx =~ s,/,::,g;
2016
2017                 # Throw away anything explicitly marked for exclusion
2018                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
2019                         return if( $xx eq $excl );
2020                 }
2021         }
2022
2023         $olbs{$ENV{DEFAULT}} = $_;
2024     }, grep( -d $_, @{$searchdirs || []}));
2025
2026     # We trust that what has been handed in as argument will be buildable
2027     $static = [] unless $static;
2028     @olbs{@{$static}} = (1) x @{$static};
2029
2030     $extra = [] unless $extra && ref $extra eq 'ARRAY';
2031     # Sort the object libraries in inverse order of
2032     # filespec length to try to insure that dependent extensions
2033     # will appear before their parents, so the linker will
2034     # search the parent library to resolve references.
2035     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
2036     # references from [.intuit.dwim]dwim.obj can be found
2037     # in [.intuit]intuit.olb).
2038     for (sort { length($a) <=> length($b) } keys %olbs) {
2039         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
2040         my($dir) = $self->fixpath($_,1);
2041         my($extralibs) = $dir . "extralibs.ld";
2042         my($extopt) = $dir . $olbs{$_};
2043         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
2044         push @optlibs, "$dir$olbs{$_}";
2045         # Get external libraries this extension will need
2046         if (-f $extralibs ) {
2047             my %seenthis;
2048             open LIST,$extralibs or warn $!,next;
2049             while (<LIST>) {
2050                 chomp;
2051                 # Include a library in the link only once, unless it's mentioned
2052                 # multiple times within a single extension's options file, in which
2053                 # case we assume the builder needed to search it again later in the
2054                 # link.
2055                 my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
2056                 $libseen{$_}++;  $seenthis{$_}++;
2057                 next if $skip;
2058                 push @$extra,$_;
2059             }
2060             close LIST;
2061         }
2062         # Get full name of extension for ExtUtils::Miniperl
2063         if (-f $extopt) {
2064             open OPT,$extopt or die $!;
2065             while (<OPT>) {
2066                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
2067                 my $pkg = $1;
2068                 $pkg =~ s#__*#::#g;
2069                 push @staticpkgs,$pkg;
2070             }
2071         }
2072     }
2073     # Place all of the external libraries after all of the Perl extension
2074     # libraries in the final link, in order to maximize the opportunity
2075     # for XS code from multiple extensions to resolve symbols against the
2076     # same external library while only including that library once.
2077     push @optlibs, @$extra;
2078
2079     $target = "Perl$Config{'exe_ext'}" unless $target;
2080     my $shrtarget;
2081     ($shrtarget,$targdir) = fileparse($target);
2082     $shrtarget =~ s/^([^.]*)/$1Shr/;
2083     $shrtarget = $targdir . $shrtarget;
2084     $target = "Perlshr.$Config{'dlext'}" unless $target;
2085     $tmp = "[]" unless $tmp;
2086     $tmp = $self->fixpath($tmp,1);
2087     if (@optlibs) { $extralist = join(' ',@optlibs); }
2088     else          { $extralist = ''; }
2089     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
2090     # that's what we're building here).
2091     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
2092     if ($libperl) {
2093         unless (-f $libperl || -f ($libperl = File::Spec->catfile($Config{'installarchlib'},'CORE',$libperl))) {
2094             print STDOUT "Warning: $libperl not found\n";
2095             undef $libperl;
2096         }
2097     }
2098     unless ($libperl) {
2099         if (defined $self->{PERL_SRC}) {
2100             $libperl = File::Spec->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
2101         } elsif (-f ($libperl = File::Spec->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
2102         } else {
2103             print STDOUT "Warning: $libperl not found
2104     If you're going to build a static perl binary, make sure perl is installed
2105     otherwise ignore this warning\n";
2106         }
2107     }
2108     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
2109
2110     push @m, '
2111 # Fill in the target you want to produce if it\'s not perl
2112 MAP_TARGET    = ',$self->fixpath($target,0),'
2113 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
2114 MAP_LINKCMD   = $linkcmd
2115 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
2116 MAP_EXTRA     = $extralist
2117 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
2118 ';
2119
2120
2121     push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
2122     foreach (@optlibs) {
2123         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
2124     }
2125     push @m,"\n${tmp}PerlShr.Opt :\n\t";
2126     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
2127
2128 push @m,'
2129 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
2130         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
2131 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
2132         $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
2133         $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
2134         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
2135         $(NOECHO) $(SAY) "To remove the intermediate files, say
2136         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
2137 ';
2138     push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
2139     push @m, "# More from the 255-char line length limit\n";
2140     foreach (@staticpkgs) {
2141         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
2142     }
2143         push @m,'
2144         $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
2145         $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
2146
2147     push @m, q[
2148 # Still more from the 255-char line length limit
2149 doc_inst_perl :
2150         $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
2151         $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
2152         $(NOECHO) $(PERL) -pl040 -e " " ].File::Spec->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
2153         $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
2154         $(DOC_INSTALL) <.MM_tmp >>].File::Spec->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
2155         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
2156 ];
2157
2158     push @m, "
2159 inst_perl : pure_inst_perl doc_inst_perl
2160         \$(NOECHO) \$(NOOP)
2161
2162 pure_inst_perl : \$(MAP_TARGET)
2163         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
2164         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
2165
2166 clean :: map_clean
2167         \$(NOECHO) \$(NOOP)
2168
2169 map_clean :
2170         \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
2171         \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
2172 ";
2173
2174     join '', @m;
2175 }
2176
2177 # --- Output postprocessing section ---
2178
2179 =item nicetext (override)
2180
2181 Insure that colons marking targets are preceded by space, in order
2182 to distinguish the target delimiter from a colon appearing as
2183 part of a filespec.
2184
2185 =cut
2186
2187 sub nicetext {
2188     my($self,$text) = @_;
2189     return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone
2190     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
2191     $text;
2192 }
2193
2194 =item prefixify (override)
2195
2196 prefixifying on VMS is simple.  Each should simply be:
2197
2198     perl_root:[some.dir]
2199
2200 which can just be converted to:
2201
2202     volume:[your.prefix.some.dir]
2203
2204 otherwise you get the default layout.
2205
2206 In effect, your search prefix is ignored and $Config{vms_prefix} is
2207 used instead.
2208
2209 =cut
2210
2211 sub prefixify {
2212     my($self, $var, $sprefix, $rprefix, $default) = @_;
2213     $default = VMS::Filespec::vmsify($default)
2214       unless $default =~ /\[.*\]/;
2215
2216     (my $var_no_install = $var) =~ s/^install//;
2217     my $path = $self->{uc $var} || $Config{lc $var} ||
2218                $Config{lc $var_no_install};
2219
2220     if( !$path ) {
2221         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
2222         $path = $self->_prefixify_default($rprefix, $default);
2223     }
2224     elsif( $sprefix eq $rprefix ) {
2225         print STDERR "  no new prefix.\n" if $Verbose >= 2;
2226     }
2227     else {
2228
2229         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
2230         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
2231
2232         my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
2233         if( $path_vol eq $Config{vms_prefix}.':' ) {
2234             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
2235
2236             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
2237             $path = $self->_catprefix($rprefix, $path_dirs);
2238         }
2239         else {
2240             $path = $self->_prefixify_default($rprefix, $default);
2241         }
2242     }
2243
2244     print "    now $path\n" if $Verbose >= 2;
2245     return $self->{uc $var} = $path;
2246 }
2247
2248
2249 sub _prefixify_default {
2250     my($self, $rprefix, $default) = @_;
2251
2252     print STDERR "  cannot prefix, using default.\n" if $Verbose >= 2;
2253
2254     if( !$default ) {
2255         print STDERR "No default!\n" if $Verbose >= 1;
2256         return;
2257     }
2258     if( !$rprefix ) {
2259         print STDERR "No replacement prefix!\n" if $Verbose >= 1;
2260         return '';
2261     }
2262
2263     return $self->_catprefix($rprefix, $default);
2264 }
2265
2266 sub _catprefix {
2267     my($self, $rprefix, $default) = @_;
2268
2269     my($rvol, $rdirs) = File::Spec->splitpath($rprefix);
2270     if( $rvol ) {
2271         return File::Spec->catpath($rvol,
2272                                    File::Spec->catdir($rdirs, $default),
2273                                    ''
2274                                   )
2275     }
2276     else {
2277         return File::Spec->catdir($rdirs, $default);
2278     }
2279 }
2280
2281
2282 =back
2283
2284 =cut
2285
2286 1;
2287