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