lib/ExtUtils/MM_VMS.pm

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