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