contrib/perl5/lib/ExtUtils/MM_VMS.pm

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