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