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