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     warn "Running '$command' exits with status " . $? unless ($? & 1);
1055     unlink $file ;
1056
1057     # gets 1.2 -> 1.92 and 2.000a1
1058     return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
1059
1060     # it is either 1.0 or 1.1
1061     return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
1062
1063     # none of the above, so 1.0
1064     return "1.0" ;
1065 }
1066
1067 =item tools_other (override)
1068
1069 Adds a few MM[SK] macros, and shortens some the installatin commands,
1070 in order to stay under DCL's 255-character limit.  Also changes
1071 EQUALIZE_TIMESTAMP to set revision date of target file to one second
1072 later than source file, since MMK interprets precisely equal revision
1073 dates for a source and target file as a sign that the target needs
1074 to be updated.
1075
1076 =cut
1077
1078 sub tools_other {
1079     my($self) = @_;
1080     qq!
1081 # Assumes \$(MMS) invokes MMS or MMK
1082 # (It is assumed in some cases later that the default makefile name
1083 # (Descrip.MMS for MM[SK]) is used.)
1084 USEMAKEFILE = /Descrip=
1085 USEMACROS = /Macro=(
1086 MACROEND = )
1087 MAKEFILE = Descrip.MMS
1088 SHELL = Posix
1089 TOUCH = $self->{TOUCH}
1090 CHMOD = $self->{CHMOD}
1091 CP = $self->{CP}
1092 MV = $self->{MV}
1093 RM_F  = $self->{RM_F}
1094 RM_RF = $self->{RM_RF}
1095 SAY = Write Sys\$Output
1096 UMASK_NULL = $self->{UMASK_NULL}
1097 NOOP = $self->{NOOP}
1098 NOECHO = $self->{NOECHO}
1099 MKPATH = Create/Directory
1100 EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
1101 !. ($self->{PARENT} ? '' :
1102 qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
1103 MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
1104 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]"
1105 UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
1106 !);
1107 }
1108
1109 =item dist (override)
1110
1111 Provide VMSish defaults for some values, then hand off to
1112 default MM_Unix method.
1113
1114 =cut
1115
1116 sub dist {
1117     my($self, %attribs) = @_;
1118     $attribs{VERSION}      ||= $self->{VERSION_SYM};
1119     $attribs{ZIPFLAGS}     ||= '-Vu';
1120     $attribs{COMPRESS}     ||= 'gzip';
1121     $attribs{SUFFIX}       ||= '-gz';
1122     $attribs{SHAR}         ||= 'vms_share';
1123     $attribs{DIST_DEFAULT} ||= 'zipdist';
1124
1125     return ExtUtils::MM_Unix::dist($self,%attribs);
1126 }
1127
1128 =item c_o (override)
1129
1130 Use VMS syntax on command line.  In particular, $(DEFINE) and
1131 $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
1132
1133 =cut
1134
1135 sub c_o {
1136     my($self) = @_;
1137     return '' unless $self->needs_linking();
1138     '
1139 .c$(OBJ_EXT) :
1140         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
1141
1142 .cpp$(OBJ_EXT) :
1143         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
1144
1145 .cxx$(OBJ_EXT) :
1146         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
1147
1148 ';
1149 }
1150
1151 =item xs_c (override)
1152
1153 Use MM[SK] macros.
1154
1155 =cut
1156
1157 sub xs_c {
1158     my($self) = @_;
1159     return '' unless $self->needs_linking();
1160     '
1161 .xs.c :
1162         $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
1163 ';
1164 }
1165
1166 =item xs_o (override)
1167
1168 Use MM[SK] macros, and VMS command line for C compiler.
1169
1170 =cut
1171
1172 sub xs_o {      # many makes are too dumb to use xs_c then c_o
1173     my($self) = @_;
1174     return '' unless $self->needs_linking();
1175     '
1176 .xs$(OBJ_EXT) :
1177         $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
1178         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
1179 ';
1180 }
1181
1182 =item top_targets (override)
1183
1184 Use VMS quoting on command line for Version_check.
1185
1186 =cut
1187
1188 sub top_targets {
1189     my($self) = shift;
1190     my(@m);
1191     push @m, '
1192 all :: pure_all manifypods
1193         $(NOECHO) $(NOOP)
1194
1195 pure_all :: config pm_to_blib subdirs linkext
1196         $(NOECHO) $(NOOP)
1197
1198 subdirs :: $(MYEXTLIB)
1199         $(NOECHO) $(NOOP)
1200
1201 config :: $(MAKEFILE) $(INST_LIBDIR).exists
1202         $(NOECHO) $(NOOP)
1203
1204 config :: $(INST_ARCHAUTODIR).exists
1205         $(NOECHO) $(NOOP)
1206
1207 config :: $(INST_AUTODIR).exists
1208         $(NOECHO) $(NOOP)
1209 ';
1210
1211     push @m, q{
1212 config :: Version_check
1213         $(NOECHO) $(NOOP)
1214
1215 } unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
1216
1217
1218     push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
1219     if (%{$self->{MAN1PODS}}) {
1220         push @m, q[
1221 config :: $(INST_MAN1DIR).exists
1222         $(NOECHO) $(NOOP)
1223 ];
1224         push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
1225     }
1226     if (%{$self->{MAN3PODS}}) {
1227         push @m, q[
1228 config :: $(INST_MAN3DIR).exists
1229         $(NOECHO) $(NOOP)
1230 ];
1231         push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
1232     }
1233
1234     push @m, '
1235 $(O_FILES) : $(H_FILES)
1236 ' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
1237
1238     push @m, q{
1239 help :
1240         perldoc ExtUtils::MakeMaker
1241 };
1242
1243     push @m, q{
1244 Version_check :
1245         $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
1246         "-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
1247 };
1248
1249     join('',@m);
1250 }
1251
1252 =item dlsyms (override)
1253
1254 Create VMS linker options files specifying universal symbols for this
1255 extension's shareable image, and listing other shareable images or
1256 libraries to which it should be linked.
1257
1258 =cut
1259
1260 sub dlsyms {
1261     my($self,%attribs) = @_;
1262
1263     return '' unless $self->needs_linking();
1264
1265     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
1266     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
1267     my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
1268     my(@m);
1269
1270     unless ($self->{SKIPHASH}{'dynamic'}) {
1271         push(@m,'
1272 dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
1273         $(NOECHO) $(NOOP)
1274 ');
1275         if ($srcdir) {
1276            my($popt) = $self->catfile($srcdir,'perlshr.opt');
1277            my($lopt) = $self->catfile($srcdir,'crtl.opt');
1278            push(@m,"# Depend on \$(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
1279 rtls.opt : $popt $lopt \$(BASEEXT).opt
1280         Copy/Log $popt Sys\$Disk:[]rtls.opt
1281         Append/Log $lopt Sys\$Disk:[]rtls.opt
1282 ");
1283         }
1284         else {
1285             push(@m,'
1286 # rtls.opt is built in the same step as $(BASEEXT).opt
1287 rtls.opt : $(BASEEXT).opt
1288         $(TOUCH) $(MMS$TARGET)
1289 ');
1290         }
1291     }
1292
1293     push(@m,'
1294 static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
1295         $(NOECHO) $(NOOP)
1296 ') unless $self->{SKIPHASH}{'static'};
1297
1298     push(@m,'
1299 $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
1300         $(CP) $(MMS$SOURCE) $(MMS$TARGET)
1301
1302 $(BASEEXT).opt : Makefile.PL
1303         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
1304         ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
1305         neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
1306         $(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
1307 ');
1308
1309     if (length $self->{LDLOADLIBS}) {
1310         my($lib); my($line) = '';
1311         foreach $lib (split ' ', $self->{LDLOADLIBS}) {
1312             $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
1313             if (length($line) + length($lib) > 160) {
1314                 push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
1315                 $line = $lib . '\n';
1316             }
1317             else { $line .= $lib . '\n'; }
1318         }
1319         push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
1320     }
1321
1322     join('',@m);
1323
1324 }
1325
1326 =item dynamic_lib (override)
1327
1328 Use VMS Link command.
1329
1330 =cut
1331
1332 sub dynamic_lib {
1333     my($self, %attribs) = @_;
1334     return '' unless $self->needs_linking(); #might be because of a subdir
1335
1336     return '' unless $self->has_link_code();
1337
1338     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
1339     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
1340     my(@m);
1341     push @m,"
1342
1343 OTHERLDFLAGS = $otherldflags
1344 INST_DYNAMIC_DEP = $inst_dynamic_dep
1345
1346 ";
1347     push @m, '
1348 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
1349         $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
1350         $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
1351         Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
1352 ';
1353
1354     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1355     join('',@m);
1356 }
1357
1358 =item dynamic_bs (override)
1359
1360 Use VMS-style quoting on Mkbootstrap command line.
1361
1362 =cut
1363
1364 sub dynamic_bs {
1365     my($self, %attribs) = @_;
1366     return '
1367 BOOTSTRAP =
1368 ' unless $self->has_link_code();
1369     '
1370 BOOTSTRAP = '."$self->{BASEEXT}.bs".'
1371
1372 # As MakeMaker mkbootstrap might not write a file (if none is required)
1373 # we use touch to prevent make continually trying to remake it.
1374 # The DynaLoader only reads a non-empty file.
1375 $(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
1376         $(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
1377         $(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
1378         -e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
1379         $(NOECHO) $(TOUCH) $(MMS$TARGET)
1380
1381 $(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
1382         $(NOECHO) $(RM_RF) $(INST_BOOT)
1383         - $(CP) $(BOOTSTRAP) $(INST_BOOT)
1384 ';
1385 }
1386
1387 =item static_lib (override)
1388
1389 Use VMS commands to manipulate object library.
1390
1391 =cut
1392
1393 sub static_lib {
1394     my($self) = @_;
1395     return '' unless $self->needs_linking();
1396
1397     return '
1398 $(INST_STATIC) :
1399         $(NOECHO) $(NOOP)
1400 ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
1401
1402     my(@m);
1403     push @m,'
1404 # Rely on suffix rule for update action
1405 $(OBJECT) : $(INST_ARCHAUTODIR).exists
1406
1407 $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
1408 ';
1409     # If this extension has it's own library (eg SDBM_File)
1410     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
1411     push(@m, '  $(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
1412
1413     push(@m,'
1414         If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
1415         Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
1416         $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
1417 ');
1418     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1419     join('',@m);
1420 }
1421
1422
1423 # sub installpm_x { # called by installpm perl file
1424 #     my($self, $dist, $inst, $splitlib) = @_;
1425 #     if ($inst =~ m!#!) {
1426 #       warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
1427 #       return '';
1428 #     }
1429 #     $inst = $self->fixpath($inst);
1430 #     $dist = $self->fixpath($dist);
1431 #     my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
1432 #     my(@m);
1433 #
1434 #     push(@m, "
1435 # $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
1436 # ",'   $(NOECHO) $(RM_F) $(MMS$TARGET)
1437 #       $(NOECHO) $(CP) ',"$dist $inst",'
1438 #       $(CHMOD) 644 $(MMS$TARGET)
1439 # ');
1440 #     push(@m, '        $(AUTOSPLITFILE) $(MMS$TARGET) ',
1441 #               $self->catdir($splitlib,'auto')."\n\n")
1442 #         if ($splitlib and $inst =~ /\.pm$/);
1443 #     push(@m,$self->dir_target($instdir));
1444 #
1445 #     join('',@m);
1446 # }
1447
1448 =item manifypods (override)
1449
1450 Use VMS-style quoting on command line, and VMS logical name
1451 to specify fallback location at build time if we can't find pod2man.
1452
1453 =cut
1454
1455
1456 sub manifypods {
1457     my($self, %attribs) = @_;
1458     return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
1459     my($dist);
1460     my($pod2man_exe);
1461     if (defined $self->{PERL_SRC}) {
1462         $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
1463     } else {
1464         $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
1465     }
1466     if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
1467         # No pod2man but some MAN3PODS to be installed
1468         print <<END;
1469
1470 Warning: I could not locate your pod2man program.  As a last choice,
1471          I will look for the file to which the logical name POD2MAN
1472          points when MMK is invoked.
1473
1474 END
1475         $pod2man_exe = "pod2man";
1476     }
1477     my(@m);
1478     push @m,
1479 qq[POD2MAN_EXE = $pod2man_exe\n],
1480 q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
1481 -e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
1482 ];
1483     push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
1484     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
1485         my($pod);
1486         foreach $pod (sort keys %{$self->{MAN1PODS}}) {
1487             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1488             push @m, "$pod $self->{MAN1PODS}{$pod}\n";
1489         }
1490         foreach $pod (sort keys %{$self->{MAN3PODS}}) {
1491             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1492             push @m, "$pod $self->{MAN3PODS}{$pod}\n";
1493         }
1494     }
1495     join('', @m);
1496 }
1497
1498 =item processPL (override)
1499
1500 Use VMS-style quoting on command line.
1501
1502 =cut
1503
1504 sub processPL {
1505     my($self) = @_;
1506     return "" unless $self->{PL_FILES};
1507     my(@m, $plfile);
1508     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
1509         my $vmsplfile = vmsify($plfile);
1510         my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
1511         push @m, "
1512 all :: $vmsfile
1513         \$(NOECHO) \$(NOOP)
1514
1515 $vmsfile :: $vmsplfile
1516 ",'     $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
1517 ";
1518     }
1519     join "", @m;
1520 }
1521
1522 =item installbin (override)
1523
1524 Stay under DCL's 255 character command line limit once again by
1525 splitting potentially long list of files across multiple lines
1526 in C<realclean> target.
1527
1528 =cut
1529
1530 sub installbin {
1531     my($self) = @_;
1532     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
1533     return '' unless @{$self->{EXE_FILES}};
1534     my(@m, $from, $to, %fromto, @to, $line);
1535     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
1536     for $from (@exefiles) {
1537         my($path) = '$(INST_SCRIPT)' . basename($from);
1538         local($_) = $path;  # backward compatibility
1539         $to = $self->libscan($path);
1540         print "libscan($from) => '$to'\n" if ($Verbose >=2);
1541         $fromto{$from} = vmsify($to);
1542     }
1543     @to = values %fromto;
1544     push @m, "
1545 EXE_FILES = @exefiles
1546
1547 all :: @to
1548         \$(NOECHO) \$(NOOP)
1549
1550 realclean ::
1551 ";
1552     $line = '';  #avoid unitialized var warning
1553     foreach $to (@to) {
1554         if (length($line) + length($to) > 80) {
1555             push @m, "\t\$(RM_F) $line\n";
1556             $line = $to;
1557         }
1558         else { $line .= " $to"; }
1559     }
1560     push @m, "\t\$(RM_F) $line\n\n" if $line;
1561
1562     while (($from,$to) = each %fromto) {
1563         last unless defined $from;
1564         my $todir;
1565         if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
1566         else                   { ($todir = $to) =~ s/[^\)]+$//; }
1567         $todir = $self->fixpath($todir,1);
1568         push @m, "
1569 $to : $from \$(MAKEFILE) ${todir}.exists
1570         \$(CP) $from $to
1571
1572 ", $self->dir_target($todir);
1573     }
1574     join "", @m;
1575 }
1576
1577 =item subdir_x (override)
1578
1579 Use VMS commands to change default directory.
1580
1581 =cut
1582
1583 sub subdir_x {
1584     my($self, $subdir) = @_;
1585     my(@m,$key);
1586     $subdir = $self->fixpath($subdir,1);
1587     push @m, '
1588
1589 subdirs ::
1590         olddef = F$Environment("Default")
1591         Set Default ',$subdir,'
1592         - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
1593         Set Default \'olddef\'
1594 ';
1595     join('',@m);
1596 }
1597
1598 =item clean (override)
1599
1600 Split potentially long list of files across multiple commands (in
1601 order to stay under the magic command line limit).  Also use MM[SK]
1602 commands for handling subdirectories.
1603
1604 =cut
1605
1606 sub clean {
1607     my($self, %attribs) = @_;
1608     my(@m,$dir);
1609     push @m, '
1610 # Delete temporary files but do not touch installed files. We don\'t delete
1611 # the Descrip.MMS here so that a later make realclean still has it to use.
1612 clean ::
1613 ';
1614     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
1615         my($vmsdir) = $self->fixpath($dir,1);
1616         push( @m, '     If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
1617               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
1618     }
1619     push @m, '  $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
1620 ';
1621
1622     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
1623     # Unlink realclean, $attribs{FILES} is a string here; it may contain
1624     # a list or a macro that expands to a list.
1625     if ($attribs{FILES}) {
1626         my($word,$key,@filist);
1627         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1628         else { @filist = split /\s+/, $attribs{FILES}; }
1629         foreach $word (@filist) {
1630             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1631                 push(@otherfiles, @{$self->{$key}});
1632             }
1633             else { push(@otherfiles, $attribs{FILES}); }
1634         }
1635     }
1636     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
1637     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
1638     my($file,$line);
1639     $line = '';  #avoid unitialized var warning
1640     foreach $file (@otherfiles) {
1641         $file = $self->fixpath($file);
1642         if (length($line) + length($file) > 80) {
1643             push @m, "\t\$(RM_RF) $line\n";
1644             $line = "$file";
1645         }
1646         else { $line .= " $file"; }
1647     }
1648     push @m, "\t\$(RM_RF) $line\n" if $line;
1649     push(@m, "  $attribs{POSTOP}\n") if $attribs{POSTOP};
1650     join('', @m);
1651 }
1652
1653 =item realclean (override)
1654
1655 Guess what we're working around?  Also, use MM[SK] for subdirectories.
1656
1657 =cut
1658
1659 sub realclean {
1660     my($self, %attribs) = @_;
1661     my(@m);
1662     push(@m,'
1663 # Delete temporary files (via clean) and also delete installed files
1664 realclean :: clean
1665 ');
1666     foreach(@{$self->{DIR}}){
1667         my($vmsdir) = $self->fixpath($_,1);
1668         push(@m, '      If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
1669               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
1670     }
1671     push @m,'   $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
1672 ';
1673     # We can't expand several of the MMS macros here, since they don't have
1674     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
1675     # combination of macros).  In order to stay below DCL's 255 char limit,
1676     # we put only 2 on a line.
1677     my($file,$line,$fcnt);
1678     my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
1679     if ($self->has_link_code) {
1680         push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
1681     }
1682     push(@files, values %{$self->{PM}});
1683     $line = '';  #avoid unitialized var warning
1684     foreach $file (@files) {
1685         $file = $self->fixpath($file);
1686         if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
1687             push @m, "\t\$(RM_F) $line\n";
1688             $line = "$file";
1689             $fcnt = 0;
1690         }
1691         else { $line .= " $file"; }
1692     }
1693     push @m, "\t\$(RM_F) $line\n" if $line;
1694     if ($attribs{FILES}) {
1695         my($word,$key,@filist,@allfiles);
1696         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1697         else { @filist = split /\s+/, $attribs{FILES}; }
1698         foreach $word (@filist) {
1699             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1700                 push(@allfiles, @{$self->{$key}});
1701             }
1702             else { push(@allfiles, $attribs{FILES}); }
1703         }
1704         $line = '';
1705         foreach $file (@allfiles) {
1706             $file = $self->fixpath($file);
1707             if (length($line) + length($file) > 80) {
1708                 push @m, "\t\$(RM_RF) $line\n";
1709                 $line = "$file";
1710             }
1711             else { $line .= " $file"; }
1712         }
1713         push @m, "\t\$(RM_RF) $line\n" if $line;
1714     }
1715     push(@m, "  $attribs{POSTOP}\n")                     if $attribs{POSTOP};
1716     join('', @m);
1717 }
1718
1719 =item dist_basics (override)
1720
1721 Use VMS-style quoting on command line.
1722
1723 =cut
1724
1725 sub dist_basics {
1726     my($self) = @_;
1727 '
1728 distclean :: realclean distcheck
1729         $(NOECHO) $(NOOP)
1730
1731 distcheck :
1732         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
1733
1734 skipcheck :
1735         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
1736
1737 manifest :
1738         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
1739 ';
1740 }
1741
1742 =item dist_core (override)
1743
1744 Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
1745 so C<shdist> target actions are VMS-specific.
1746
1747 =cut
1748
1749 sub dist_core {
1750     my($self) = @_;
1751 q[
1752 dist : $(DIST_DEFAULT)
1753         $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)'"
1754
1755 zipdist : $(DISTVNAME).zip
1756         $(NOECHO) $(NOOP)
1757
1758 $(DISTVNAME).zip : distdir
1759         $(PREOP)
1760         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) $(SRC)
1761         $(RM_RF) $(DISTVNAME)
1762         $(POSTOP)
1763
1764 $(DISTVNAME).tar$(SUFFIX) : distdir
1765         $(PREOP)
1766         $(TO_UNIX)
1767         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar $(SRC)
1768         $(RM_RF) $(DISTVNAME)
1769         $(COMPRESS) $(DISTVNAME).tar
1770         $(POSTOP)
1771
1772 shdist : distdir
1773         $(PREOP)
1774         $(SHARE) $(SRC) $(DISTVNAME).share
1775         $(RM_RF) $(DISTVNAME)
1776         $(POSTOP)
1777 ];
1778 }
1779
1780 =item dist_dir (override)
1781
1782 Use VMS-style quoting on command line.
1783
1784 =cut
1785
1786 sub dist_dir {
1787     my($self) = @_;
1788 q{
1789 distdir :
1790         $(RM_RF) $(DISTVNAME)
1791         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
1792         -e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
1793 };
1794 }
1795
1796 =item dist_test (override)
1797
1798 Use VMS commands to change default directory, and use VMS-style
1799 quoting on command line.
1800
1801 =cut
1802
1803 sub dist_test {
1804     my($self) = @_;
1805 q{
1806 disttest : distdir
1807         startdir = F$Environment("Default")
1808         Set Default [.$(DISTVNAME)]
1809         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
1810         $(MMS)$(MMSQUALIFIERS)
1811         $(MMS)$(MMSQUALIFIERS) test
1812         Set Default 'startdir'
1813 };
1814 }
1815
1816 # --- Test and Installation Sections ---
1817
1818 =item install (override)
1819
1820 Work around DCL's 255 character limit several times,and use
1821 VMS-style command line quoting in a few cases.
1822
1823 =cut
1824
1825 sub install {
1826     my($self, %attribs) = @_;
1827     my(@m,@docfiles);
1828
1829     if ($self->{EXE_FILES}) {
1830         my($line,$file) = ('','');
1831         foreach $file (@{$self->{EXE_FILES}}) {
1832             $line .= "$file ";
1833             if (length($line) > 128) {
1834                 push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]);
1835                 $line = '';
1836             }
1837         }
1838         push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
1839     }
1840
1841     push @m, q[
1842 install :: all pure_install doc_install
1843         $(NOECHO) $(NOOP)
1844
1845 install_perl :: all pure_perl_install doc_perl_install
1846         $(NOECHO) $(NOOP)
1847
1848 install_site :: all pure_site_install doc_site_install
1849         $(NOECHO) $(NOOP)
1850
1851 install_ :: install_site
1852         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1853
1854 pure_install :: pure_$(INSTALLDIRS)_install
1855         $(NOECHO) $(NOOP)
1856
1857 doc_install :: doc_$(INSTALLDIRS)_install
1858         $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
1859
1860 pure__install : pure_site_install
1861         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1862
1863 doc__install : doc_site_install
1864         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1865
1866 # This hack brought to you by DCL's 255-character command line limit
1867 pure_perl_install ::
1868         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1869         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1870         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
1871         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
1872         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1873         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1874         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1875         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1876         $(MOD_INSTALL) <.MM_tmp
1877         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1878         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
1879
1880 # Likewise
1881 pure_site_install ::
1882         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1883         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1884         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
1885         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
1886         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1887         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1888         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1889         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1890         $(MOD_INSTALL) <.MM_tmp
1891         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1892         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1893
1894 # Ditto
1895 doc_perl_install ::
1896         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
1897         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
1898         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
1899 ],@docfiles,
1900 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1901         $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1902         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1903         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1904         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1905         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1906
1907 # And again
1908 doc_site_install ::
1909         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
1910         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
1911         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
1912 ],@docfiles,
1913 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1914         $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1915         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1916         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1917         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1918         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1919
1920 ];
1921
1922     push @m, q[
1923 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1924         $(NOECHO) $(NOOP)
1925
1926 uninstall_from_perldirs ::
1927         $(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1928         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1929         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1930         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1931
1932 uninstall_from_sitedirs ::
1933         $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",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
1939     join('',@m);
1940 }
1941
1942 =item perldepend (override)
1943
1944 Use VMS-style syntax for files; it's cheaper to just do it directly here
1945 than to have the MM_Unix method call C<catfile> repeatedly.  Also use
1946 config.vms as source of original config data if the Perl distribution
1947 is available; config.sh is an ancillary file under VMS.  Finally, if
1948 we have to rebuild Config.pm, use MM[SK] to do it.
1949
1950 =cut
1951
1952 sub perldepend {
1953     my($self) = @_;
1954     my(@m);
1955
1956     push @m, '
1957 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
1958 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
1959 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
1960 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
1961 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
1962 $(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1963 $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
1964
1965 ' if $self->{OBJECT};
1966
1967     if ($self->{PERL_SRC}) {
1968         my(@macros);
1969         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
1970         push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
1971         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1972         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1973         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1974         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1975         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1976         push(@m,q[
1977 # Check for unpropagated config.sh changes. Should never happen.
1978 # We do NOT just update config.h because that is not sufficient.
1979 # An out of date config.h is not fatal but complains loudly!
1980 #$(PERL_INC)config.h : $(PERL_SRC)config.sh
1981 $(PERL_INC)config.h : $(PERL_VMS)config.vms
1982         $(NOECHO) Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
1983
1984 #$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
1985 $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
1986         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
1987         olddef = F$Environment("Default")
1988         Set Default $(PERL_SRC)
1989         $(MMS)],$mmsquals,);
1990         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
1991             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
1992             $target =~ s/\Q$prefix/[/;
1993             push(@m," $target");
1994         }
1995         else { push(@m,' $(MMS$TARGET)'); }
1996         push(@m,q[
1997         Set Default 'olddef'
1998 ]);
1999     }
2000
2001     push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
2002       if %{$self->{XS}};
2003
2004     join('',@m);
2005 }
2006
2007 =item makefile (override)
2008
2009 Use VMS commands and quoting.
2010
2011 =cut
2012
2013 sub makefile {
2014     my($self) = @_;
2015     my(@m,@cmd);
2016     # We do not know what target was originally specified so we
2017     # must force a manual rerun to be sure. But as it should only
2018     # happen very rarely it is not a significant problem.
2019     push @m, q[
2020 $(OBJECT) : $(FIRST_MAKEFILE)
2021 ] if $self->{OBJECT};
2022
2023     push @m,q[
2024 # We take a very conservative approach here, but it\'s worth it.
2025 # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
2026 $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
2027         $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
2028         $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
2029         - $(MV) $(MAKEFILE) $(MAKEFILE)_old
2030         - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
2031         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
2032         $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
2033         $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
2034 ];
2035
2036     join('',@m);
2037 }
2038
2039 =item test (override)
2040
2041 Use VMS commands for handling subdirectories.
2042
2043 =cut
2044
2045 sub test {
2046     my($self, %attribs) = @_;
2047     my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
2048     my(@m);
2049     push @m,"
2050 TEST_VERBOSE = 0
2051 TEST_TYPE = test_\$(LINKTYPE)
2052 TEST_FILE = test.pl
2053 TESTDB_SW = -d
2054
2055 test :: \$(TEST_TYPE)
2056         \$(NOECHO) \$(NOOP)
2057
2058 testdb :: testdb_\$(LINKTYPE)
2059         \$(NOECHO) \$(NOOP)
2060
2061 ";
2062     foreach(@{$self->{DIR}}){
2063       my($vmsdir) = $self->fixpath($_,1);
2064       push(@m, '        If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
2065            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
2066     }
2067     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
2068         unless $tests or -f "test.pl" or @{$self->{DIR}};
2069     push(@m, "\n");
2070
2071     push(@m, "test_dynamic :: pure_all\n");
2072     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
2073     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
2074     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
2075     push(@m, "\n");
2076
2077     push(@m, "testdb_dynamic :: pure_all\n");
2078     push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)'));
2079     push(@m, "\n");
2080
2081     # Occasionally we may face this degenerate target:
2082     push @m, "test_ : test_dynamic\n\n";
2083
2084     if ($self->needs_linking()) {
2085         push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
2086         push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
2087         push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
2088         push(@m, "\n");
2089         push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
2090         push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
2091         push(@m, "\n");
2092     }
2093     else {
2094         push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
2095         push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
2096     }
2097
2098     join('',@m);
2099 }
2100
2101 =item test_via_harness (override)
2102
2103 Use VMS-style quoting on command line.
2104
2105 =cut
2106
2107 sub test_via_harness {
2108     my($self,$perl,$tests) = @_;
2109     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
2110     '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
2111 }
2112
2113 =item test_via_script (override)
2114
2115 Use VMS-style quoting on command line.
2116
2117 =cut
2118
2119 sub test_via_script {
2120     my($self,$perl,$script) = @_;
2121     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
2122 ';
2123 }
2124
2125 =item makeaperl (override)
2126
2127 Undertake to build a new set of Perl images using VMS commands.  Since
2128 VMS does dynamic loading, it's not necessary to statically link each
2129 extension into the Perl image, so this isn't the normal build path.
2130 Consequently, it hasn't really been tested, and may well be incomplete.
2131
2132 =cut
2133
2134 sub makeaperl {
2135     my($self, %attribs) = @_;
2136     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
2137       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
2138     my(@m);
2139     push @m, "
2140 # --- MakeMaker makeaperl section ---
2141 MAP_TARGET    = $target
2142 ";
2143     return join '', @m if $self->{PARENT};
2144
2145     my($dir) = join ":", @{$self->{DIR}};
2146
2147     unless ($self->{MAKEAPERL}) {
2148         push @m, q{
2149 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
2150         $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
2151         $(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
2152                 Makefile.PL DIR=}, $dir, q{ \
2153                 MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
2154                 MAKEAPERL=1 NORECURS=1
2155
2156 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
2157         $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
2158 };
2159         push @m, map( " \\\n\t\t$_", @ARGV );
2160         push @m, "\n";
2161
2162         return join '', @m;
2163     }
2164
2165
2166     my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
2167
2168     # The front matter of the linkcommand...
2169     $linkcmd = join ' ', $Config{'ld'},
2170             grep($_, @Config{qw(large split ldflags ccdlflags)});
2171     $linkcmd =~ s/\s+/ /g;
2172
2173     # Which *.olb files could we make use of...
2174     local(%olbs);
2175     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
2176     require File::Find;
2177     File::Find::find(sub {
2178         return unless m/\Q$self->{LIB_EXT}\E$/;
2179         return if m/^libperl/;
2180
2181         if( exists $self->{INCLUDE_EXT} ){
2182                 my $found = 0;
2183                 my $incl;
2184                 my $xx;
2185
2186                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2187                 $xx =~ s,/?$_,,;
2188                 $xx =~ s,/,::,g;
2189
2190                 # Throw away anything not explicitly marked for inclusion.
2191                 # DynaLoader is implied.
2192                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
2193                         if( $xx eq $incl ){
2194                                 $found++;
2195                                 last;
2196                         }
2197                 }
2198                 return unless $found;
2199         }
2200         elsif( exists $self->{EXCLUDE_EXT} ){
2201                 my $excl;
2202                 my $xx;
2203
2204                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2205                 $xx =~ s,/?$_,,;
2206                 $xx =~ s,/,::,g;
2207
2208                 # Throw away anything explicitly marked for exclusion
2209                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
2210                         return if( $xx eq $excl );
2211                 }
2212         }
2213
2214         $olbs{$ENV{DEFAULT}} = $_;
2215     }, grep( -d $_, @{$searchdirs || []}));
2216
2217     # We trust that what has been handed in as argument will be buildable
2218     $static = [] unless $static;
2219     @olbs{@{$static}} = (1) x @{$static};
2220
2221     $extra = [] unless $extra && ref $extra eq 'ARRAY';
2222     # Sort the object libraries in inverse order of
2223     # filespec length to try to insure that dependent extensions
2224     # will appear before their parents, so the linker will
2225     # search the parent library to resolve references.
2226     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
2227     # references from [.intuit.dwim]dwim.obj can be found
2228     # in [.intuit]intuit.olb).
2229     for (sort keys %olbs) {
2230         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
2231         my($dir) = $self->fixpath($_,1);
2232         my($extralibs) = $dir . "extralibs.ld";
2233         my($extopt) = $dir . $olbs{$_};
2234         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
2235         if (-f $extralibs ) {
2236             open LIST,$extralibs or warn $!,next;
2237             push @$extra, <LIST>;
2238             close LIST;
2239         }
2240         if (-f $extopt) {
2241             open OPT,$extopt or die $!;
2242             while (<OPT>) {
2243                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
2244                 # ExtUtils::Miniperl expects Unix paths
2245                 (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
2246                 push @staticpkgs,$pkg;
2247             }
2248             push @staticopts, $extopt;
2249         }
2250     }
2251
2252     $target = "Perl$Config{'exe_ext'}" unless $target;
2253     ($shrtarget,$targdir) = fileparse($target);
2254     $shrtarget =~ s/^([^.]*)/$1Shr/;
2255     $shrtarget = $targdir . $shrtarget;
2256     $target = "Perlshr.$Config{'dlext'}" unless $target;
2257     $tmp = "[]" unless $tmp;
2258     $tmp = $self->fixpath($tmp,1);
2259     if (@$extra) {
2260         $extralist = join(' ',@$extra);
2261         $extralist =~ s/[,\s\n]+/, /g;
2262     }
2263     else { $extralist = ''; }
2264     if ($libperl) {
2265         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
2266             print STDOUT "Warning: $libperl not found\n";
2267             undef $libperl;
2268         }
2269     }
2270     unless ($libperl) {
2271         if (defined $self->{PERL_SRC}) {
2272             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
2273         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
2274         } else {
2275             print STDOUT "Warning: $libperl not found
2276     If you're going to build a static perl binary, make sure perl is installed
2277     otherwise ignore this warning\n";
2278         }
2279     }
2280     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
2281
2282     push @m, '
2283 # Fill in the target you want to produce if it\'s not perl
2284 MAP_TARGET    = ',$self->fixpath($target),'
2285 MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
2286 MAP_LINKCMD   = $linkcmd
2287 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
2288 # We use the linker options files created with each extension, rather than
2289 #specifying the object files directly on the command line.
2290 MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
2291 MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
2292 MAP_EXTRA     = $extralist
2293 MAP_LIBPERL = ",$self->fixpath($libperl),'
2294 ';
2295
2296
2297     push @m,'
2298 $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
2299         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
2300 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
2301         $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
2302         $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
2303         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
2304         $(NOECHO) $(SAY) "To remove the intermediate files, say
2305         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
2306 ';
2307     push @m,'
2308 ',"${tmp}perlmain.c",' : $(MAKEFILE)
2309         $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
2310 ';
2311
2312     push @m, q[
2313 # More from the 255-char line length limit
2314 doc_inst_perl :
2315         $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
2316         $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
2317         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
2318         $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
2319         $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
2320         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
2321 ];
2322
2323     push @m, "
2324 inst_perl : pure_inst_perl doc_inst_perl
2325         \$(NOECHO) \$(NOOP)
2326
2327 pure_inst_perl : \$(MAP_TARGET)
2328         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
2329         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
2330
2331 clean :: map_clean
2332         \$(NOECHO) \$(NOOP)
2333
2334 map_clean :
2335         \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
2336         \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
2337 ";
2338
2339     join '', @m;
2340 }
2341
2342 # --- Output postprocessing section ---
2343
2344 =item nicetext (override)
2345
2346 Insure that colons marking targets are preceded by space, in order
2347 to distinguish the target delimiter from a colon appearing as
2348 part of a filespec.
2349
2350 =cut
2351
2352 sub nicetext {
2353
2354     my($self,$text) = @_;
2355     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
2356     $text;
2357 }
2358
2359 1;
2360
2361 =back
2362
2363 =cut
2364
2365 __END__
2366