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