lib/ExtUtils/MM_VMS.pm

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