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