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