[PATCH 5.004_60] Fix to MM_VMS.PM
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / MM_VMS.pm
index b56b1b8..954f612 100644 (file)
@@ -6,8 +6,6 @@
 #   Author:  Charles Bailey  bailey@genetics.upenn.edu
 
 package ExtUtils::MM_VMS;
-$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.39 (31-Jan-1997)';
-unshift @MM::ISA, 'ExtUtils::MM_VMS';
 
 use Carp qw( &carp );
 use Config;
@@ -15,6 +13,11 @@ require Exporter;
 use VMS::Filespec;
 use File::Basename;
 
+use vars qw($Revision);
+$Revision = '5.3901 (6-Mar-1997)';
+
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
 Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
 
 =head1 NAME
@@ -33,6 +36,8 @@ the semantics.
 
 =head2 Methods always loaded
 
+=over
+
 =item eliminate_macros
 
 Expands MM[KS]/Make macros in a text string, using the contents of
@@ -91,7 +96,7 @@ sub fixpath {
     }
     my($fixedpath,$prefix,$name);
 
-    if ($path =~ m#^\$\(.+\)$# || $path =~ m#[/:>\]]#) { 
+    if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) { 
         if ($force_path or $path =~ /(?:DIR\)|\])$/) {
             $fixedpath = vmspath($self->eliminate_macros($path));
         }
@@ -100,7 +105,9 @@ sub fixpath {
         }
     }
     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
-        my($vmspre) = vmspath($self->eliminate_macros("\$($prefix)")) || ''; # is it a dir or just a name?
+        my($vmspre) = $self->eliminate_macros("\$($prefix)");
+        # is it a dir or just a name?
+        $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : '';
         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
         $fixedpath = vmspath($fixedpath) if $force_path;
     }
@@ -309,6 +316,7 @@ sub ext {
   ExtUtils::Liblist::ext(@_);
 }
 
+=back
 
 =head2 SelfLoaded methods
 
@@ -318,6 +326,8 @@ For overridden methods, documentation is limited to an explanation
 of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
 documentation for more details.
 
+=over
+
 =item guess_name (override)
 
 Try to determine name of extension being built.  We begin with the name
@@ -459,22 +469,32 @@ sub path {
 
 Follows VMS naming conventions for executable files.
 If the name passed in doesn't exactly match an executable file,
-appends F<.Exe> to check for executable image, and F<.Com> to check
-for DCL procedure.  If this fails, checks F<Sys$System:> for an
-executable file having the name specified.  Finally, appends F<.Exe>
-and checks again.
+appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
+to check for DCL procedure.  If this fails, checks directories in DCL$PATH
+and finally F<Sys$System:> for an executable file having the name specified,
+with or without the F<.Exe>-equivalent suffix.
 
 =cut
 
 sub maybe_command {
     my($self,$file) = @_;
     return $file if -x $file && ! -d _;
-    return "$file.exe" if -x "$file.exe";
-    return "$file.com" if -x "$file.com";
+    my(@dirs) = ('');
+    my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
+    my($dir,$ext);
     if ($file !~ m![/:>\]]!) {
-       my($shrfile) = 'Sys$System:' . $file;
-       return $file if -x $shrfile && ! -d _;
-       return "$file.exe" if -x "$shrfile.exe";
+       for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
+           $dir = $ENV{"DCL\$PATH;$i"};
+           $dir .= ':' unless $dir =~ m%[\]:]$%;
+           push(@dirs,$dir);
+       }
+       push(@dirs,'Sys$System:');
+       foreach $dir (@dirs) {
+           my $sysfile = "$dir$file";
+           foreach $ext (@exts) {
+               return $file if -x "$sysfile$ext" && ! -d _;
+           }
+       }
     }
     return 0;
 }
@@ -517,8 +537,8 @@ sub maybe_command_in_dirs { # $ver is optional argument if looking for perl
 
 =item perl_script (override)
 
-If name passed in doesn't specify a readable file, appends F<.pl> and
-tries again, since it's customary to have file types on all files
+If name passed in doesn't specify a readable file, appends F<.com> or
+F<.pl> and tries again, since it's customary to have file types on all files
 under VMS.
 
 =cut
@@ -526,7 +546,8 @@ under VMS.
 sub perl_script {
     my($self,$file) = @_;
     return $file if -r $file && ! -d _;
-    return "$file.pl" if -r "$file.pl" && ! -d _;
+    return "$file.com" if -r "$file.com";
+    return "$file.pl" if -r "$file.pl";
     return '';
 }
 
@@ -748,7 +769,7 @@ INST_STATIC =
 INST_DYNAMIC =
 INST_BOOT =
 EXPORT_LIST = $(BASEEXT).opt
-PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : 'Sys$Share:PerlShr.Exe'),'
+PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : "Sys\$Share:PerlShr.$Config{'dlext'}"),'
 ';
     }
 
