lib/ExtUtils/MM_VMS.pm

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