Major changes to the DOS/djgpp port (including threading):
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / MM_Unix.pm
index b051617..6703245 100644 (file)
@@ -5,11 +5,11 @@ use Config;
 use File::Basename qw(basename dirname fileparse);
 use DirHandle;
 use strict;
-use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32
+use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos
            $Verbose %pm %static $Xsubpp_Version);
 
-$VERSION = substr q$Revision: 1.114 $, 10;
-# $Id: MM_Unix.pm,v 1.113 1997/02/11 21:54:09 k Exp $
+$VERSION = substr q$Revision: 1.118 $, 10;
+# $Id: MM_Unix.pm,v 1.118 1997/08/01 09:42:52 k Exp $
 
 Exporter::import('ExtUtils::MakeMaker',
        qw( $Verbose &neatvalue));
@@ -17,6 +17,7 @@ Exporter::import('ExtUtils::MakeMaker',
 $Is_OS2 = $^O eq 'os2';
 $Is_Mac = $^O eq 'MacOS';
 $Is_Win32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
 
 if ($Is_VMS = $^O eq 'VMS') {
     require VMS::Filespec;
@@ -181,6 +182,7 @@ sub ExtUtils::MM_Unix::export_list ;
 sub ExtUtils::MM_Unix::extliblist ;
 sub ExtUtils::MM_Unix::file_name_is_absolute ;
 sub ExtUtils::MM_Unix::find_perl ;
+sub ExtUtils::MM_Unix::fixin ;
 sub ExtUtils::MM_Unix::force ;
 sub ExtUtils::MM_Unix::guess_name ;
 sub ExtUtils::MM_Unix::has_link_code ;
@@ -265,7 +267,7 @@ sub c_o {
     push @m, '
 .C$(OBJ_EXT):
        $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
-' if $^O ne 'os2';                     # Case-specific
+' if $^O ne 'os2' and $^O ne 'MSWin32' and $^O ne 'dos'; #Case-specific
     push @m, '
 .cpp$(OBJ_EXT):
        $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
@@ -1048,7 +1050,12 @@ Takes as argument a path and returns true, if it is an absolute path.
 
 sub file_name_is_absolute {
     my($self,$file) = @_;
-    $file =~ m:^/: ;
+    if ($Is_Dos){
+        $file =~ m{^([a-z]:)?[\\/]}i ;
+    }
+    else {
+        $file =~ m:^/: ;
+    }
 }
 
 =item find_perl
@@ -1103,6 +1110,91 @@ specified by @ExtUtils::MakeMaker::MM_Sections.
 
 =over 2
 
+=item fixin
+
+Inserts the sharpbang or equivalent magic number to a script
+
+=cut
+
+sub fixin { # stolen from the pink Camel book, more or less
+    my($self,@files) = @_;
+    my($does_shbang) = $Config::Config{'sharpbang'} =~ /^\s*\#\!/;
+    my($file,$interpreter);
+    for $file (@files) {
+       local(*FIXIN);
+       local(*FIXOUT);
+       open(FIXIN, $file) or Carp::croak "Can't process '$file': $!";
+       local $/ = "\n";
+       chomp(my $line = <FIXIN>);
+       next unless $line =~ s/^\s*\#!\s*//;     # Not a shbang file.
+       # Now figure out the interpreter name.
+       my($cmd,$arg) = split ' ', $line, 2;
+       $cmd =~ s!^.*/!!;
+
+       # Now look (in reverse) for interpreter in absolute PATH (unless perl).
+       if ($cmd eq "perl") {
+            if ($Config{startperl} =~ m,^\#!.*/perl,) {
+                $interpreter = $Config{startperl};
+                $interpreter =~ s,^\#!,,;
+            } else {
+                $interpreter = $Config{perlpath};
+            }
+       } else {
+           my(@absdirs) = reverse grep {$self->file_name_is_absolute} $self->path;
+           $interpreter = '';
+           my($dir);
+           foreach $dir (@absdirs) {
+               if ($self->maybe_command($cmd)) {
+                   warn "Ignoring $interpreter in $file\n" if $Verbose && $interpreter;
+                   $interpreter = $self->catfile($dir,$cmd);
+               }
+           }
+       }
+       # Figure out how to invoke interpreter on this machine.
+
+       my($shb) = "";
+       if ($interpreter) {
+           print STDOUT "Changing sharpbang in $file to $interpreter" if $Verbose;
+           if ($does_shbang) {
+               $shb .= "$Config{'sharpbang'}$interpreter";
+               $shb .= ' ' . $arg if defined $arg;
+               $shb .= "\n";
+           }
+           $shb .= qq{
+eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
+    if 0; # not running under some shell
+};
+       } else {
+           warn "Can't find $cmd in PATH, $file unchanged"
+               if $Verbose;
+           next;
+       }
+
+       unless ( rename($file, "$file.bak") ) { 
+           warn "Can't modify $file";
+           next;
+       }
+       unless ( open(FIXOUT,">$file") ) {
+           warn "Can't create new $file: $!\n";
+           next;
+       }
+       my($dev,$ino,$mode) = stat FIXIN;
+       $mode = 0755 unless $dev;
+       chmod $mode, $file;
+       
+       # Print out the new #! line (or equivalent).
+       local $\;
+       undef $/;
+       print FIXOUT $shb, <FIXIN>;
+       close FIXIN;
+       close FIXOUT;
+       unlink "$file.bak";
+    } continue {
+       chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+       system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';;
+    }
+}
+
 =item force (o)
 
 Just writes FORCE:
@@ -1113,6 +1205,7 @@ sub force {
     my($self) = shift;
     '# Phony target to force checking subdirectories.
 FORCE:
+       '.$self->{NOECHO}.'$(NOOP)
 ';
 }
 
@@ -1279,7 +1372,6 @@ sub init_dirscan {        # --- File and Directory Lists (.xs .pm .pod etc)
 #              my $fh = new FileHandle;
                local *FH;
                my($ispod)=0;
-               # one day test, if $/ can be set to '' safely (is the bug fixed that was in 5.001m?)
 #              if ($fh->open("<$name")) {
                if (open(FH,"<$name")) {
 #                  while (<$fh>) {
@@ -1296,7 +1388,9 @@ sub init_dirscan {        # --- File and Directory Lists (.xs .pm .pod etc)
                    $ispod = 1;
                }
                if( $ispod ) {
-                   $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)');
+                   $manifypods{$name} =
+                       $self->catfile('$(INST_MAN1DIR)',
+                                      basename($name).'.$(MAN1EXT)');
                }
            }
        }
@@ -1900,22 +1994,27 @@ sub installbin {
        $fromto{$from}=$to;
     }
     @to   = values %fromto;
-    push(@m, "
+    push(@m, qq{
 EXE_FILES = @{$self->{EXE_FILES}}
 
+FIXIN = \$(PERL) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) -MExtUtils::MakeMaker \\
+    -e "MY->fixin(shift)"
+
 all :: @to
+       $self->{NOECHO}\$(NOOP)
 
 realclean ::
        $self->{RM_F} @to
-");
+});
 
     while (($from,$to) = each %fromto) {
        last unless defined $from;
        my $todir = dirname($to);
        push @m, "
-$to: $from $self->{MAKEFILE} $todir/.exists
+$to: $from $self->{MAKEFILE} " . $self->catdir($todir,'.exists') . "
        $self->{NOECHO}$self->{RM_F} $to
        $self->{CP} $from $to
+       \$(FIXIN) $to
 ";
     }
     join "", @m;
@@ -2205,6 +2304,9 @@ $tmp/perlmain.c: $makefilename}, q{
                -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
 
 };
+    push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
+} if (defined (&Dos::UseLFN) && Dos::UseLFN()==0);
+
 
     push @m, q{
 doc_inst_perl:
@@ -2429,18 +2531,21 @@ sub parse_version {
        $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
        next if $inpod;
        chop;
-       next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
+       # next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
+       next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
        my $eval = qq{
            package ExtUtils::MakeMaker::_version;
            no strict;
 
-           \$$1=undef; do {
+           local $1$2;
+           \$$2=undef; do {
                $_
-           }; \$$1
+           }; \$$2
        };
        local($^W) = 0;
-       $result = eval($eval) || 0;
+       $result = eval($eval);
        die "Could not eval '$eval' in $parsefile: $@" if $@;
+       $result = "undef" unless defined $result;
        last;
     }
     close FH;
@@ -2479,7 +2584,7 @@ Takes no argument, returns the environment variable PATH as an array.
 
 sub path {
     my($self) = @_;
-    my $path_sep = $Is_OS2 ? ";" : ":";
+    my $path_sep = ($Is_OS2 || $Is_Dos) ? ";" : ":";
     my $path = $ENV{PATH};
     $path =~ s:\\:/:g if $Is_OS2;
     my @path = split $path_sep, $path;
@@ -2631,6 +2736,7 @@ sub processPL {
     foreach $plfile (sort keys %{$self->{PL_FILES}}) {
        push @m, "
 all :: $self->{PL_FILES}->{$plfile}
+       $self->{NOECHO}\$(NOOP)
 
 $self->{PL_FILES}->{$plfile} :: $plfile
        \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
@@ -2843,11 +2949,13 @@ sub test {
     if (!$tests && -d 't') {
        $tests = $Is_Win32 ? join(' ', <t\\*.t>) : 't/*.t';
     }
+    # note: 'test.pl' name is also hardcoded in init_dirscan()
     my(@m);
     push(@m,"
 TEST_VERBOSE=0
 TEST_TYPE=test_\$(LINKTYPE)
 TEST_FILE = test.pl
+TEST_FILES = $tests
 TESTDB_SW = -d
 
 testdb :: testdb_\$(LINKTYPE)
@@ -2861,8 +2969,8 @@ test :: \$(TEST_TYPE)
     push(@m, "\n");
 
     push(@m, "test_dynamic :: pure_all\n");
-    push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
-    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, $self->test_via_harness('$(FULLPERL)', '$(TEST_FILES)')) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', '$(TEST_FILE)')) if -f "test.pl";
     push(@m, "\n");
 
     push(@m, "testdb_dynamic :: pure_all\n");
@@ -2874,8 +2982,8 @@ test :: \$(TEST_TYPE)
 
     if ($self->needs_linking()) {
        push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
-       push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests;
-       push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl";
+       push(@m, $self->test_via_harness('./$(MAP_TARGET)', '$(TEST_FILES)')) if $tests;
+       push(@m, $self->test_via_script('./$(MAP_TARGET)', '$(TEST_FILE)')) if -f "test.pl";
        push(@m, "\n");
        push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
        push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));