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