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       push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
1470     }
1471     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1472     join('',@m);
1473 }
1474
1475
1476 =item manifypods (override)
1477
1478 Use VMS-style quoting on command line, and VMS logical name
1479 to specify fallback location at build time if we can't find pod2man.
1480
1481 =cut
1482
1483
1484 sub manifypods {
1485     my($self, %attribs) = @_;
1486     return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
1487     my($dist);
1488     my($pod2man_exe);
1489     if (defined $self->{PERL_SRC}) {
1490         $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
1491     } else {
1492         $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
1493     }
1494     if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
1495         # No pod2man but some MAN3PODS to be installed
1496         print <<END;
1497
1498 Warning: I could not locate your pod2man program.  As a last choice,
1499          I will look for the file to which the logical name POD2MAN
1500          points when MMK is invoked.
1501
1502 END
1503         $pod2man_exe = "pod2man";
1504     }
1505     my(@m);
1506     push @m,
1507 qq[POD2MAN_EXE = $pod2man_exe\n],
1508 q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
1509 -e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
1510 ];
1511     push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
1512     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
1513         my($pod);
1514         foreach $pod (sort keys %{$self->{MAN1PODS}}) {
1515             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1516             push @m, "$pod $self->{MAN1PODS}{$pod}\n";
1517         }
1518         foreach $pod (sort keys %{$self->{MAN3PODS}}) {
1519             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1520             push @m, "$pod $self->{MAN3PODS}{$pod}\n";
1521         }
1522     }
1523     join('', @m);
1524 }
1525
1526 =item processPL (override)
1527
1528 Use VMS-style quoting on command line.
1529
1530 =cut
1531
1532 sub processPL {
1533     my($self) = @_;
1534     return "" unless $self->{PL_FILES};
1535     my(@m, $plfile);
1536     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
1537         my $vmsplfile = vmsify($plfile);
1538         my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
1539         push @m, "
1540 all :: $vmsfile
1541         \$(NOECHO) \$(NOOP)
1542
1543 $vmsfile :: $vmsplfile
1544 ",'     $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
1545 ";
1546     }
1547     join "", @m;
1548 }
1549
1550 =item installbin (override)
1551
1552 Stay under DCL's 255 character command line limit once again by
1553 splitting potentially long list of files across multiple lines
1554 in C<realclean> target.
1555
1556 =cut
1557
1558 sub installbin {
1559     my($self) = @_;
1560     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
1561     return '' unless @{$self->{EXE_FILES}};
1562     my(@m, $from, $to, %fromto, @to, $line);
1563     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
1564     for $from (@exefiles) {
1565         my($path) = '$(INST_SCRIPT)' . basename($from);
1566         local($_) = $path;  # backward compatibility
1567         $to = $self->libscan($path);
1568         print "libscan($from) => '$to'\n" if ($Verbose >=2);
1569         $fromto{$from} = vmsify($to);
1570     }
1571     @to = values %fromto;
1572     push @m, "
1573 EXE_FILES = @exefiles
1574
1575 all :: @to
1576         \$(NOECHO) \$(NOOP)
1577
1578 realclean ::
1579 ";
1580     $line = '';  #avoid unitialized var warning
1581     foreach $to (@to) {
1582         if (length($line) + length($to) > 80) {
1583             push @m, "\t\$(RM_F) $line\n";
1584             $line = $to;
1585         }
1586         else { $line .= " $to"; }
1587     }
1588     push @m, "\t\$(RM_F) $line\n\n" if $line;
1589
1590     while (($from,$to) = each %fromto) {
1591         last unless defined $from;
1592         my $todir;
1593         if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
1594         else                   { ($todir = $to) =~ s/[^\)]+$//; }
1595         $todir = $self->fixpath($todir,1);
1596         push @m, "
1597 $to : $from \$(MAKEFILE) ${todir}.exists
1598         \$(CP) $from $to
1599
1600 ", $self->dir_target($todir);
1601     }
1602     join "", @m;
1603 }
1604
1605 =item subdir_x (override)
1606
1607 Use VMS commands to change default directory.
1608
1609 =cut
1610
1611 sub subdir_x {
1612     my($self, $subdir) = @_;
1613     my(@m,$key);
1614     $subdir = $self->fixpath($subdir,1);
1615     push @m, '
1616
1617 subdirs ::
1618         olddef = F$Environment("Default")
1619         Set Default ',$subdir,'
1620         - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
1621         Set Default \'olddef\'
1622 ';
1623     join('',@m);
1624 }
1625
1626 =item clean (override)
1627
1628 Split potentially long list of files across multiple commands (in
1629 order to stay under the magic command line limit).  Also use MM[SK]
1630 commands for handling subdirectories.
1631
1632 =cut
1633
1634 sub clean {
1635     my($self, %attribs) = @_;
1636     my(@m,$dir);
1637     push @m, '
1638 # Delete temporary files but do not touch installed files. We don\'t delete
1639 # the Descrip.MMS here so that a later make realclean still has it to use.
1640 clean ::
1641 ';
1642     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
1643         my($vmsdir) = $self->fixpath($dir,1);
1644         push( @m, '     If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
1645               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
1646     }
1647     push @m, '  $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
1648 ';
1649
1650     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
1651     # Unlink realclean, $attribs{FILES} is a string here; it may contain
1652     # a list or a macro that expands to a list.
1653     if ($attribs{FILES}) {
1654         my($word,$key,@filist);
1655         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1656         else { @filist = split /\s+/, $attribs{FILES}; }
1657         foreach $word (@filist) {
1658             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1659                 push(@otherfiles, @{$self->{$key}});
1660             }
1661             else { push(@otherfiles, $word); }
1662         }
1663     }
1664     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
1665     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
1666     my($file,$line);
1667     $line = '';  #avoid unitialized var warning
1668     # Occasionally files are repeated several times from different sources
1669     { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
1670
1671     foreach $file (@otherfiles) {
1672         $file = $self->fixpath($file);
1673         if (length($line) + length($file) > 80) {
1674             push @m, "\t\$(RM_RF) $line\n";
1675             $line = "$file";
1676         }
1677         else { $line .= " $file"; }
1678     }
1679     push @m, "\t\$(RM_RF) $line\n" if $line;
1680     push(@m, "  $attribs{POSTOP}\n") if $attribs{POSTOP};
1681     join('', @m);
1682 }
1683
1684 =item realclean (override)
1685
1686 Guess what we're working around?  Also, use MM[SK] for subdirectories.
1687
1688 =cut
1689
1690 sub realclean {
1691     my($self, %attribs) = @_;
1692     my(@m);
1693     push(@m,'
1694 # Delete temporary files (via clean) and also delete installed files
1695 realclean :: clean
1696 ');
1697     foreach(@{$self->{DIR}}){
1698         my($vmsdir) = $self->fixpath($_,1);
1699         push(@m, '      If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
1700               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
1701     }
1702     push @m,'   $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
1703 ';
1704     # We can't expand several of the MMS macros here, since they don't have
1705     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
1706     # combination of macros).  In order to stay below DCL's 255 char limit,
1707     # we put only 2 on a line.
1708     my($file,$line,$fcnt);
1709     my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
1710     if ($self->has_link_code) {
1711         push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
1712     }
1713     push(@files, values %{$self->{PM}});
1714     $line = '';  #avoid unitialized var warning
1715     # Occasionally files are repeated several times from different sources
1716     { my(%f) = map { ($_,1) } @files; @files = keys %f; }
1717     foreach $file (@files) {
1718         $file = $self->fixpath($file);
1719         if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
1720             push @m, "\t\$(RM_F) $line\n";
1721             $line = "$file";
1722             $fcnt = 0;
1723         }
1724         else { $line .= " $file"; }
1725     }
1726     push @m, "\t\$(RM_F) $line\n" if $line;
1727     if ($attribs{FILES}) {
1728         my($word,$key,@filist,@allfiles);
1729         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1730         else { @filist = split /\s+/, $attribs{FILES}; }
1731         foreach $word (@filist) {
1732             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1733                 push(@allfiles, @{$self->{$key}});
1734             }
1735             else { push(@allfiles, $word); }
1736         }
1737         $line = '';
1738         # Occasionally files are repeated several times from different sources
1739         { my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
1740         foreach $file (@allfiles) {
1741             $file = $self->fixpath($file);
1742             if (length($line) + length($file) > 80) {
1743                 push @m, "\t\$(RM_RF) $line\n";
1744                 $line = "$file";
1745             }
1746             else { $line .= " $file"; }
1747         }
1748         push @m, "\t\$(RM_RF) $line\n" if $line;
1749     }
1750     push(@m, "  $attribs{POSTOP}\n")                     if $attribs{POSTOP};
1751     join('', @m);
1752 }
1753
1754 =item dist_basics (override)
1755
1756 Use VMS-style quoting on command line.
1757
1758 =cut
1759
1760 sub dist_basics {
1761     my($self) = @_;
1762 '
1763 distclean :: realclean distcheck
1764         $(NOECHO) $(NOOP)
1765
1766 distcheck :
1767         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
1768
1769 skipcheck :
1770         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
1771
1772 manifest :
1773         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
1774 ';
1775 }
1776
1777 =item dist_core (override)
1778
1779 Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
1780 so C<shdist> target actions are VMS-specific.
1781
1782 =cut
1783
1784 sub dist_core {
1785     my($self) = @_;
1786 q[
1787 dist : $(DIST_DEFAULT)
1788         $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
1789
1790 zipdist : $(DISTVNAME).zip
1791         $(NOECHO) $(NOOP)
1792
1793 $(DISTVNAME).zip : distdir
1794         $(PREOP)
1795         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
1796         $(RM_RF) $(DISTVNAME)
1797         $(POSTOP)
1798
1799 $(DISTVNAME).tar$(SUFFIX) : distdir
1800         $(PREOP)
1801         $(TO_UNIX)
1802         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
1803         $(RM_RF) $(DISTVNAME)
1804         $(COMPRESS) $(DISTVNAME).tar
1805         $(POSTOP)
1806
1807 shdist : distdir
1808         $(PREOP)
1809         $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
1810         $(RM_RF) $(DISTVNAME)
1811         $(POSTOP)
1812 ];
1813 }
1814
1815 =item dist_dir (override)
1816
1817 Use VMS-style quoting on command line.
1818
1819 =cut
1820
1821 sub dist_dir {
1822     my($self) = @_;
1823 q{
1824 distdir :
1825         $(RM_RF) $(DISTVNAME)
1826         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
1827         -e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
1828 };
1829 }
1830
1831 =item dist_test (override)
1832
1833 Use VMS commands to change default directory, and use VMS-style
1834 quoting on command line.
1835
1836 =cut
1837
1838 sub dist_test {
1839     my($self) = @_;
1840 q{
1841 disttest : distdir
1842         startdir = F$Environment("Default")
1843         Set Default [.$(DISTVNAME)]
1844         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
1845         $(MMS)$(MMSQUALIFIERS)
1846         $(MMS)$(MMSQUALIFIERS) test
1847         Set Default 'startdir'
1848 };
1849 }
1850
1851 # --- Test and Installation Sections ---
1852
1853 =item install (override)
1854
1855 Work around DCL's 255 character limit several times,and use
1856 VMS-style command line quoting in a few cases.
1857
1858 =cut
1859
1860 sub install {
1861     my($self, %attribs) = @_;
1862     my(@m,@docfiles);
1863
1864     if ($self->{EXE_FILES}) {
1865         my($line,$file) = ('','');
1866         foreach $file (@{$self->{EXE_FILES}}) {
1867             $line .= "$file ";
1868             if (length($line) > 128) {
1869                 push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]);
1870                 $line = '';
1871             }
1872         }
1873         push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
1874     }
1875
1876     push @m, q[
1877 install :: all pure_install doc_install
1878         $(NOECHO) $(NOOP)
1879
1880 install_perl :: all pure_perl_install doc_perl_install
1881         $(NOECHO) $(NOOP)
1882
1883 install_site :: all pure_site_install doc_site_install
1884         $(NOECHO) $(NOOP)
1885
1886 install_ :: install_site
1887         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1888
1889 pure_install :: pure_$(INSTALLDIRS)_install
1890         $(NOECHO) $(NOOP)
1891
1892 doc_install :: doc_$(INSTALLDIRS)_install
1893         $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
1894
1895 pure__install : pure_site_install
1896         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1897
1898 doc__install : doc_site_install
1899         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1900
1901 # This hack brought to you by DCL's 255-character command line limit
1902 pure_perl_install ::
1903         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1904         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1905         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
1906         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
1907         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1908         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1909         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1910         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1911         $(MOD_INSTALL) <.MM_tmp
1912         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1913         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
1914
1915 # Likewise
1916 pure_site_install ::
1917         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1918         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1919         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
1920         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
1921         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1922         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1923         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1924         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1925         $(MOD_INSTALL) <.MM_tmp
1926         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1927         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1928
1929 # Ditto
1930 doc_perl_install ::
1931         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
1932         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1933 ],@docfiles,
1934 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1935         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1936         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1937         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1938         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1939         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1940
1941 # And again
1942 doc_site_install ::
1943         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
1944         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1945 ],@docfiles,
1946 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1947         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1948         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1949         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1950         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1951         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1952
1953 ];
1954
1955     push @m, q[
1956 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1957         $(NOECHO) $(NOOP)
1958
1959 uninstall_from_perldirs ::
1960         $(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1961         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1962         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1963         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1964
1965 uninstall_from_sitedirs ::
1966         $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",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
1972     join('',@m);
1973 }
1974
1975 =item perldepend (override)
1976
1977 Use VMS-style syntax for files; it's cheaper to just do it directly here
1978 than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
1979 we have to rebuild Config.pm, use MM[SK] to do it.
1980
1981 =cut
1982
1983 sub perldepend {
1984     my($self) = @_;
1985     my(@m);
1986
1987     push @m, '
1988 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
1989 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
1990 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
1991 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
1992 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
1993 $(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1994 $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
1995 $(OBJECT) : $(PERL_INC)iperlsys.h
1996
1997 ' if $self->{OBJECT};
1998
1999     if ($self->{PERL_SRC}) {
2000         my(@macros);
2001         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
2002         push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
2003         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
2004         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
2005         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
2006         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
2007         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
2008         push(@m,q[
2009 # Check for unpropagated config.sh changes. Should never happen.
2010 # We do NOT just update config.h because that is not sufficient.
2011 # An out of date config.h is not fatal but complains loudly!
2012 $(PERL_INC)config.h : $(PERL_SRC)config.sh
2013
2014 $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
2015         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
2016         olddef = F$Environment("Default")
2017         Set Default $(PERL_SRC)
2018         $(MMS)],$mmsquals,);
2019         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
2020             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
2021             $target =~ s/\Q$prefix/[/;
2022             push(@m," $target");
2023         }
2024         else { push(@m,' $(MMS$TARGET)'); }
2025         push(@m,q[
2026         Set Default 'olddef'
2027 ]);
2028     }
2029
2030     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
2031       if %{$self->{XS}};
2032
2033     join('',@m);
2034 }
2035
2036 =item makefile (override)
2037
2038 Use VMS commands and quoting.
2039
2040 =cut
2041
2042 sub makefile {
2043     my($self) = @_;
2044     my(@m,@cmd);
2045     # We do not know what target was originally specified so we
2046     # must force a manual rerun to be sure. But as it should only
2047     # happen very rarely it is not a significant problem.
2048     push @m, q[
2049 $(OBJECT) : $(FIRST_MAKEFILE)
2050 ] if $self->{OBJECT};
2051
2052     push @m,q[
2053 # We take a very conservative approach here, but it\'s worth it.
2054 # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
2055 $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
2056         $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
2057         $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
2058         - $(MV) $(MAKEFILE) $(MAKEFILE)_old
2059         - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
2060         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
2061         $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
2062         $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
2063 ];
2064
2065     join('',@m);
2066 }
2067
2068 =item test (override)
2069
2070 Use VMS commands for handling subdirectories.
2071
2072 =cut
2073
2074 sub test {
2075     my($self, %attribs) = @_;
2076     my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
2077     my(@m);
2078     push @m,"
2079 TEST_VERBOSE = 0
2080 TEST_TYPE = test_\$(LINKTYPE)
2081 TEST_FILE = test.pl
2082 TESTDB_SW = -d
2083
2084 test :: \$(TEST_TYPE)
2085         \$(NOECHO) \$(NOOP)
2086
2087 testdb :: testdb_\$(LINKTYPE)
2088         \$(NOECHO) \$(NOOP)
2089
2090 ";
2091     foreach(@{$self->{DIR}}){
2092       my($vmsdir) = $self->fixpath($_,1);
2093       push(@m, '        If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
2094            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
2095     }
2096     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
2097         unless $tests or -f "test.pl" or @{$self->{DIR}};
2098     push(@m, "\n");
2099
2100     push(@m, "test_dynamic :: pure_all\n");
2101     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
2102     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
2103     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
2104     push(@m, "\n");
2105
2106     push(@m, "testdb_dynamic :: pure_all\n");
2107     push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)'));
2108     push(@m, "\n");
2109
2110     # Occasionally we may face this degenerate target:
2111     push @m, "test_ : test_dynamic\n\n";
2112
2113     if ($self->needs_linking()) {
2114         push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
2115         push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
2116         push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
2117         push(@m, "\n");
2118         push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
2119         push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
2120         push(@m, "\n");
2121     }
2122     else {
2123         push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
2124         push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
2125     }
2126
2127     join('',@m);
2128 }
2129
2130 =item test_via_harness (override)
2131
2132 Use VMS-style quoting on command line.
2133
2134 =cut
2135
2136 sub test_via_harness {
2137     my($self,$perl,$tests) = @_;
2138     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
2139     '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
2140 }
2141
2142 =item test_via_script (override)
2143
2144 Use VMS-style quoting on command line.
2145
2146 =cut
2147
2148 sub test_via_script {
2149     my($self,$perl,$script) = @_;
2150     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
2151 ';
2152 }
2153
2154 =item makeaperl (override)
2155
2156 Undertake to build a new set of Perl images using VMS commands.  Since
2157 VMS does dynamic loading, it's not necessary to statically link each
2158 extension into the Perl image, so this isn't the normal build path.
2159 Consequently, it hasn't really been tested, and may well be incomplete.
2160
2161 =cut
2162
2163 sub makeaperl {
2164     my($self, %attribs) = @_;
2165     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
2166       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
2167     my(@m);
2168     push @m, "
2169 # --- MakeMaker makeaperl section ---
2170 MAP_TARGET    = $target
2171 ";
2172     return join '', @m if $self->{PARENT};
2173
2174     my($dir) = join ":", @{$self->{DIR}};
2175
2176     unless ($self->{MAKEAPERL}) {
2177         push @m, q{
2178 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
2179         $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
2180         $(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
2181                 Makefile.PL DIR=}, $dir, q{ \
2182                 MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
2183                 MAKEAPERL=1 NORECURS=1
2184
2185 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
2186         $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
2187 };
2188         push @m, map( " \\\n\t\t$_", @ARGV );
2189         push @m, "\n";
2190
2191         return join '', @m;
2192     }
2193
2194
2195     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
2196     local($_);
2197
2198     # The front matter of the linkcommand...
2199     $linkcmd = join ' ', $Config{'ld'},
2200             grep($_, @Config{qw(large split ldflags ccdlflags)});
2201     $linkcmd =~ s/\s+/ /g;
2202
2203     # Which *.olb files could we make use of...
2204     local(%olbs);
2205     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
2206     require File::Find;
2207     File::Find::find(sub {
2208         return unless m/\Q$self->{LIB_EXT}\E$/;
2209         return if m/^libperl/;
2210
2211         if( exists $self->{INCLUDE_EXT} ){
2212                 my $found = 0;
2213                 my $incl;
2214                 my $xx;
2215
2216                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2217                 $xx =~ s,/?$_,,;
2218                 $xx =~ s,/,::,g;
2219
2220                 # Throw away anything not explicitly marked for inclusion.
2221                 # DynaLoader is implied.
2222                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
2223                         if( $xx eq $incl ){
2224                                 $found++;
2225                                 last;
2226                         }
2227                 }
2228                 return unless $found;
2229         }
2230         elsif( exists $self->{EXCLUDE_EXT} ){
2231                 my $excl;
2232                 my $xx;
2233
2234                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2235                 $xx =~ s,/?$_,,;
2236                 $xx =~ s,/,::,g;
2237
2238                 # Throw away anything explicitly marked for exclusion
2239                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
2240                         return if( $xx eq $excl );
2241                 }
2242         }
2243
2244         $olbs{$ENV{DEFAULT}} = $_;
2245     }, grep( -d $_, @{$searchdirs || []}));
2246
2247     # We trust that what has been handed in as argument will be buildable
2248     $static = [] unless $static;
2249     @olbs{@{$static}} = (1) x @{$static};
2250
2251     $extra = [] unless $extra && ref $extra eq 'ARRAY';
2252     # Sort the object libraries in inverse order of
2253     # filespec length to try to insure that dependent extensions
2254     # will appear before their parents, so the linker will
2255     # search the parent library to resolve references.
2256     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
2257     # references from [.intuit.dwim]dwim.obj can be found
2258     # in [.intuit]intuit.olb).
2259     for (sort { length($a) <=> length($b) } keys %olbs) {
2260         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
2261         my($dir) = $self->fixpath($_,1);
2262         my($extralibs) = $dir . "extralibs.ld";
2263         my($extopt) = $dir . $olbs{$_};
2264         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
2265         push @optlibs, "$dir$olbs{$_}";
2266         # Get external libraries this extension will need
2267         if (-f $extralibs ) {
2268             my %seenthis;
2269             open LIST,$extralibs or warn $!,next;
2270             while (<LIST>) {
2271                 chomp;
2272                 # Include a library in the link only once, unless it's mentioned
2273                 # multiple times within a single extension's options file, in which
2274                 # case we assume the builder needed to search it again later in the
2275                 # link.
2276                 my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
2277                 $libseen{$_}++;  $seenthis{$_}++;
2278                 next if $skip;
2279                 push @$extra,$_;
2280             }
2281             close LIST;
2282         }
2283         # Get full name of extension for ExtUtils::Miniperl
2284         if (-f $extopt) {
2285             open OPT,$extopt or die $!;
2286             while (<OPT>) {
2287                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
2288                 my $pkg = $1;
2289                 $pkg =~ s#__*#::#g;
2290                 push @staticpkgs,$pkg;
2291             }
2292         }
2293     }
2294     # Place all of the external libraries after all of the Perl extension
2295     # libraries in the final link, in order to maximize the opportunity
2296     # for XS code from multiple extensions to resolve symbols against the
2297     # same external library while only including that library once.
2298     push @optlibs, @$extra;
2299
2300     $target = "Perl$Config{'exe_ext'}" unless $target;
2301     ($shrtarget,$targdir) = fileparse($target);
2302     $shrtarget =~ s/^([^.]*)/$1Shr/;
2303     $shrtarget = $targdir . $shrtarget;
2304     $target = "Perlshr.$Config{'dlext'}" unless $target;
2305     $tmp = "[]" unless $tmp;
2306     $tmp = $self->fixpath($tmp,1);
2307     if (@optlibs) { $extralist = join(' ',@optlibs); }
2308     else          { $extralist = ''; }
2309     # Let ExtUtils::Liblist find the necessary for us (but skip PerlShr;
2310     # that's what we're building here).
2311     push @optlibs, grep { !/PerlShr/i } split +($self->ext())[2];
2312     if ($libperl) {
2313         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
2314             print STDOUT "Warning: $libperl not found\n";
2315             undef $libperl;
2316         }
2317     }
2318     unless ($libperl) {
2319         if (defined $self->{PERL_SRC}) {
2320             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
2321         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
2322         } else {
2323             print STDOUT "Warning: $libperl not found
2324     If you're going to build a static perl binary, make sure perl is installed
2325     otherwise ignore this warning\n";
2326         }
2327     }
2328     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
2329
2330     push @m, '
2331 # Fill in the target you want to produce if it\'s not perl
2332 MAP_TARGET    = ',$self->fixpath($target,0),'
2333 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
2334 MAP_LINKCMD   = $linkcmd
2335 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
2336 MAP_EXTRA     = $extralist
2337 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
2338 ';
2339
2340
2341     push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
2342     foreach (@optlibs) {
2343         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
2344     }
2345     push @m,"\n${tmp}PerlShr.Opt :\n\t";
2346     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
2347
2348 push @m,'
2349 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
2350         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
2351 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
2352         $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
2353         $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
2354         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
2355         $(NOECHO) $(SAY) "To remove the intermediate files, say
2356         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
2357 ';
2358     push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
2359     push @m, "# More from the 255-char line length limit\n";
2360     foreach (@staticpkgs) {
2361         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
2362     }
2363         push @m,'
2364         $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
2365         $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
2366
2367     push @m, q[
2368 # Still more from the 255-char line length limit
2369 doc_inst_perl :
2370         $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
2371         $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
2372         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
2373         $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
2374         $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
2375         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
2376 ];
2377
2378     push @m, "
2379 inst_perl : pure_inst_perl doc_inst_perl
2380         \$(NOECHO) \$(NOOP)
2381
2382 pure_inst_perl : \$(MAP_TARGET)
2383         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
2384         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
2385
2386 clean :: map_clean
2387         \$(NOECHO) \$(NOOP)
2388
2389 map_clean :
2390         \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
2391         \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
2392 ";
2393
2394     join '', @m;
2395 }
2396
2397 # --- Output postprocessing section ---
2398
2399 =item nicetext (override)
2400
2401 Insure that colons marking targets are preceded by space, in order
2402 to distinguish the target delimiter from a colon appearing as
2403 part of a filespec.
2404
2405 =cut
2406
2407 sub nicetext {
2408
2409     my($self,$text) = @_;
2410     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
2411     $text;
2412 }
2413
2414 1;
2415
2416 =back
2417
2418 =cut
2419
2420 __END__
2421