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 ');
1426     # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
1427     # 'cause it's a library and you can't stick them in other libraries.
1428     # In that case, we use $OBJECT instead and hope for the best
1429     if ($self->{MYEXTLIB}) {
1430       push(@m,'
1431         Library/Object/Replace $(MMS$TARGET) $(OBJECT)
1432 ');
1433     } else {
1434       push(@m,'
1435         Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
1436 ');
1437     }
1438
1439     push(@m, '
1440         $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
1441 ');
1442     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
1443     join('',@m);
1444 }
1445
1446
1447 # sub installpm_x { # called by installpm perl file
1448 #     my($self, $dist, $inst, $splitlib) = @_;
1449 #     if ($inst =~ m!#!) {
1450 #       warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
1451 #       return '';
1452 #     }
1453 #     $inst = $self->fixpath($inst);
1454 #     $dist = $self->fixpath($dist);
1455 #     my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
1456 #     my(@m);
1457 #
1458 #     push(@m, "
1459 # $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
1460 # ",'   $(NOECHO) $(RM_F) $(MMS$TARGET)
1461 #       $(NOECHO) $(CP) ',"$dist $inst",'
1462 #       $(CHMOD) 644 $(MMS$TARGET)
1463 # ');
1464 #     push(@m, '        $(AUTOSPLITFILE) $(MMS$TARGET) ',
1465 #               $self->catdir($splitlib,'auto')."\n\n")
1466 #         if ($splitlib and $inst =~ /\.pm$/);
1467 #     push(@m,$self->dir_target($instdir));
1468 #
1469 #     join('',@m);
1470 # }
1471
1472 =item manifypods (override)
1473
1474 Use VMS-style quoting on command line, and VMS logical name
1475 to specify fallback location at build time if we can't find pod2man.
1476
1477 =cut
1478
1479
1480 sub manifypods {
1481     my($self, %attribs) = @_;
1482     return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
1483     my($dist);
1484     my($pod2man_exe);
1485     if (defined $self->{PERL_SRC}) {
1486         $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
1487     } else {
1488         $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
1489     }
1490     if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
1491         # No pod2man but some MAN3PODS to be installed
1492         print <<END;
1493
1494 Warning: I could not locate your pod2man program.  As a last choice,
1495          I will look for the file to which the logical name POD2MAN
1496          points when MMK is invoked.
1497
1498 END
1499         $pod2man_exe = "pod2man";
1500     }
1501     my(@m);
1502     push @m,
1503 qq[POD2MAN_EXE = $pod2man_exe\n],
1504 q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
1505 -e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
1506 ];
1507     push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
1508     if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
1509         my($pod);
1510         foreach $pod (sort keys %{$self->{MAN1PODS}}) {
1511             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1512             push @m, "$pod $self->{MAN1PODS}{$pod}\n";
1513         }
1514         foreach $pod (sort keys %{$self->{MAN3PODS}}) {
1515             push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
1516             push @m, "$pod $self->{MAN3PODS}{$pod}\n";
1517         }
1518     }
1519     join('', @m);
1520 }
1521
1522 =item processPL (override)
1523
1524 Use VMS-style quoting on command line.
1525
1526 =cut
1527
1528 sub processPL {
1529     my($self) = @_;
1530     return "" unless $self->{PL_FILES};
1531     my(@m, $plfile);
1532     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
1533         my $vmsplfile = vmsify($plfile);
1534         my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
1535         push @m, "
1536 all :: $vmsfile
1537         \$(NOECHO) \$(NOOP)
1538
1539 $vmsfile :: $vmsplfile
1540 ",'     $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
1541 ";
1542     }
1543     join "", @m;
1544 }
1545
1546 =item installbin (override)
1547
1548 Stay under DCL's 255 character command line limit once again by
1549 splitting potentially long list of files across multiple lines
1550 in C<realclean> target.
1551
1552 =cut
1553
1554 sub installbin {
1555     my($self) = @_;
1556     return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
1557     return '' unless @{$self->{EXE_FILES}};
1558     my(@m, $from, $to, %fromto, @to, $line);
1559     my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
1560     for $from (@exefiles) {
1561         my($path) = '$(INST_SCRIPT)' . basename($from);
1562         local($_) = $path;  # backward compatibility
1563         $to = $self->libscan($path);
1564         print "libscan($from) => '$to'\n" if ($Verbose >=2);
1565         $fromto{$from} = vmsify($to);
1566     }
1567     @to = values %fromto;
1568     push @m, "
1569 EXE_FILES = @exefiles
1570
1571 all :: @to
1572         \$(NOECHO) \$(NOOP)
1573
1574 realclean ::
1575 ";
1576     $line = '';  #avoid unitialized var warning
1577     foreach $to (@to) {
1578         if (length($line) + length($to) > 80) {
1579             push @m, "\t\$(RM_F) $line\n";
1580             $line = $to;
1581         }
1582         else { $line .= " $to"; }
1583     }
1584     push @m, "\t\$(RM_F) $line\n\n" if $line;
1585
1586     while (($from,$to) = each %fromto) {
1587         last unless defined $from;
1588         my $todir;
1589         if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
1590         else                   { ($todir = $to) =~ s/[^\)]+$//; }
1591         $todir = $self->fixpath($todir,1);
1592         push @m, "
1593 $to : $from \$(MAKEFILE) ${todir}.exists
1594         \$(CP) $from $to
1595
1596 ", $self->dir_target($todir);
1597     }
1598     join "", @m;
1599 }
1600
1601 =item subdir_x (override)
1602
1603 Use VMS commands to change default directory.
1604
1605 =cut
1606
1607 sub subdir_x {
1608     my($self, $subdir) = @_;
1609     my(@m,$key);
1610     $subdir = $self->fixpath($subdir,1);
1611     push @m, '
1612
1613 subdirs ::
1614         olddef = F$Environment("Default")
1615         Set Default ',$subdir,'
1616         - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
1617         Set Default \'olddef\'
1618 ';
1619     join('',@m);
1620 }
1621
1622 =item clean (override)
1623
1624 Split potentially long list of files across multiple commands (in
1625 order to stay under the magic command line limit).  Also use MM[SK]
1626 commands for handling subdirectories.
1627
1628 =cut
1629
1630 sub clean {
1631     my($self, %attribs) = @_;
1632     my(@m,$dir);
1633     push @m, '
1634 # Delete temporary files but do not touch installed files. We don\'t delete
1635 # the Descrip.MMS here so that a later make realclean still has it to use.
1636 clean ::
1637 ';
1638     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
1639         my($vmsdir) = $self->fixpath($dir,1);
1640         push( @m, '     If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
1641               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
1642     }
1643     push @m, '  $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
1644 ';
1645
1646     my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
1647     # Unlink realclean, $attribs{FILES} is a string here; it may contain
1648     # a list or a macro that expands to a list.
1649     if ($attribs{FILES}) {
1650         my($word,$key,@filist);
1651         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1652         else { @filist = split /\s+/, $attribs{FILES}; }
1653         foreach $word (@filist) {
1654             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1655                 push(@otherfiles, @{$self->{$key}});
1656             }
1657             else { push(@otherfiles, $attribs{FILES}); }
1658         }
1659     }
1660     push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
1661     push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
1662     my($file,$line);
1663     $line = '';  #avoid unitialized var warning
1664     foreach $file (@otherfiles) {
1665         $file = $self->fixpath($file);
1666         if (length($line) + length($file) > 80) {
1667             push @m, "\t\$(RM_RF) $line\n";
1668             $line = "$file";
1669         }
1670         else { $line .= " $file"; }
1671     }
1672     push @m, "\t\$(RM_RF) $line\n" if $line;
1673     push(@m, "  $attribs{POSTOP}\n") if $attribs{POSTOP};
1674     join('', @m);
1675 }
1676
1677 =item realclean (override)
1678
1679 Guess what we're working around?  Also, use MM[SK] for subdirectories.
1680
1681 =cut
1682
1683 sub realclean {
1684     my($self, %attribs) = @_;
1685     my(@m);
1686     push(@m,'
1687 # Delete temporary files (via clean) and also delete installed files
1688 realclean :: clean
1689 ');
1690     foreach(@{$self->{DIR}}){
1691         my($vmsdir) = $self->fixpath($_,1);
1692         push(@m, '      If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
1693               '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
1694     }
1695     push @m,'   $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
1696 ';
1697     # We can't expand several of the MMS macros here, since they don't have
1698     # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
1699     # combination of macros).  In order to stay below DCL's 255 char limit,
1700     # we put only 2 on a line.
1701     my($file,$line,$fcnt);
1702     my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
1703     if ($self->has_link_code) {
1704         push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
1705     }
1706     push(@files, values %{$self->{PM}});
1707     $line = '';  #avoid unitialized var warning
1708     foreach $file (@files) {
1709         $file = $self->fixpath($file);
1710         if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
1711             push @m, "\t\$(RM_F) $line\n";
1712             $line = "$file";
1713             $fcnt = 0;
1714         }
1715         else { $line .= " $file"; }
1716     }
1717     push @m, "\t\$(RM_F) $line\n" if $line;
1718     if ($attribs{FILES}) {
1719         my($word,$key,@filist,@allfiles);
1720         if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
1721         else { @filist = split /\s+/, $attribs{FILES}; }
1722         foreach $word (@filist) {
1723             if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
1724                 push(@allfiles, @{$self->{$key}});
1725             }
1726             else { push(@allfiles, $attribs{FILES}); }
1727         }
1728         $line = '';
1729         foreach $file (@allfiles) {
1730             $file = $self->fixpath($file);
1731             if (length($line) + length($file) > 80) {
1732                 push @m, "\t\$(RM_RF) $line\n";
1733                 $line = "$file";
1734             }
1735             else { $line .= " $file"; }
1736         }
1737         push @m, "\t\$(RM_RF) $line\n" if $line;
1738     }
1739     push(@m, "  $attribs{POSTOP}\n")                     if $attribs{POSTOP};
1740     join('', @m);
1741 }
1742
1743 =item dist_basics (override)
1744
1745 Use VMS-style quoting on command line.
1746
1747 =cut
1748
1749 sub dist_basics {
1750     my($self) = @_;
1751 '
1752 distclean :: realclean distcheck
1753         $(NOECHO) $(NOOP)
1754
1755 distcheck :
1756         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
1757
1758 skipcheck :
1759         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"
1760
1761 manifest :
1762         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
1763 ';
1764 }
1765
1766 =item dist_core (override)
1767
1768 Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
1769 so C<shdist> target actions are VMS-specific.
1770
1771 =cut
1772
1773 sub dist_core {
1774     my($self) = @_;
1775 q[
1776 dist : $(DIST_DEFAULT)
1777         $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
1778
1779 zipdist : $(DISTVNAME).zip
1780         $(NOECHO) $(NOOP)
1781
1782 $(DISTVNAME).zip : distdir
1783         $(PREOP)
1784         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
1785         $(RM_RF) $(DISTVNAME)
1786         $(POSTOP)
1787
1788 $(DISTVNAME).tar$(SUFFIX) : distdir
1789         $(PREOP)
1790         $(TO_UNIX)
1791         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
1792         $(RM_RF) $(DISTVNAME)
1793         $(COMPRESS) $(DISTVNAME).tar
1794         $(POSTOP)
1795
1796 shdist : distdir
1797         $(PREOP)
1798         $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
1799         $(RM_RF) $(DISTVNAME)
1800         $(POSTOP)
1801 ];
1802 }
1803
1804 =item dist_dir (override)
1805
1806 Use VMS-style quoting on command line.
1807
1808 =cut
1809
1810 sub dist_dir {
1811     my($self) = @_;
1812 q{
1813 distdir :
1814         $(RM_RF) $(DISTVNAME)
1815         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
1816         -e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
1817 };
1818 }
1819
1820 =item dist_test (override)
1821
1822 Use VMS commands to change default directory, and use VMS-style
1823 quoting on command line.
1824
1825 =cut
1826
1827 sub dist_test {
1828     my($self) = @_;
1829 q{
1830 disttest : distdir
1831         startdir = F$Environment("Default")
1832         Set Default [.$(DISTVNAME)]
1833         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
1834         $(MMS)$(MMSQUALIFIERS)
1835         $(MMS)$(MMSQUALIFIERS) test
1836         Set Default 'startdir'
1837 };
1838 }
1839
1840 # --- Test and Installation Sections ---
1841
1842 =item install (override)
1843
1844 Work around DCL's 255 character limit several times,and use
1845 VMS-style command line quoting in a few cases.
1846
1847 =cut
1848
1849 sub install {
1850     my($self, %attribs) = @_;
1851     my(@m,@docfiles);
1852
1853     if ($self->{EXE_FILES}) {
1854         my($line,$file) = ('','');
1855         foreach $file (@{$self->{EXE_FILES}}) {
1856             $line .= "$file ";
1857             if (length($line) > 128) {
1858                 push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]);
1859                 $line = '';
1860             }
1861         }
1862         push(@docfiles,qq[\t\$(PERL) -e "print '$line'" >>.MM_tmp\n]) if $line;
1863     }
1864
1865     push @m, q[
1866 install :: all pure_install doc_install
1867         $(NOECHO) $(NOOP)
1868
1869 install_perl :: all pure_perl_install doc_perl_install
1870         $(NOECHO) $(NOOP)
1871
1872 install_site :: all pure_site_install doc_site_install
1873         $(NOECHO) $(NOOP)
1874
1875 install_ :: install_site
1876         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1877
1878 pure_install :: pure_$(INSTALLDIRS)_install
1879         $(NOECHO) $(NOOP)
1880
1881 doc_install :: doc_$(INSTALLDIRS)_install
1882         $(NOECHO) $(SAY) "Appending installation info to $(INSTALLARCHLIB)perllocal.pod"
1883
1884 pure__install : pure_site_install
1885         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1886
1887 doc__install : doc_site_install
1888         $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1889
1890 # This hack brought to you by DCL's 255-character command line limit
1891 pure_perl_install ::
1892         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1893         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1894         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
1895         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.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('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
1903
1904 # Likewise
1905 pure_site_install ::
1906         $(NOECHO) $(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
1907         $(NOECHO) $(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
1908         $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
1909         $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
1910         $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
1911         $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
1912         $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
1913         $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
1914         $(MOD_INSTALL) <.MM_tmp
1915         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
1916         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1917
1918 # Ditto
1919 doc_perl_install ::
1920         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
1921         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1922 ],@docfiles,
1923 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1924         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1925         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1926         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1927         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1928         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1929
1930 # And again
1931 doc_site_install ::
1932         $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
1933         $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
1934 ],@docfiles,
1935 q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
1936         $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
1937         $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
1938         $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
1939         $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
1940         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp;
1941
1942 ];
1943
1944     push @m, q[
1945 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1946         $(NOECHO) $(NOOP)
1947
1948 uninstall_from_perldirs ::
1949         $(NOECHO) $(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
1950         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1951         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1952         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1953
1954 uninstall_from_sitedirs ::
1955         $(NOECHO) $(UNINSTALL) ],$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist'),"\n",q[
1956         $(NOECHO) $(SAY) "Uninstall is now deprecated and makes no actual changes."
1957         $(NOECHO) $(SAY) "Please check the list above carefully for errors, and manually remove"
1958         $(NOECHO) $(SAY) "the appropriate files.  Sorry for the inconvenience."
1959 ];
1960
1961     join('',@m);
1962 }
1963
1964 =item perldepend (override)
1965
1966 Use VMS-style syntax for files; it's cheaper to just do it directly here
1967 than to have the MM_Unix method call C<catfile> repeatedly.  Also use
1968 config.vms as source of original config data if the Perl distribution
1969 is available; config.sh is an ancillary file under VMS.  Finally, if
1970 we have to rebuild Config.pm, use MM[SK] to do it.
1971
1972 =cut
1973
1974 sub perldepend {
1975     my($self) = @_;
1976     my(@m);
1977
1978     push @m, '
1979 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
1980 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
1981 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
1982 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
1983 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
1984 $(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1985 $(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
1986
1987 ' if $self->{OBJECT};
1988
1989     if ($self->{PERL_SRC}) {
1990         my(@macros);
1991         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
1992         push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
1993         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1994         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1995         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1996         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1997         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1998         push(@m,q[
1999 # Check for unpropagated config.sh changes. Should never happen.
2000 # We do NOT just update config.h because that is not sufficient.
2001 # An out of date config.h is not fatal but complains loudly!
2002 #$(PERL_INC)config.h : $(PERL_SRC)config.sh
2003 $(PERL_INC)config.h : $(PERL_VMS)config.vms
2004         $(NOECHO) Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
2005
2006 #$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
2007 $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
2008         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
2009         olddef = F$Environment("Default")
2010         Set Default $(PERL_SRC)
2011         $(MMS)],$mmsquals,);
2012         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
2013             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
2014             $target =~ s/\Q$prefix/[/;
2015             push(@m," $target");
2016         }
2017         else { push(@m,' $(MMS$TARGET)'); }
2018         push(@m,q[
2019         Set Default 'olddef'
2020 ]);
2021     }
2022
2023     push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
2024       if %{$self->{XS}};
2025
2026     join('',@m);
2027 }
2028
2029 =item makefile (override)
2030
2031 Use VMS commands and quoting.
2032
2033 =cut
2034
2035 sub makefile {
2036     my($self) = @_;
2037     my(@m,@cmd);
2038     # We do not know what target was originally specified so we
2039     # must force a manual rerun to be sure. But as it should only
2040     # happen very rarely it is not a significant problem.
2041     push @m, q[
2042 $(OBJECT) : $(FIRST_MAKEFILE)
2043 ] if $self->{OBJECT};
2044
2045     push @m,q[
2046 # We take a very conservative approach here, but it\'s worth it.
2047 # We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
2048 $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
2049         $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
2050         $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
2051         - $(MV) $(MAKEFILE) $(MAKEFILE)_old
2052         - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
2053         $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
2054         $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
2055         $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
2056 ];
2057
2058     join('',@m);
2059 }
2060
2061 =item test (override)
2062
2063 Use VMS commands for handling subdirectories.
2064
2065 =cut
2066
2067 sub test {
2068     my($self, %attribs) = @_;
2069     my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
2070     my(@m);
2071     push @m,"
2072 TEST_VERBOSE = 0
2073 TEST_TYPE = test_\$(LINKTYPE)
2074 TEST_FILE = test.pl
2075 TESTDB_SW = -d
2076
2077 test :: \$(TEST_TYPE)
2078         \$(NOECHO) \$(NOOP)
2079
2080 testdb :: testdb_\$(LINKTYPE)
2081         \$(NOECHO) \$(NOOP)
2082
2083 ";
2084     foreach(@{$self->{DIR}}){
2085       my($vmsdir) = $self->fixpath($_,1);
2086       push(@m, '        If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
2087            '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
2088     }
2089     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
2090         unless $tests or -f "test.pl" or @{$self->{DIR}};
2091     push(@m, "\n");
2092
2093     push(@m, "test_dynamic :: pure_all\n");
2094     push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
2095     push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
2096     push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl");
2097     push(@m, "\n");
2098
2099     push(@m, "testdb_dynamic :: pure_all\n");
2100     push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)'));
2101     push(@m, "\n");
2102
2103     # Occasionally we may face this degenerate target:
2104     push @m, "test_ : test_dynamic\n\n";
2105
2106     if ($self->needs_linking()) {
2107         push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
2108         push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
2109         push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
2110         push(@m, "\n");
2111         push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
2112         push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
2113         push(@m, "\n");
2114     }
2115     else {
2116         push @m, "test_static :: test_dynamic\n\t\$(NOECHO) \$(NOOP)\n\n";
2117         push @m, "testdb_static :: testdb_dynamic\n\t\$(NOECHO) \$(NOOP)\n";
2118     }
2119
2120     join('',@m);
2121 }
2122
2123 =item test_via_harness (override)
2124
2125 Use VMS-style quoting on command line.
2126
2127 =cut
2128
2129 sub test_via_harness {
2130     my($self,$perl,$tests) = @_;
2131     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
2132     '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
2133 }
2134
2135 =item test_via_script (override)
2136
2137 Use VMS-style quoting on command line.
2138
2139 =cut
2140
2141 sub test_via_script {
2142     my($self,$perl,$script) = @_;
2143     "   $perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
2144 ';
2145 }
2146
2147 =item makeaperl (override)
2148
2149 Undertake to build a new set of Perl images using VMS commands.  Since
2150 VMS does dynamic loading, it's not necessary to statically link each
2151 extension into the Perl image, so this isn't the normal build path.
2152 Consequently, it hasn't really been tested, and may well be incomplete.
2153
2154 =cut
2155
2156 sub makeaperl {
2157     my($self, %attribs) = @_;
2158     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
2159       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
2160     my(@m);
2161     push @m, "
2162 # --- MakeMaker makeaperl section ---
2163 MAP_TARGET    = $target
2164 ";
2165     return join '', @m if $self->{PARENT};
2166
2167     my($dir) = join ":", @{$self->{DIR}};
2168
2169     unless ($self->{MAKEAPERL}) {
2170         push @m, q{
2171 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
2172         $(NOECHO) $(SAY) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
2173         $(NOECHO) $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
2174                 Makefile.PL DIR=}, $dir, q{ \
2175                 MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
2176                 MAKEAPERL=1 NORECURS=1
2177
2178 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
2179         $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
2180 };
2181         push @m, map( " \\\n\t\t$_", @ARGV );
2182         push @m, "\n";
2183
2184         return join '', @m;
2185     }
2186
2187
2188     my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
2189
2190     # The front matter of the linkcommand...
2191     $linkcmd = join ' ', $Config{'ld'},
2192             grep($_, @Config{qw(large split ldflags ccdlflags)});
2193     $linkcmd =~ s/\s+/ /g;
2194
2195     # Which *.olb files could we make use of...
2196     local(%olbs);
2197     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
2198     require File::Find;
2199     File::Find::find(sub {
2200         return unless m/\Q$self->{LIB_EXT}\E$/;
2201         return if m/^libperl/;
2202
2203         if( exists $self->{INCLUDE_EXT} ){
2204                 my $found = 0;
2205                 my $incl;
2206                 my $xx;
2207
2208                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2209                 $xx =~ s,/?$_,,;
2210                 $xx =~ s,/,::,g;
2211
2212                 # Throw away anything not explicitly marked for inclusion.
2213                 # DynaLoader is implied.
2214                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
2215                         if( $xx eq $incl ){
2216                                 $found++;
2217                                 last;
2218                         }
2219                 }
2220                 return unless $found;
2221         }
2222         elsif( exists $self->{EXCLUDE_EXT} ){
2223                 my $excl;
2224                 my $xx;
2225
2226                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
2227                 $xx =~ s,/?$_,,;
2228                 $xx =~ s,/,::,g;
2229
2230                 # Throw away anything explicitly marked for exclusion
2231                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
2232                         return if( $xx eq $excl );
2233                 }
2234         }
2235
2236         $olbs{$ENV{DEFAULT}} = $_;
2237     }, grep( -d $_, @{$searchdirs || []}));
2238
2239     # We trust that what has been handed in as argument will be buildable
2240     $static = [] unless $static;
2241     @olbs{@{$static}} = (1) x @{$static};
2242
2243     $extra = [] unless $extra && ref $extra eq 'ARRAY';
2244     # Sort the object libraries in inverse order of
2245     # filespec length to try to insure that dependent extensions
2246     # will appear before their parents, so the linker will
2247     # search the parent library to resolve references.
2248     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
2249     # references from [.intuit.dwim]dwim.obj can be found
2250     # in [.intuit]intuit.olb).
2251     for (sort keys %olbs) {
2252         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
2253         my($dir) = $self->fixpath($_,1);
2254         my($extralibs) = $dir . "extralibs.ld";
2255         my($extopt) = $dir . $olbs{$_};
2256         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
2257         if (-f $extralibs ) {
2258             open LIST,$extralibs or warn $!,next;
2259             push @$extra, <LIST>;
2260             close LIST;
2261         }
2262         if (-f $extopt) {
2263             open OPT,$extopt or die $!;
2264             while (<OPT>) {
2265                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
2266                 # ExtUtils::Miniperl expects Unix paths
2267                 (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
2268                 push @staticpkgs,$pkg;
2269             }
2270             push @staticopts, $extopt;
2271         }
2272     }
2273
2274     $target = "Perl$Config{'exe_ext'}" unless $target;
2275     ($shrtarget,$targdir) = fileparse($target);
2276     $shrtarget =~ s/^([^.]*)/$1Shr/;
2277     $shrtarget = $targdir . $shrtarget;
2278     $target = "Perlshr.$Config{'dlext'}" unless $target;
2279     $tmp = "[]" unless $tmp;
2280     $tmp = $self->fixpath($tmp,1);
2281     if (@$extra) {
2282         $extralist = join(' ',@$extra);
2283         $extralist =~ s/[,\s\n]+/, /g;
2284     }
2285     else { $extralist = ''; }
2286     if ($libperl) {
2287         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
2288             print STDOUT "Warning: $libperl not found\n";
2289             undef $libperl;
2290         }
2291     }
2292     unless ($libperl) {
2293         if (defined $self->{PERL_SRC}) {
2294             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
2295         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
2296         } else {
2297             print STDOUT "Warning: $libperl not found
2298     If you're going to build a static perl binary, make sure perl is installed
2299     otherwise ignore this warning\n";
2300         }
2301     }
2302     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
2303
2304     push @m, '
2305 # Fill in the target you want to produce if it\'s not perl
2306 MAP_TARGET    = ',$self->fixpath($target),'
2307 MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
2308 MAP_LINKCMD   = $linkcmd
2309 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
2310 # We use the linker options files created with each extension, rather than
2311 #specifying the object files directly on the command line.
2312 MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
2313 MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
2314 MAP_EXTRA     = $extralist
2315 MAP_LIBPERL = ",$self->fixpath($libperl),'
2316 ';
2317
2318
2319     push @m,'
2320 $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
2321         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
2322 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
2323         $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
2324         $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
2325         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
2326         $(NOECHO) $(SAY) "To remove the intermediate files, say
2327         $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
2328 ';
2329     push @m,'
2330 ',"${tmp}perlmain.c",' : $(MAKEFILE)
2331         $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
2332 ';
2333
2334     push @m, q[
2335 # More from the 255-char line length limit
2336 doc_inst_perl :
2337         $(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
2338         $(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
2339         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
2340         $(NOECHO) $(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
2341         $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
2342         $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
2343 ];
2344
2345     push @m, "
2346 inst_perl : pure_inst_perl doc_inst_perl
2347         \$(NOECHO) \$(NOOP)
2348
2349 pure_inst_perl : \$(MAP_TARGET)
2350         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
2351         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
2352
2353 clean :: map_clean
2354         \$(NOECHO) \$(NOOP)
2355
2356 map_clean :
2357         \$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
2358         \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
2359 ";
2360
2361     join '', @m;
2362 }
2363
2364 # --- Output postprocessing section ---
2365
2366 =item nicetext (override)
2367
2368 Insure that colons marking targets are preceded by space, in order
2369 to distinguish the target delimiter from a colon appearing as
2370 part of a filespec.
2371
2372 =cut
2373
2374 sub nicetext {
2375
2376     my($self,$text) = @_;
2377     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
2378     $text;
2379 }
2380
2381 1;
2382
2383 =back
2384
2385 =cut
2386
2387 __END__
2388