@@ -1002,7 +1023,10 @@ sub xsubpp_version
     my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
     print "Running: $command\n" if $Verbose;
     $version = `$command` ;
-    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    if ($?) {
+       use vmsish 'status';
+       warn "Running '$command' exits with status $?";
+    }
     chop $version ;
 
     return $1 if $version =~ /^xsubpp version (.*)/ ;
@@ -1029,7 +1053,10 @@ EOM
     $command = "$self->{PERL} $xsubpp $file";
     print "Running: $command\n" if $Verbose;
     my $text = `$command` ;
-    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    if ($?) {
+       use vmsish 'status';
+       warn "Running '$command' exits with status $?";
+    }
     unlink $file ;
 
     # gets 1.2 -> 1.92 and 2.000a1
@@ -1094,12 +1121,17 @@ default MM_Unix method.
 sub dist {
     my($self, %attribs) = @_;
     $attribs{VERSION}      ||= $self->{VERSION_SYM};
+    $attribs{NAME}         ||= $self->{DISTNAME};
     $attribs{ZIPFLAGS}     ||= '-Vu';
     $attribs{COMPRESS}     ||= 'gzip';
     $attribs{SUFFIX}       ||= '-gz';
     $attribs{SHAR}         ||= 'vms_share';
     $attribs{DIST_DEFAULT} ||= 'zipdist';
 
+    # Sanitize these for use in $(DISTVNAME) filespec
+    $attribs{VERSION} =~ s/[^\w\$]/_/g;
+    $attribs{NAME} =~ s/[^\w\$]/_/g;
+
     return ExtUtils::MM_Unix::dist($self,%attribs);
 }
 
@@ -1289,12 +1321,12 @@ $(BASEEXT).opt : Makefile.PL
        foreach $lib (split ' ', $self->{LDLOADLIBS}) {
            $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
            if (length($line) + length($lib) > 160) {
-               push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n";
+               push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
                $line = $lib . '\n';
            }
            else { $line .= $lib . '\n'; }
        }
-       push @m, "\t\$(PERL) -e \"print qq[$line]\" >>\$(MMS\$TARGET)\n" if $line;
+       push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
     }
 
     join('',@m);
@@ -1325,7 +1357,7 @@ INST_DYNAMIC_DEP = $inst_dynamic_dep
     push @m, '
 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
        $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
-       $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.Exe
+       $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config{'dlext'},'
        Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
 ';
 
