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