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