@@ -1390,8 +1422,22 @@ $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
 
     push(@m,'
        If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
+');
+    # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
+    # 'cause it's a library and you can't stick them in other libraries.
+    # In that case, we use $OBJECT instead and hope for the best
+    if ($self->{MYEXTLIB}) {
+      push(@m,'
+       Library/Object/Replace $(MMS$TARGET) $(OBJECT)
+'); 
+    } else {
+      push(@m,'
        Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
-       $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
+'); 
+    }
+    
+    push(@m, '
+       $(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"
 ');
     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
     join('',@m);
@@ -1567,7 +1613,7 @@ sub subdir_x {
 subdirs ::
        olddef = F$Environment("Default")
        Set Default ',$subdir,'
-       - $(MMS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
+       - $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
        Set Default \'olddef\'
 ';
     join('',@m);
@@ -1592,7 +1638,7 @@ clean ::
     foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
        my($vmsdir) = $self->fixpath($dir,1);
        push( @m, '     If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
-             '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n");
+             '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
     }
     push @m, ' $(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
 ';
@@ -1644,7 +1690,7 @@ realclean :: clean
     foreach(@{$self->{DIR}}){
        my($vmsdir) = $self->fixpath($_,1);
        push(@m, '      If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
-             '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n");
+             '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
     }
     push @m,'  $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
 ';
@@ -1728,28 +1774,28 @@ sub dist_core {
     my($self) = @_;
 q[
 dist : $(DIST_DEFAULT)
-       $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)'"
+       $(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"
 
 zipdist : $(DISTVNAME).zip
        $(NOECHO) $(NOOP)
 
 $(DISTVNAME).zip : distdir
        $(PREOP)
-       $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) $(SRC)
+       $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
        $(RM_RF) $(DISTVNAME)
        $(POSTOP)
 
 $(DISTVNAME).tar$(SUFFIX) : distdir
        $(PREOP)
        $(TO_UNIX)
-       $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar $(SRC)
+       $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)]
        $(RM_RF) $(DISTVNAME)
        $(COMPRESS) $(DISTVNAME).tar
        $(POSTOP)
 
 shdist : distdir
        $(PREOP)
-       $(SHARE) $(SRC) $(DISTVNAME).share
+       $(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
        $(RM_RF) $(DISTVNAME)
        $(POSTOP)
 ];
@@ -1785,8 +1831,8 @@ disttest : distdir
        startdir = F$Environment("Default")
        Set Default [.$(DISTVNAME)]
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
-       $(MMS)
-       $(MMS) test
+       $(MMS)$(MMSQUALIFIERS)
+       $(MMS)$(MMSQUALIFIERS) test
        Set Default 'startdir'
 };
 }
@@ -1872,11 +1918,10 @@ pure_site_install ::
 # Ditto
 doc_perl_install ::
        $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
-       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
-       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
 ],@docfiles,
 q%     $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
-       $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+       $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
        $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
        $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
        $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
@@ -1885,11 +1930,10 @@ q%      $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
 # And again
 doc_site_install ::
        $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
-       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
-       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+       $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp
 ],@docfiles,
 q%     $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp
-       $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
+       $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp
        $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp
        $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp
        $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
@@ -1964,7 +2008,14 @@ $(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
        $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
        olddef = F$Environment("Default")
        Set Default $(PERL_SRC)
-       $(MMS)],$mmsquals,q[ $(MMS$TARGET)
+       $(MMS)],$mmsquals,);
+       if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
+           my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm'));
+           $target =~ s/\Q$prefix/[/;
+           push(@m," $target");
+       }
+       else { push(@m,' $(MMS$TARGET)'); }
+       push(@m,q[
        Set Default 'olddef'
 ]);
     }
@@ -1998,7 +2049,7 @@ $(MAKEFILE) : Makefile.PL $(CONFIGDEP)
        $(NOECHO) $(SAY) "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
        $(NOECHO) $(SAY) "Cleaning current config before rebuilding $(MAKEFILE) ..."
        - $(MV) $(MAKEFILE) $(MAKEFILE)_old
-       - $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+       - $(MMS)$(MMSQUALIFIERS) $(USEMAKEFILE)$(MAKEFILE)_old clean
        $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
        $(NOECHO) $(SAY) "$(MAKEFILE) has been rebuilt."
        $(NOECHO) $(SAY) "Please run $(MMS) to build the extension."
@@ -2033,7 +2084,7 @@ testdb :: testdb_\$(LINKTYPE)
     foreach(@{$self->{DIR}}){
       my($vmsdir) = $self->fixpath($_,1);
       push(@m, '       If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
-           '; print `$(MMS) $(PASTHRU2) test`'."\n");
+           '; print `$(MMS)$(MMSQUALIFIERS) $(PASTHRU2) test`'."\n");
     }
     push(@m, "\t\$(NOECHO) \$(SAY) \"No tests defined for \$(NAME) extension.\"\n")
         unless $tests or -f "test.pl" or @{$self->{DIR}};
@@ -2125,7 +2176,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
                MAKEAPERL=1 NORECURS=1
 
 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
-       $(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+       $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
 };
        push @m, map( " \\\n\t\t$_", @ARGV );
        push @m, "\n";
@@ -2220,7 +2271,7 @@ $(MAP_TARGET) :: $(MAKE_APERL_FILE)
        }
     }
 
-    $target = "Perl.Exe" unless $target;
+    $target = "Perl$Config{'exe_ext'}" unless $target;
     ($shrtarget,$targdir) = fileparse($target);
     $shrtarget =~ s/^([^.]*)/$1Shr/;
     $shrtarget = $targdir . $shrtarget;
@@ -2271,9 +2322,9 @@ $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt
 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
        $(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
        $(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
-       $(NOECHO) $(SAY) "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+       $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
        $(NOECHO) $(SAY) "To remove the intermediate files, say
-       $(NOECHO) $(SAY) "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+       $(NOECHO) $(SAY) "    $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
 ';
     push @m,'
 ',"${tmp}perlmain.c",' : $(MAKEFILE)
@@ -2329,5 +2380,9 @@ sub nicetext {
 
 1;
 
+=back
+
+=cut
+
 __END__