lib/ExtUtils/MM_VMS.pm

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