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