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