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