summaryrefslogtreecommitdiff
path: root/win32
diff options
context:
space:
mode:
Diffstat (limited to 'win32')
-rw-r--r--win32/Makefile30
-rw-r--r--win32/bin/pl2bat.bat54
-rw-r--r--win32/bin/pl2bat.pl154
-rw-r--r--win32/bin/runperl.pl67
-rw-r--r--win32/bin/search.pl (renamed from win32/bin/search.bat)8
-rw-r--r--win32/bin/test.bat143
-rw-r--r--win32/bin/webget.pl (renamed from win32/bin/webget.bat)8
-rw-r--r--win32/config.bc22
-rw-r--r--win32/config.vc20
-rw-r--r--win32/config_H.bc4
-rw-r--r--win32/config_H.vc2
-rw-r--r--win32/config_h.PL3
-rw-r--r--win32/makedef.pl34
-rw-r--r--win32/makefile.mk28
-rw-r--r--win32/perllib.c273
-rw-r--r--win32/win32.c530
-rw-r--r--win32/win32.h20
-rw-r--r--win32/win32io.c25
-rw-r--r--win32/win32io.h21
-rw-r--r--win32/win32iop.h43
-rw-r--r--win32/win32sck.c5
21 files changed, 941 insertions, 553 deletions
diff --git a/win32/Makefile b/win32/Makefile
index 8c8b1ad0bc..9e4437f853 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -122,8 +122,8 @@ GLOBEXE=..\perlglob.exe
CONFIGPM=..\lib\Config.pm
MINIMOD=..\lib\ExtUtils\Miniperl.pm
-PL2BAT=bin\PL2BAT.BAT
-GLOBBAT = perlglob.bat
+PL2BAT=bin\pl2bat.pl
+GLOBBAT = bin\perlglob.bat
MAKE=nmake -nologo
CFGSH_TMPL = config.vc
@@ -277,8 +277,8 @@ $(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
$(GLOBEXE): perlglob.obj
$(LINK32) $(LINK_FLAGS) -out:$@ -subsystem:$(SUBSYS) perlglob.obj setargv.obj
-perlglob.bat : ..\lib\File\DosGlob.pm $(MINIPERL)
- $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(*B).bat
+$(GLOBBAT) : ..\lib\File\DosGlob.pm $(MINIPERL)
+ $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(GLOBBAT)
perlglob.obj : perlglob.c
@@ -294,7 +294,7 @@ config.w32 : $(CFGSH_TMPL)
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
$(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
"INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \
- "cf_email=$(EMAIL)" "libs=$(LIBFILES)" \
+ "cf_email=$(EMAIL)" "libs=$(LIBFILES)" "incpath=$(CCINCDIR)" \
"libpth=$(CCLIBDIR)" "libc=$(LIBC)" \
config.w32 > ..\config.sh
@@ -403,6 +403,11 @@ $(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
cd ..\..\win32
doc: $(PERLEXE)
+ cd ..\pod
+ $(MAKE) -f ..\win32\pod.mak checkpods pod2html pod2latex \
+ pod2man pod2text
+ $(XCOPY) *.bat ..\win32\bin\*.*
+ cd ..\win32
copy ..\README.win32 ..\pod\perlwin32.pod
$(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \
--podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML::=|)" \
@@ -411,10 +416,12 @@ doc: $(PERLEXE)
utils: $(PERLEXE)
cd ..\utils
nmake PERL=$(MINIPERL)
- $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph \
- h2xs perldoc pstruct
+ $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug pl2pm c2ph
+ $(PERLEXE) ..\win32\$(PL2BAT) h2xs perldoc pstruct
$(XCOPY) *.bat ..\win32\bin\*.*
cd ..\win32
+ $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \
+ bin\pl2bat.pl
distclean: clean
-del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
@@ -426,6 +433,9 @@ distclean: clean
$(DYNALOADER).c
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
+ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \
+ config.h.new perl95.c
+ -del /f bin\*.bat
-rmdir /s /q ..\lib\auto
-rmdir /s /q ..\lib\CORE
cd $(EXTDIR)
@@ -438,9 +448,8 @@ install : all doc utils
$(XCOPY) $(PERLEXE) $(INST_BIN)\*.*
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
- $(XCOPY) $(GLOBBAT) $(INST_BIN)\*.*
$(XCOPY) $(PERLDLL) $(INST_BIN)\*.*
- $(XCOPY) bin\*.* $(INST_BIN)\*.*
+ $(XCOPY) bin\*.bat $(INST_BIN)\*.*
$(RCOPY) ..\lib $(INST_LIB)\*.*
$(XCOPY) ..\pod\*.bat $(INST_BIN)\*.*
$(XCOPY) ..\pod\*.pod $(INST_POD)\*.*
@@ -481,7 +490,8 @@ clean :
-@erase $(CORE_OBJ)
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
- -@erase ..\*.obj *.obj ..\*.lib ..\*.exp
+ -@erase ..\*.obj ..\*.lib ..\*.exp *.obj *.lib *.exp
+ -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase *.ilk
-@erase *.pdb
diff --git a/win32/bin/pl2bat.bat b/win32/bin/pl2bat.bat
deleted file mode 100644
index 7f5f39aa95..0000000000
--- a/win32/bin/pl2bat.bat
+++ /dev/null
@@ -1,54 +0,0 @@
-@rem = '--*-Perl-*--
-@echo off
-perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-@rem ';
-#!perl -w
-#line 8
-(my $head = <<'--end--') =~ s/^\t//gm;
- @rem = '--*-Perl-*--
- @echo off
- perl -x -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
- goto endofperl
- @rem ';
---end--
-my $headlines = 2 + ($head =~ tr/\n/\n/);
-my $tail = "__END__\n:endofperl\n";
-
-@ARGV = ('-') unless @ARGV;
-
-process(@ARGV);
-
-sub process {
- LOOP:
- foreach ( @_ ) {
- my $myhead = $head;
- my $linedone = 0;
- my $linenum = $headlines;
- my $line;
- open( FILE, $_ ) or die "Can't open $_: $!";
- @file = <FILE>;
- foreach $line ( @file ) {
- $linenum++;
- if ( $line =~ /^:endofperl/) {
- warn "$_ has already been converted to a batch file!\n";
- next LOOP;
- }
- if ( not $linedone and $line =~ /^#!.*perl/ ) {
- $line .= "#line $linenum\n";
- $linedone++;
- }
- }
- close( FILE );
- s/\.pl$//;
- $_ .= '.bat' unless /\.bat$/ or /^-$/;
- open( FILE, ">$_" ) or die "Can't open $_: $!";
- $myhead =~ s/perl -x/perl/ unless $linedone;
- print FILE $myhead;
- print FILE "#line $headlines\n" unless $linedone;
- print FILE @file, $tail;
- close( FILE );
- }
-}
-__END__
-:endofperl
diff --git a/win32/bin/pl2bat.pl b/win32/bin/pl2bat.pl
new file mode 100644
index 0000000000..73ae87164d
--- /dev/null
+++ b/win32/bin/pl2bat.pl
@@ -0,0 +1,154 @@
+#!perl -w
+require 5;
+use Getopt::Std;
+
+$0 =~ s|.*[/\\]||;
+
+my $usage = <<EOT;
+Usage: $0 [-h] [-a argstring] [-s stripsuffix] [files]
+ -a argstring arguments to invoke perl with in generated file
+ Defaults to "-x -S %0 %*" on WindowsNT,
+ "-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9" otherwise
+ -s stripsuffix strip this suffix from file before appending ".bat"
+ Not case-sensitive
+ Can be a regex if it begins with `/'
+ Defaults to "/\.pl/"
+ -h show this help
+EOT
+
+my %OPT = ();
+warn($usage), exit(0) if !getopts('ha:s:',\%OPT) or $OPT{'h'};
+$OPT{'a'} = ($^O eq 'MSWin32' and &Win32::IsWinNT
+ ? '-x -S %0 %*'
+ : '-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9')
+ unless exists $OPT{'a'};
+$OPT{'s'} = '.pl' unless exists $OPT{'s'};
+$OPT{'s'} = ($OPT{'s'} =~ m|^/([^/]*)| ? $1 : "\Q$OPT{'s'}\E");
+
+(my $head = <<EOT) =~ s/^\t//gm;
+ \@rem = '--*-Perl-*--
+ \@echo off
+ perl $OPT{'a'}
+ goto endofperl
+ \@rem ';
+EOT
+my $headlines = 2 + ($head =~ tr/\n/\n/);
+my $tail = "__END__\n:endofperl\n";
+
+@ARGV = ('-') unless @ARGV;
+
+process(@ARGV);
+
+sub process {
+ LOOP:
+ foreach ( @_ ) {
+ my $myhead = $head;
+ my $linedone = 0;
+ my $linenum = $headlines;
+ my $line;
+ open( FILE, $_ ) or die "$0: Can't open $_: $!";
+ @file = <FILE>;
+ foreach $line ( @file ) {
+ $linenum++;
+ if ( $line =~ /^:endofperl/) {
+ warn "$0: $_ has already been converted to a batch file!\n";
+ next LOOP;
+ }
+ if ( not $linedone and $line =~ /^#!.*perl/ ) {
+ $line .= "#line $linenum\n";
+ $linedone++;
+ }
+ }
+ close( FILE );
+ s/$OPT{'s'}$//oi;
+ $_ .= '.bat' unless /\.bat$/i or /^-$/;
+ open( FILE, ">$_" ) or die "Can't open $_: $!";
+ print FILE $myhead;
+ print FILE "#!perl\n#line " . ($headlines+1) . "\n" unless $linedone;
+ print FILE @file, $tail;
+ close( FILE );
+ }
+}
+__END__
+
+=head1 NAME
+
+pl2bat - wrap perl code into a batch file
+
+=head1 SYNOPSIS
+
+B<pl2bat> [B<-h>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
+
+=head1 DESCRIPTION
+
+This utility converts a perl script into a batch file that can be
+executed on DOS-like operating systems.
+
+Note that by default, the ".pl" suffix will be stripped before adding
+a ".bat" suffix to the supplied file names. This can be controlled
+with the C<-s> option.
+
+The default behavior on WindowsNT is to generate a batch file that
+uses the C<%*> construct to refer to all the command line arguments
+that were given to it, so you'll need to make sure that works on your
+variant of the command shell. It is known to work in the cmd.exe shell
+under WindowsNT. 4DOS/NT users will want to put a C<ParameterChar = *>
+line in their initialization file, or execute C<setdos /p*> in
+the shell startup file. On Windows95 and other platforms a nine
+argument limit is imposed on command-line arguments given to the
+generated batch file, since they may not support C<%*> in batch files.
+This can be overridden using the C<-a> option.
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-a> I<argstring>
+
+Arguments to invoke perl with in generated batch file. Defaults to
+S<"-x -S %0 %*"> on WindowsNT, S<"-x -S %0 %1 %2 %3 %4 %5 %6 %7 %8 %9">
+on other platforms.
+
+=item B<-s> I<stripsuffix>
+
+Strip a suffix string from file name before appending a ".bat"
+suffix. The suffix is not case-sensitive. It can be a regex if it
+begins with `/' (the trailing '/' being optional. Defaults to ".pl".
+
+=item B<-h>
+
+Show command line usage.
+
+=back
+
+=head1 EXAMPLES
+
+ C:\> pl2bat foo.pl bar.PM
+ [..creates foo.bat, bar.PM.bat..]
+
+ C:\> pl2bat -s "/\.pl|\.pm/" foo.pl bar.PM
+ [..creates foo.bat, bar.bat..]
+
+ C:\> pl2bat < somefile > another.bat
+
+ C:\> pl2bat > another.bat
+ print scalar reverse "rekcah lrep rehtona tsuj\n";
+ ^Z
+ [..another.bat is now a certified japh application..]
+
+=head1 BUGS
+
+C<$0> will contain the full name, including the ".bat" suffix
+when the generated batch file runs. If you don't like this,
+see runperl.bat for an alternative way to invoke perl scripts.
+
+Default behavior is to invoke Perl with the -S flag, so Perl will
+search the PATH to find the script. This may have undesirable
+effects.
+
+=head1 SEE ALSO
+
+perl, perlwin32, runperl.bat
+
+=cut
+
diff --git a/win32/bin/runperl.pl b/win32/bin/runperl.pl
new file mode 100644
index 0000000000..95b33f9342
--- /dev/null
+++ b/win32/bin/runperl.pl
@@ -0,0 +1,67 @@
+#!perl -w
+$0 =~ s|\.bat||i;
+unless (-f $0) {
+ $0 =~ s|.*[/\\]||;
+ for (".", split ';', $ENV{PATH}) {
+ $_ = "." if $_ eq "";
+ $0 = "$_/$0" , goto doit if -f "$_/$0";
+ }
+ die "`$0' not found.\n";
+}
+doit: exec "perl", "-x", $0, @ARGV;
+die "Failed to exec `$0': $!";
+__END__
+
+=head1 NAME
+
+runperl.bat - "universal" batch file to run perl scripts
+
+=head1 SYNOPSIS
+
+ C:\> copy runperl.bat foo.bat
+ C:\> foo
+ [..runs the perl script `foo'..]
+
+ C:\> foo.bat
+ [..runs the perl script `foo'..]
+
+
+=head1 DESCRIPTION
+
+This file can be copied to any file name ending in the ".bat" suffix.
+When executed on a DOS-like operating system, it will invoke the perl
+script of the same name, but without the ".bat" suffix. It will
+look for the script in the same directory as itself, and then in
+the current directory, and then search the directories in your PATH.
+
+It relies on the C<exec()> operator, so you will need to make sure
+that works in your perl.
+
+This method of invoking perl scripts has some advantages over
+batch-file wrappers like C<pl2bat.bat>: it avoids duplication
+of all the code; it ensures C<$0> contains the same name as the
+executing file, without any egregious ".bat" suffix; it allows
+you to separate your perl scripts from the wrapper used to
+run them; since the wrapper is generic, you can use symbolic
+links to simply link to C<runperl.bat>, if you are serving your
+files on a filesystem that supports that.
+
+On the other hand, if the batch file is invoked with the ".bat"
+suffix, it does an extra C<exec()>. This may be a performance
+issue. You can avoid this by running it without specifying
+the ".bat" suffix.
+
+Perl is invoked with the -x flag, so the script must contain
+a C<#!perl> line. Any flags found on that line will be honored.
+
+=head1 BUGS
+
+Perl is invoked with the -S flag, so it will search the PATH to find
+the script. This may have undesirable effects.
+
+=head1 SEE ALSO
+
+perl, perlwin32, pl2bat.bat
+
+=cut
+
diff --git a/win32/bin/search.bat b/win32/bin/search.pl
index 88e83e5040..b63f7353af 100644
--- a/win32/bin/search.bat
+++ b/win32/bin/search.pl
@@ -1,9 +1,3 @@
-@rem = '--*-Perl-*--';
-@rem = '
-@echo off
-perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-@rem ';
#!/usr/local/bin/perl -w
'di';
'ig00';
@@ -1869,5 +1863,3 @@ http://www.wg.omron.co.jp/cgi-bin/j-e/jfriedl.html
.SH "LATEST SOURCE"
See http://www.wg.omron.co.jp/~jfriedl/perl/index.html
-__END__
-:endofperl
diff --git a/win32/bin/test.bat b/win32/bin/test.bat
deleted file mode 100644
index e6b7b38160..0000000000
--- a/win32/bin/test.bat
+++ /dev/null
@@ -1,143 +0,0 @@
-@rem = '
-@echo off
-if exist perl.exe goto perlhere
-echo Cannot run without perl.exe in current directory!! Did you build it?
-pause
-goto endofperl
-:perlhere
-if exist perlglob.exe goto perlglobhere
-echo Cannot run without perlglob.exe in current directory!! Did you build it?
-pause
-goto endofperl
-:perlglobhere
-perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-@rem ';
-
-#Portions (C) 1995 Microsoft Corporation. All rights reserved.
-# Developed by hip communications inc., http://info.hip.com/info/
-
-
-# This is written in a peculiar style, since we're trying to avoid
-# most of the constructs we'll be testing for.
-
-$| = 1;
-
-if ($ARGV[0] eq '-v') {
- $verbose = 1;
- shift;
-}
-
-
-# WYT 1995-05-02
-chdir 't' if -f 't/TESTNT';
-
-
-if ($ARGV[0] eq '') {
-# @ARGV = split(/[ \n]/,
-# `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
-# `ls base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t`);
-
-# WYT 1995-05-02 wildcard expansion,
-# `perl -e "print( join( ' ', \@ARGV ) )" base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t nt/*.t`);
-
-# WYT 1995-06-01 removed all dependency on perlglob
-# WYT 1995-11-28 hacked up to cope with braindead Win95 console.
- push( @ARGV, `dir/s/b base` );
- push( @ARGV, `dir/s/b comp` );
- push( @ARGV, `dir/s/b cmd` );
- push( @ARGV, `dir/s/b io` );
- push( @ARGV, `dir/s/b op` );
- push( @ARGV, `dir/s/b lib` );
- push( @ARGV, `dir/s/b nt` );
-
- grep( chomp, @ARGV );
- @ARGV = grep( /\.t$/, @ARGV );
- grep( s/.*t\\//, @ARGV );
-}
-
-$sharpbang = 0;
-
-$bad = 0;
-$good = 0;
-$total = @ARGV;
-while ($test = shift) {
- if ($test =~ /^$/) {
- next;
- }
- $te = $test;
-# chop off 't' extension
- chop($te);
- print "$te" . '.' x (15 - length($te));
- if ($sharpbang) {
- open(results,"./$test |") || (print "can't run.\n");
- } else {
- $switch = '';
-# open(results,"./perl$switch $test |") || (print "can't run.\n");
- open(results,"perl$switch $test |") || (print "can't run.\n");
- }
- $ok = 0;
- $next = 0;
- while (<results>) {
- if ($verbose) {
- print $_;
- }
- unless (/^#/||/^$/) {
- if (/^1\.\.([0-9]+)/) {
- $max = $1;
- $totmax += $max;
- $files += 1;
- $next = 1;
- $ok = 1;
- } else {
- $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
- if (/^ok (.*)/ && $1 == $next) {
- $next = $next + 1;
- } else {
- $ok = 0;
- }
- }
- }
- }
- $next = $next - 1;
- if ($ok && $next == $max) {
- print "ok\n";
- $good = $good + 1;
- } else {
- $next += 1;
- print "FAILED on test $next\n";
- $bad = $bad + 1;
- $_ = $test;
- if (/^base/) {
- die "Failed a basic test--cannot continue.\n";
- }
- }
-}
-
-if ($bad == 0) {
- if ($ok) {
- print "All tests successful.\n";
- } else {
- die "FAILED--no tests were run for some reason.\n";
- }
-} else {
- $pct = sprintf("%.2f", $good / $total * 100);
- if ($bad == 1) {
- warn "Failed 1 test, $pct% okay.\n";
- } else {
- die "Failed $bad/$total tests, $pct% okay.\n";
- }
-}
-
-
-# WYT 1995-05-03 times not implemented.
-#($user,$sys,$cuser,$csys) = times;
-#print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n",
-# $user,$sys,$cuser,$csys,$files,$totmax);
-
-#`del /f Cmd_while.tmp Comp.try null 2>NULL`;
-
-unlink 'Cmd_while.tmp', 'Comp.try', 'null';
-
-__END__
-:endofperl
diff --git a/win32/bin/webget.bat b/win32/bin/webget.pl
index e77bb88ced..3d72208cb2 100644
--- a/win32/bin/webget.bat
+++ b/win32/bin/webget.pl
@@ -1,9 +1,3 @@
-@rem = '--*-Perl-*--';
-@rem = '
-@echo off
-perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-@rem ';
#!/usr/local/bin/perl -w
#-
@@ -1095,5 +1089,3 @@ sub dummy {
}
__END__
-__END__
-:endofperl
diff --git a/win32/config.bc b/win32/config.bc
index 4b148de2fc..ad76309e5d 100644
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -58,7 +58,7 @@ byacc='byacc'
byteorder='1234'
c=''
castflags='0'
-cat='cat'
+cat='type'
cccdlflags=''
ccdlflags=' '
cf_by='garyng'
@@ -68,10 +68,10 @@ chgrp=''
chmod=''
chown=''
clocktype='clock_t'
-comm='comm'
+comm=''
compress=''
contains='grep'
-cp='cp'
+cp='copy'
cpio=''
cpp='cpp32'
cpp_stuff='42'
@@ -81,7 +81,7 @@ cpprun=''
cppstdin=''
cryptlib=''
csh='undef'
-d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_Gconvert='gcvt((x),(n),(b))'
d_access='define'
d_alarm='undef'
d_archlib='define'
@@ -371,13 +371,13 @@ line='line'
lint=''
lkflags=''
ln=''
-lns=''
+lns='copy'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
longsize='4'
lp=''
lpr=''
-ls='ls'
+ls='dir'
lseektype='off_t'
mail=''
mailx=''
@@ -421,7 +421,7 @@ path_sep=';'
perl='perl'
perladmin=''
perlpath='~INST_TOP~\bin\perl.exe'
-pg='pg'
+pg=''
phostname='hostname'
plibpth=''
pmake=''
@@ -432,7 +432,7 @@ prototype='define'
randbits='15'
ranlib=''
rd_nodata='-1'
-rm='rm'
+rm='del'
rmail=''
runnm='true'
scriptdir='~INST_TOP~\bin'
@@ -459,7 +459,7 @@ sockethdr=''
socketlib=''
sort='sort'
spackage='Perl5'
-spitshell='cat'
+spitshell=''
split=''
ssizetype='int'
startperl='#perl'
@@ -474,11 +474,11 @@ sysman='/usr/man/man1'
tail=''
tar=''
tbl=''
-test='test'
+test=''
timeincl='/usr/include/sys/time.h '
timetype='time_t'
touch='touch'
-tr='tr'
+tr=''
troff=''
uidtype='uid_t'
uname='uname'
diff --git a/win32/config.vc b/win32/config.vc
index 0219969d89..7cc91dabd3 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -58,7 +58,7 @@ byacc='byacc'
byteorder='1234'
c=''
castflags='0'
-cat='cat'
+cat='type'
cccdlflags=''
ccdlflags=' '
cf_by='garyng'
@@ -68,10 +68,10 @@ chgrp=''
chmod=''
chown=''
clocktype='clock_t'
-comm='comm'
+comm=''
compress=''
contains='grep'
-cp='cp'
+cp='copy'
cpio=''
cpp='cpp'
cpp_stuff='42'
@@ -371,13 +371,13 @@ line='line'
lint=''
lkflags=''
ln=''
-lns=''
+lns='copy'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
longsize='4'
lp=''
lpr=''
-ls='ls'
+ls='dir'
lseektype='off_t'
mail=''
mailx=''
@@ -421,7 +421,7 @@ path_sep=';'
perl='perl'
perladmin=''
perlpath='~INST_TOP~\bin\perl.exe'
-pg='pg'
+pg=''
phostname='hostname'
plibpth=''
pmake=''
@@ -432,7 +432,7 @@ prototype='define'
randbits='15'
ranlib=''
rd_nodata='-1'
-rm='rm'
+rm='del'
rmail=''
runnm='true'
scriptdir='~INST_TOP~\bin'
@@ -459,7 +459,7 @@ sockethdr=''
socketlib=''
sort='sort'
spackage='Perl5'
-spitshell='cat'
+spitshell=''
split=''
ssizetype='int'
startperl='#perl'
@@ -474,11 +474,11 @@ sysman='/usr/man/man1'
tail=''
tar=''
tbl=''
-test='test'
+test=''
timeincl='/usr/include/sys/time.h '
timetype='time_t'
touch='touch'
-tr='tr'
+tr=''
troff=''
uidtype='uid_t'
uname='uname'
diff --git a/win32/config_H.bc b/win32/config_H.bc
index 5976289777..1883e973c1 100644
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -1511,7 +1511,7 @@
* d_Gconvert='sprintf((b),"%.*g",(n),(x))'
* The last two assume trailing zeros should not be kept.
*/
-#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
/* HAS_GETPGID:
* This symbol, if defined, indicates to the C program that
@@ -1687,7 +1687,7 @@
* /bin/pdksh, /bin/ash, /bin/bash, or even something such as
* D:/bin/sh.exe.
*/
-#define SH_PATH "cmd /x /c" /**/
+#define SH_PATH "cmd.exe" /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
diff --git a/win32/config_H.vc b/win32/config_H.vc
index ced62a11c8..36a9a5b0d4 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -1687,7 +1687,7 @@
* /bin/pdksh, /bin/ash, /bin/bash, or even something such as
* D:/bin/sh.exe.
*/
-#define SH_PATH "cmd /x /c" /**/
+#define SH_PATH "cmd.exe" /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
diff --git a/win32/config_h.PL b/win32/config_h.PL
index 98b474a144..5d47016dc9 100644
--- a/win32/config_h.PL
+++ b/win32/config_h.PL
@@ -37,7 +37,8 @@ while (<SH>)
s#/[ *\*]*\*/#/**/#;
if (/^\s*#define\s+ARCHLIB_EXP/)
{
- $_ = "#define ARCHLIB_EXP (win32PerlLibPath())\t/**/\n";
+ $_ = "#define ARCHLIB_EXP (win32PerlLibPath())\t/**/\n"
+ . "#define APPLLIB_EXP (win32SiteLibPath())\t/**/\n";
}
print H;
}
diff --git a/win32/makedef.pl b/win32/makedef.pl
index 73380b4b55..b4883ccb59 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -12,7 +12,7 @@
# There is some symbol defined in global.sym and interp.sym
# that does not present in the WIN32 port but there is no easy
-# way to find them so I just put a exeception list here
+# way to find them so I just put a exception list here
my $CCTYPE = shift || "MSVC";
@@ -191,12 +191,17 @@ sub emit_symbol {
chomp $symbol;
if ($CCTYPE eq "BORLAND") {
# workaround Borland quirk by exporting both the straight
- # name and a name with leading underscore
- #print "\t$symbol = _$symbol\n";
+ # name and a name with leading underscore. Note the
+ # alias *must* come after the symbol itself, if both
+ # are to be exported. (Linker bug?)
print "\t_$symbol\n";
+ print "\t$symbol = _$symbol\n";
}
else {
+ # for binary coexistence, export both the symbol and
+ # alias with leading underscore
print "\t$symbol\n";
+ print "\t_$symbol = $symbol\n";
}
}
@@ -275,6 +280,7 @@ win32_mkdir
win32_rmdir
win32_chdir
win32_flock
+win32_execvp
win32_htons
win32_ntohs
win32_htonl
@@ -317,3 +323,25 @@ win32_sethostent
win32_setnetent
win32_setprotoent
win32_setservent
+win32_getenv
+win32_perror
+win32_setbuf
+win32_setvbuf
+win32_flushall
+win32_fcloseall
+win32_fgets
+win32_gets
+win32_fgetc
+win32_putc
+win32_puts
+win32_getchar
+win32_putchar
+win32_malloc
+win32_calloc
+win32_realloc
+win32_free
+win32stdio
+Perl_win32_init
+RunPerl
+SetIOSubSystem
+GetIOSubSystem
diff --git a/win32/makefile.mk b/win32/makefile.mk
index b91fffc187..4696dcbccf 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -176,8 +176,8 @@ GLOBEXE=..\perlglob.exe
CONFIGPM=..\lib\Config.pm
MINIMOD=..\lib\ExtUtils\Miniperl.pm
-PL2BAT=bin\PL2BAT.BAT
-GLOBBAT = perlglob.bat
+PL2BAT=bin\pl2bat.pl
+GLOBBAT = bin\perlglob.bat
.IF "$(CCTYPE)" == "BORLAND"
@@ -350,8 +350,8 @@ $(GLOBEXE): perlglob.obj
$(LINK32) $(LINK_FLAGS) -out:$@ -subsystem:$(SUBSYS) perlglob.obj setargv.obj
.ENDIF
-perlglob.bat : ..\lib\File\DosGlob.pm $(MINIPERL)
- $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(*B).bat
+$(GLOBBAT) : ..\lib\File\DosGlob.pm $(MINIPERL)
+ $(MINIPERL) $(PL2BAT) - < ..\lib\File\DosGlob.pm > $(GLOBBAT)
perlglob.obj : perlglob.c
@@ -367,7 +367,7 @@ config.w32 : $(CFGSH_TMPL)
..\config.sh : config.w32 $(MINIPERL) config_sh.PL
$(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \
"INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \
- "cf_email=$(EMAIL)" "libs=$(LIBFILES:f)" \
+ "cf_email=$(EMAIL)" "libs=$(LIBFILES:f)" "incpath=$(CCINCDIR)" \
"libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" "libc=$(LIBC)" \
config.w32 > ..\config.sh
@@ -498,6 +498,9 @@ $(SOCKET_DLL): $(SOCKET).xs $(PERLEXE)
cd $(EXTDIR)\$(*B) && $(MAKE)
doc: $(PERLEXE)
+ cd ..\pod && $(MAKE) -f ..\win32\pod.mak checkpods \
+ pod2html pod2latex pod2man pod2text
+ cd ..\pod && $(XCOPY) *.bat ..\win32\bin\*.*
copy ..\README.win32 ..\pod\perlwin32.pod
$(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \
--podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML:s,:,|,)" \
@@ -507,7 +510,9 @@ utils: $(PERLEXE)
cd ..\utils && $(MAKE) PERL=$(MINIPERL)
cd ..\utils && $(PERLEXE) ..\win32\$(PL2BAT) h2ph splain perlbug \
pl2pm c2ph h2xs perldoc pstruct
- cd ..\utils && $(XCOPY) *.bat ..\win32\bin\*.*
+ $(XCOPY) ..\utils\*.bat bin\*.*
+ $(PERLEXE) $(PL2BAT) bin\network.pl bin\www.pl bin\runperl.pl \
+ bin\pl2bat.pl
distclean: clean
-del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \
@@ -519,6 +524,11 @@ distclean: clean
$(DYNALOADER).c
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
+ -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
+.IF "$(PERL95EXE)" != ""
+ -del /f perl95.c
+.ENDIF
+ -del /f bin\*.bat
-cd $(EXTDIR) && del /s *.lib *.def *.map *.bs Makefile *.obj pm_to_blib
-rmdir /s /q ..\lib\auto
-rmdir /s /q ..\lib\CORE
@@ -531,9 +541,8 @@ install : all doc utils
$(XCOPY) $(PERL95EXE) $(INST_BIN)\*.*
.ENDIF
$(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
- $(XCOPY) $(GLOBBAT) $(INST_BIN)\*.*
$(XCOPY) $(PERLDLL) $(INST_BIN)\*.*
- $(XCOPY) bin\*.* $(INST_BIN)\*.*
+ $(XCOPY) bin\*.bat $(INST_BIN)\*.*
$(RCOPY) ..\lib $(INST_LIB)\*.*
$(XCOPY) ..\pod\*.bat $(INST_BIN)\*.*
$(XCOPY) ..\pod\*.pod $(INST_POD)\*.*
@@ -579,7 +588,8 @@ clean :
-@erase $(CORE_OBJ)
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
- -@erase ..\*.obj *.obj ..\*.lib ..\*.exp
+ -@erase ..\*.obj ..\*.lib ..\*.exp *.obj *.lib *.exp
+ -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase *.ilk
-@erase *.pdb
diff --git a/win32/perllib.c b/win32/perllib.c
index 45d64d394c..391b4d375f 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -103,284 +103,11 @@ char *staticlinkmodules[] = {
EXTERN_C void boot_DynaLoader _((CV* cv));
-static
-XS(w32_GetCwd)
-{
- dXSARGS;
- SV *sv = sv_newmortal();
- /* Make one call with zero size - return value is required size */
- DWORD len = GetCurrentDirectory((DWORD)0,NULL);
- SvUPGRADE(sv,SVt_PV);
- SvGROW(sv,len);
- SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
- /*
- * If result != 0
- * then it worked, set PV valid,
- * else leave it 'undef'
- */
- if (SvCUR(sv))
- SvPOK_on(sv);
- EXTEND(sp,1);
- ST(0) = sv;
- XSRETURN(1);
-}
-
-static
-XS(w32_SetCwd)
-{
- dXSARGS;
- if (items != 1)
- croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),na)))
- XSRETURN_YES;
-
- XSRETURN_NO;
-}
-
-static
-XS(w32_GetNextAvailDrive)
-{
- dXSARGS;
- char ix = 'C';
- char root[] = "_:\\";
- while (ix <= 'Z') {
- root[0] = ix++;
- if (GetDriveType(root) == 1) {
- root[2] = '\0';
- XSRETURN_PV(root);
- }
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetLastError)
-{
- dXSARGS;
- XSRETURN_IV(GetLastError());
-}
-
-static
-XS(w32_LoginName)
-{
- dXSARGS;
- char name[256];
- DWORD size = sizeof(name);
- if (GetUserName(name,&size)) {
- /* size includes NULL */
- ST(0) = sv_2mortal(newSVpv(name,size-1));
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_NodeName)
-{
- dXSARGS;
- char name[MAX_COMPUTERNAME_LENGTH+1];
- DWORD size = sizeof(name);
- if (GetComputerName(name,&size)) {
- /* size does NOT include NULL :-( */
- ST(0) = sv_2mortal(newSVpv(name,size));
- XSRETURN(1);
- }
- XSRETURN_UNDEF;
-}
-
-
-static
-XS(w32_DomainName)
-{
- dXSARGS;
- char name[256];
- DWORD size = sizeof(name);
- if (GetUserName(name,&size)) {
- char sid[1024];
- DWORD sidlen = sizeof(sid);
- char dname[256];
- DWORD dnamelen = sizeof(dname);
- SID_NAME_USE snu;
- if (LookupAccountName(NULL, name, &sid, &sidlen,
- dname, &dnamelen, &snu)) {
- XSRETURN_PV(dname); /* all that for this */
- }
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_FsType)
-{
- dXSARGS;
- char fsname[256];
- DWORD flags, filecomplen;
- if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
- &flags, fsname, sizeof(fsname))) {
- if (GIMME == G_ARRAY) {
- XPUSHs(sv_2mortal(newSVpv(fsname,0)));
- XPUSHs(sv_2mortal(newSViv(flags)));
- XPUSHs(sv_2mortal(newSViv(filecomplen)));
- PUTBACK;
- return;
- }
- XSRETURN_PV(fsname);
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetOSVersion)
-{
- dXSARGS;
- OSVERSIONINFO osver;
-
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- if (GetVersionEx(&osver)) {
- XPUSHs(newSVpv(osver.szCSDVersion, 0));
- XPUSHs(newSViv(osver.dwMajorVersion));
- XPUSHs(newSViv(osver.dwMinorVersion));
- XPUSHs(newSViv(osver.dwBuildNumber));
- XPUSHs(newSViv(osver.dwPlatformId));
- PUTBACK;
- return;
- }
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_IsWinNT)
-{
- dXSARGS;
- XSRETURN_IV(IsWinNT());
-}
-
-static
-XS(w32_IsWin95)
-{
- dXSARGS;
- XSRETURN_IV(IsWin95());
-}
-
-static
-XS(w32_FormatMessage)
-{
- dXSARGS;
- DWORD source = 0;
- char msgbuf[1024];
-
- if (items != 1)
- croak("usage: Win32::FormatMessage($errno)");
-
- if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
- &source, SvIV(ST(0)), 0,
- msgbuf, sizeof(msgbuf)-1, NULL))
- XSRETURN_PV(msgbuf);
-
- XSRETURN_UNDEF;
-}
-
-static
-XS(w32_Spawn)
-{
- dXSARGS;
- char *cmd, *args;
- PROCESS_INFORMATION stProcInfo;
- STARTUPINFO stStartInfo;
- BOOL bSuccess = FALSE;
-
- if(items != 3)
- croak("usage: Win32::Spawn($cmdName, $args, $PID)");
-
- cmd = SvPV(ST(0),na);
- args = SvPV(ST(1), na);
-
- memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
- stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
- stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
- stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
-
- if(CreateProcess(
- cmd, /* Image path */
- args, /* Arguments for command line */
- NULL, /* Default process security */
- NULL, /* Default thread security */
- FALSE, /* Must be TRUE to use std handles */
- NORMAL_PRIORITY_CLASS, /* No special scheduling */
- NULL, /* Inherit our environment block */
- NULL, /* Inherit our currrent directory */
- &stStartInfo, /* -> Startup info */
- &stProcInfo)) /* <- Process info (if OK) */
- {
- CloseHandle(stProcInfo.hThread);/* library source code does this. */
- sv_setiv(ST(2), stProcInfo.dwProcessId);
- bSuccess = TRUE;
- }
- XSRETURN_IV(bSuccess);
-}
-
-static
-XS(w32_GetTickCount)
-{
- dXSARGS;
- XSRETURN_IV(GetTickCount());
-}
-
-static
-XS(w32_GetShortPathName)
-{
- dXSARGS;
- SV *shortpath;
-
- if(items != 1)
- croak("usage: Win32::GetShortPathName($longPathName)");
-
- shortpath = sv_mortalcopy(ST(0));
- SvUPGRADE(shortpath, SVt_PV);
- /* src == target is allowed */
- if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath)))
- ST(0) = shortpath;
- else
- ST(0) = &sv_undef;
- XSRETURN(1);
-}
-
static void
xs_init()
{
char *file = __FILE__;
dXSUB_SYS;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-
- /* XXX should be removed after checking with Nick */
- newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
-
- /* these names are Activeware compatible */
- newXS("Win32::GetCwd", w32_GetCwd, file);
- newXS("Win32::SetCwd", w32_SetCwd, file);
- newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
- newXS("Win32::GetLastError", w32_GetLastError, file);
- newXS("Win32::LoginName", w32_LoginName, file);
- newXS("Win32::NodeName", w32_NodeName, file);
- newXS("Win32::DomainName", w32_DomainName, file);
- newXS("Win32::FsType", w32_FsType, file);
- newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
- newXS("Win32::IsWinNT", w32_IsWinNT, file);
- newXS("Win32::IsWin95", w32_IsWin95, file);
- newXS("Win32::FormatMessage", w32_FormatMessage, file);
- newXS("Win32::Spawn", w32_Spawn, file);
- newXS("Win32::GetTickCount", w32_GetTickCount, file);
- newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
-
- /* XXX Bloat Alert! The following Activeware preloads really
- * ought to be part of Win32::Sys::*, so they're not included
- * here.
- */
- /* LookupAccountName
- * LookupAccountSID
- * InitiateSystemShutdown
- * AbortSystemShutdown
- * ExpandEnvrironmentStrings
- */
}
diff --git a/win32/win32.c b/win32/win32.c
index 6fbe7339c5..7a4c2852db 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -22,22 +22,25 @@
#include "EXTERN.h"
#include "perl.h"
+#include "XSUB.h"
#include <fcntl.h>
#include <sys/stat.h>
#include <assert.h>
#include <string.h>
#include <stdarg.h>
+#include <float.h>
#define CROAK croak
#define WARN warn
+#define EXECF_EXEC 1
+#define EXECF_SPAWN 2
+#define EXECF_SPAWN_NOWAIT 3
+
static DWORD IdOS(void);
extern WIN32_IOSUBSYSTEM win32stdio;
-#ifndef __BORLANDC__ /* pointers cannot be declared TLS! */
-__declspec(thread)
-#endif
-PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio;
+static PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio;
BOOL ProbeEnv = FALSE;
DWORD Win32System = (DWORD)-1;
@@ -45,6 +48,8 @@ char szShellPath[MAX_PATH+1];
char szPerlLibRoot[MAX_PATH+1];
HANDLE PerlDllHandle = INVALID_HANDLE_VALUE;
+static int do_spawn2(char *cmd, int exectype);
+
int
IsWin95(void) {
return (IdOS() == VER_PLATFORM_WIN32_WINDOWS);
@@ -55,7 +60,7 @@ IsWinNT(void) {
return (IdOS() == VER_PLATFORM_WIN32_NT);
}
-void *
+DllExport PWIN32_IOSUBSYSTEM
SetIOSubSystem(void *p)
{
PWIN32_IOSUBSYSTEM old = pIOSubSystem;
@@ -72,6 +77,12 @@ SetIOSubSystem(void *p)
return old;
}
+DllExport PWIN32_IOSUBSYSTEM
+GetIOSubSystem(void)
+{
+ return pIOSubSystem;
+}
+
char *
win32PerlLibPath(void)
{
@@ -89,6 +100,15 @@ win32PerlLibPath(void)
return (szPerlLibRoot);
}
+char *
+win32SiteLibPath(void)
+{
+ static char szPerlSiteLib[MAX_PATH+1];
+ strcpy(szPerlSiteLib, win32PerlLibPath());
+ strcat(szPerlSiteLib, "\\site");
+ return (szPerlSiteLib);
+}
+
BOOL
HasRedirection(char *ptr)
{
@@ -359,7 +379,8 @@ do_aspawn(void* really, void** mark, void** arglast)
}
else {
argv[index++] = cmd = GetShell();
- argv[index++] = "/x"; /* always enable command extensions */
+ if (IsWinNT())
+ argv[index++] = "/x"; /* always enable command extensions */
argv[index++] = "/c";
}
@@ -384,7 +405,7 @@ do_aspawn(void* really, void** mark, void** arglast)
}
int
-do_spawn(char *cmd)
+do_spawn2(char *cmd, int exectype)
{
char **a;
char *s;
@@ -414,7 +435,19 @@ do_spawn(char *cmd)
}
*a = Nullch;
if(argv[0]) {
- status = win32_spawnvp(P_WAIT, argv[0], (const char* const*)argv);
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = win32_spawnvp(P_WAIT, argv[0],
+ (const char* const*)argv);
+ break;
+ case EXECF_SPAWN_NOWAIT:
+ status = win32_spawnvp(P_NOWAIT, argv[0],
+ (const char* const*)argv);
+ break;
+ case EXECF_EXEC:
+ status = win32_execvp(argv[0], (const char* const*)argv);
+ break;
+ }
if(status != -1 || errno == 0)
needToTry = FALSE;
}
@@ -423,19 +456,49 @@ do_spawn(char *cmd)
}
if(needToTry) {
char *argv[5];
- argv[0] = shell; argv[1] = "/x"; argv[2] = "/c";
- argv[3] = cmd; argv[4] = Nullch;
- status = win32_spawnvp(P_WAIT, argv[0], (const char* const*)argv);
+ int i = 0;
+ argv[i++] = shell;
+ if (IsWinNT())
+ argv[i++] = "/x";
+ argv[i++] = "/c"; argv[i++] = cmd; argv[i] = Nullch;
+ switch (exectype) {
+ case EXECF_SPAWN:
+ status = win32_spawnvp(P_WAIT, argv[0],
+ (const char* const*)argv);
+ break;
+ case EXECF_SPAWN_NOWAIT:
+ status = win32_spawnvp(P_NOWAIT, argv[0],
+ (const char* const*)argv);
+ break;
+ case EXECF_EXEC:
+ status = win32_execvp(argv[0], (const char* const*)argv);
+ break;
+ }
}
if (status < 0) {
if (dowarn)
- warn("Can't spawn \"%s\": %s", needToTry ? shell : argv[0],
+ warn("Can't %s \"%s\": %s",
+ (exectype == EXECF_EXEC ? "exec" : "spawn"),
+ needToTry ? shell : argv[0],
strerror(errno));
status = 255 << 8;
}
return (status);
}
+int
+do_spawn(char *cmd)
+{
+ return do_spawn2(cmd, EXECF_SPAWN);
+}
+
+bool
+do_exec(char *cmd)
+{
+ do_spawn2(cmd, EXECF_EXEC);
+ return FALSE;
+}
+
#define PATHLEN 1024
@@ -461,7 +524,7 @@ opendir(char *filename)
/* char *dummy;*/
/* check to see if filename is a directory */
- if(stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) {
+ if (win32_stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) {
return NULL;
}
@@ -711,6 +774,7 @@ win32_stat(const char *path, struct stat *buffer)
char t[MAX_PATH];
const char *p = path;
int l = strlen(path);
+ int res;
if (l > 1) {
switch(path[l - 1]) {
@@ -723,9 +787,52 @@ win32_stat(const char *path, struct stat *buffer)
};
}
}
- return stat(p, buffer);
+ res = pIOSubSystem->pfnstat(p,buffer);
+#ifdef __BORLANDC__
+ if (res == 0) {
+ if (S_ISDIR(buffer->st_mode))
+ buffer->st_mode |= S_IWRITE | S_IEXEC;
+ else if (S_ISREG(buffer->st_mode)) {
+ if (l >= 4 && path[l-4] == '.') {
+ const char *e = path + l - 3;
+ if (strnicmp(e,"exe",3)
+ && strnicmp(e,"bat",3)
+ && strnicmp(e,"com",3)
+ && (IsWin95() || strnicmp(e,"cmd",3)))
+ buffer->st_mode &= ~S_IEXEC;
+ else
+ buffer->st_mode |= S_IEXEC;
+ }
+ else
+ buffer->st_mode &= ~S_IEXEC;
+ }
+ }
+#endif
+ return res;
}
+#ifndef USE_WIN32_RTL_ENV
+
+DllExport char *
+win32_getenv(const char *name)
+{
+ static char *curitem = Nullch;
+ static DWORD curlen = 512;
+ DWORD needlen;
+ if (!curitem)
+ New(1305,curitem,curlen,char);
+ if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
+ return Nullch;
+ while (needlen > curlen) {
+ Renew(curitem,needlen,char);
+ curlen = needlen;
+ needlen = GetEnvironmentVariable(name,curitem,curlen);
+ }
+ return curitem;
+}
+
+#endif
+
#undef times
int
mytimes(struct tms *timebuf)
@@ -1101,6 +1208,108 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
return pIOSubSystem->pfnspawnvp(mode, cmdname, argv);
}
+DllExport int
+win32_execvp(const char *cmdname, const char *const *argv)
+{
+ return pIOSubSystem->pfnexecvp(cmdname, argv);
+}
+
+DllExport void
+win32_perror(const char *str)
+{
+ pIOSubSystem->pfnperror(str);
+}
+
+DllExport void
+win32_setbuf(FILE *pf, char *buf)
+{
+ pIOSubSystem->pfnsetbuf(pf, buf);
+}
+
+DllExport int
+win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
+{
+ return pIOSubSystem->pfnsetvbuf(pf, buf, type, size);
+}
+
+DllExport int
+win32_flushall(void)
+{
+ return pIOSubSystem->pfnflushall();
+}
+
+DllExport int
+win32_fcloseall(void)
+{
+ return pIOSubSystem->pfnfcloseall();
+}
+
+DllExport char*
+win32_fgets(char *s, int n, FILE *pf)
+{
+ return pIOSubSystem->pfnfgets(s, n, pf);
+}
+
+DllExport char*
+win32_gets(char *s)
+{
+ return pIOSubSystem->pfngets(s);
+}
+
+DllExport int
+win32_fgetc(FILE *pf)
+{
+ return pIOSubSystem->pfnfgetc(pf);
+}
+
+DllExport int
+win32_putc(int c, FILE *pf)
+{
+ return pIOSubSystem->pfnputc(c,pf);
+}
+
+DllExport int
+win32_puts(const char *s)
+{
+ return pIOSubSystem->pfnputs(s);
+}
+
+DllExport int
+win32_getchar(void)
+{
+ return pIOSubSystem->pfngetchar();
+}
+
+DllExport int
+win32_putchar(int c)
+{
+ return pIOSubSystem->pfnputchar(c);
+}
+
+DllExport void*
+win32_malloc(size_t size)
+{
+ return pIOSubSystem->pfnmalloc(size);
+}
+
+DllExport void*
+win32_calloc(size_t numitems, size_t size)
+{
+ return pIOSubSystem->pfncalloc(numitems,size);
+}
+
+DllExport void*
+win32_realloc(void *block, size_t size)
+{
+ return pIOSubSystem->pfnrealloc(block,size);
+}
+
+DllExport void
+win32_free(void *block)
+{
+ pIOSubSystem->pfnfree(block);
+}
+
int
stolen_open_osfhandle(long handle, int flags)
{
@@ -1127,3 +1336,296 @@ win32_flock(int fd, int oper)
return pIOSubSystem->pfnflock(fd, oper);
}
+static
+XS(w32_GetCwd)
+{
+ dXSARGS;
+ SV *sv = sv_newmortal();
+ /* Make one call with zero size - return value is required size */
+ DWORD len = GetCurrentDirectory((DWORD)0,NULL);
+ SvUPGRADE(sv,SVt_PV);
+ SvGROW(sv,len);
+ SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
+ /*
+ * If result != 0
+ * then it worked, set PV valid,
+ * else leave it 'undef'
+ */
+ if (SvCUR(sv))
+ SvPOK_on(sv);
+ EXTEND(sp,1);
+ ST(0) = sv;
+ XSRETURN(1);
+}
+
+static
+XS(w32_SetCwd)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("usage: Win32::SetCurrentDirectory($cwd)");
+ if (SetCurrentDirectory(SvPV(ST(0),na)))
+ XSRETURN_YES;
+
+ XSRETURN_NO;
+}
+
+static
+XS(w32_GetNextAvailDrive)
+{
+ dXSARGS;
+ char ix = 'C';
+ char root[] = "_:\\";
+ while (ix <= 'Z') {
+ root[0] = ix++;
+ if (GetDriveType(root) == 1) {
+ root[2] = '\0';
+ XSRETURN_PV(root);
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetLastError)
+{
+ dXSARGS;
+ XSRETURN_IV(GetLastError());
+}
+
+static
+XS(w32_LoginName)
+{
+ dXSARGS;
+ char name[256];
+ DWORD size = sizeof(name);
+ if (GetUserName(name,&size)) {
+ /* size includes NULL */
+ ST(0) = sv_2mortal(newSVpv(name,size-1));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_NodeName)
+{
+ dXSARGS;
+ char name[MAX_COMPUTERNAME_LENGTH+1];
+ DWORD size = sizeof(name);
+ if (GetComputerName(name,&size)) {
+ /* size does NOT include NULL :-( */
+ ST(0) = sv_2mortal(newSVpv(name,size));
+ XSRETURN(1);
+ }
+ XSRETURN_UNDEF;
+}
+
+
+static
+XS(w32_DomainName)
+{
+ dXSARGS;
+ char name[256];
+ DWORD size = sizeof(name);
+ if (GetUserName(name,&size)) {
+ char sid[1024];
+ DWORD sidlen = sizeof(sid);
+ char dname[256];
+ DWORD dnamelen = sizeof(dname);
+ SID_NAME_USE snu;
+ if (LookupAccountName(NULL, name, &sid, &sidlen,
+ dname, &dnamelen, &snu)) {
+ XSRETURN_PV(dname); /* all that for this */
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_FsType)
+{
+ dXSARGS;
+ char fsname[256];
+ DWORD flags, filecomplen;
+ if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
+ &flags, fsname, sizeof(fsname))) {
+ if (GIMME == G_ARRAY) {
+ XPUSHs(sv_2mortal(newSVpv(fsname,0)));
+ XPUSHs(sv_2mortal(newSViv(flags)));
+ XPUSHs(sv_2mortal(newSViv(filecomplen)));
+ PUTBACK;
+ return;
+ }
+ XSRETURN_PV(fsname);
+ }
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetOSVersion)
+{
+ dXSARGS;
+ OSVERSIONINFO osver;
+
+ osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ if (GetVersionEx(&osver)) {
+ XPUSHs(newSVpv(osver.szCSDVersion, 0));
+ XPUSHs(newSViv(osver.dwMajorVersion));
+ XPUSHs(newSViv(osver.dwMinorVersion));
+ XPUSHs(newSViv(osver.dwBuildNumber));
+ XPUSHs(newSViv(osver.dwPlatformId));
+ PUTBACK;
+ return;
+ }
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_IsWinNT)
+{
+ dXSARGS;
+ XSRETURN_IV(IsWinNT());
+}
+
+static
+XS(w32_IsWin95)
+{
+ dXSARGS;
+ XSRETURN_IV(IsWin95());
+}
+
+static
+XS(w32_FormatMessage)
+{
+ dXSARGS;
+ DWORD source = 0;
+ char msgbuf[1024];
+
+ if (items != 1)
+ croak("usage: Win32::FormatMessage($errno)");
+
+ if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
+ &source, SvIV(ST(0)), 0,
+ msgbuf, sizeof(msgbuf)-1, NULL))
+ XSRETURN_PV(msgbuf);
+
+ XSRETURN_UNDEF;
+}
+
+static
+XS(w32_Spawn)
+{
+ dXSARGS;
+ char *cmd, *args;
+ PROCESS_INFORMATION stProcInfo;
+ STARTUPINFO stStartInfo;
+ BOOL bSuccess = FALSE;
+
+ if(items != 3)
+ croak("usage: Win32::Spawn($cmdName, $args, $PID)");
+
+ cmd = SvPV(ST(0),na);
+ args = SvPV(ST(1), na);
+
+ memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
+ stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
+ stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
+ stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
+
+ if(CreateProcess(
+ cmd, /* Image path */
+ args, /* Arguments for command line */
+ NULL, /* Default process security */
+ NULL, /* Default thread security */
+ FALSE, /* Must be TRUE to use std handles */
+ NORMAL_PRIORITY_CLASS, /* No special scheduling */
+ NULL, /* Inherit our environment block */
+ NULL, /* Inherit our currrent directory */
+ &stStartInfo, /* -> Startup info */
+ &stProcInfo)) /* <- Process info (if OK) */
+ {
+ CloseHandle(stProcInfo.hThread);/* library source code does this. */
+ sv_setiv(ST(2), stProcInfo.dwProcessId);
+ bSuccess = TRUE;
+ }
+ XSRETURN_IV(bSuccess);
+}
+
+static
+XS(w32_GetTickCount)
+{
+ dXSARGS;
+ XSRETURN_IV(GetTickCount());
+}
+
+static
+XS(w32_GetShortPathName)
+{
+ dXSARGS;
+ SV *shortpath;
+
+ if(items != 1)
+ croak("usage: Win32::GetShortPathName($longPathName)");
+
+ shortpath = sv_mortalcopy(ST(0));
+ SvUPGRADE(shortpath, SVt_PV);
+ /* src == target is allowed */
+ if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath)))
+ ST(0) = shortpath;
+ else
+ ST(0) = &sv_undef;
+ XSRETURN(1);
+}
+
+void
+init_os_extras()
+{
+ char *file = __FILE__;
+ dXSUB_SYS;
+
+ /* XXX should be removed after checking with Nick */
+ newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
+
+ /* these names are Activeware compatible */
+ newXS("Win32::GetCwd", w32_GetCwd, file);
+ newXS("Win32::SetCwd", w32_SetCwd, file);
+ newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
+ newXS("Win32::GetLastError", w32_GetLastError, file);
+ newXS("Win32::LoginName", w32_LoginName, file);
+ newXS("Win32::NodeName", w32_NodeName, file);
+ newXS("Win32::DomainName", w32_DomainName, file);
+ newXS("Win32::FsType", w32_FsType, file);
+ newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
+ newXS("Win32::IsWinNT", w32_IsWinNT, file);
+ newXS("Win32::IsWin95", w32_IsWin95, file);
+ newXS("Win32::FormatMessage", w32_FormatMessage, file);
+ newXS("Win32::Spawn", w32_Spawn, file);
+ newXS("Win32::GetTickCount", w32_GetTickCount, file);
+ newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+
+ /* XXX Bloat Alert! The following Activeware preloads really
+ * ought to be part of Win32::Sys::*, so they're not included
+ * here.
+ */
+ /* LookupAccountName
+ * LookupAccountSID
+ * InitiateSystemShutdown
+ * AbortSystemShutdown
+ * ExpandEnvrironmentStrings
+ */
+}
+
+void
+Perl_win32_init(int *argcp, char ***argvp)
+{
+ /* Disable floating point errors, Perl will trap the ones we
+ * care about. VC++ RTL defaults to switching these off
+ * already, but the Borland RTL doesn't. Since we don't
+ * want to be at the vendor's whim on the default, we set
+ * it explicitly here.
+ */
+#if !defined(_ALPHA_)
+ _control87(MCW_EM, MCW_EM);
+#endif
+}
diff --git a/win32/win32.h b/win32/win32.h
index 344ddaba59..dc069ba366 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -31,6 +31,10 @@
#define _chdir chdir
#include <sys/types.h>
+#ifndef DllMain
+#define DllMain DllEntryPoint
+#endif
+
#pragma warn -ccc
#pragma warn -rch
#pragma warn -sig
@@ -64,6 +68,19 @@ extern char *staticlinkmodules[];
* facilities for accessing the same. See note in util.c/my_setenv().
*/
/*#define USE_WIN32_RTL_ENV */
+
+#ifndef USE_WIN32_RTL_ENV
+#include <stdlib.h>
+#ifndef EXT
+#include "EXTERN.h"
+#endif
+#undef getenv
+#define getenv win32_getenv
+EXT char *win32_getenv(const char *name);
+#endif
+
+EXT void Perl_win32_init(int *argcp, char ***argvp);
+
#define USE_SOCKETS_AS_HANDLES
#ifndef USE_SOCKETS_AS_HANDLES
extern FILE *myfdopen(int, char *);
@@ -99,10 +116,13 @@ struct tms {
unsigned int sleep(unsigned int);
char *win32PerlLibPath(void);
+char *win32SiteLibPath(void);
int mytimes(struct tms *timebuf);
unsigned int myalarm(unsigned int sec);
int do_aspawn(void* really, void** mark, void** arglast);
int do_spawn(char *cmd);
+char do_exec(char *cmd);
+void init_os_extras(void);
typedef char * caddr_t; /* In malloc.c (core address). */
diff --git a/win32/win32io.c b/win32/win32io.c
index 0651781342..12bc645d2d 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -293,10 +293,29 @@ WIN32_IOSUBSYSTEM win32stdio = {
my_open_osfhandle,
my_get_osfhandle,
spawnvp,
- _mkdir,
- _rmdir,
- _chdir,
+ mkdir,
+ rmdir,
+ chdir,
my_flock, /* (*pfunc_flock)(int fd, int oper) */
+ execvp,
+ perror,
+ setbuf,
+ setvbuf,
+ flushall,
+ fcloseall,
+ fgets,
+ gets,
+ fgetc,
+ putc,
+ puts,
+ getchar,
+ putchar,
+ fscanf,
+ scanf,
+ malloc,
+ calloc,
+ realloc,
+ free,
87654321L, /* end of structure */
};
diff --git a/win32/win32io.h b/win32/win32io.h
index 678327cd20..ba4080c152 100644
--- a/win32/win32io.h
+++ b/win32/win32io.h
@@ -60,7 +60,26 @@ int (*pfnmkdir)(const char *path);
int (*pfnrmdir)(const char *path);
int (*pfnchdir)(const char *path);
int (*pfnflock)(int fd, int oper);
-int signature_end;
+int (*pfnexecvp)(const char *cmdname, const char *const *argv);
+void (*pfnperror)(const char *str);
+void (*pfnsetbuf)(FILE *pf, char *buf);
+int (*pfnsetvbuf)(FILE *pf, char *buf, int type, size_t size);
+int (*pfnflushall)(void);
+int (*pfnfcloseall)(void);
+char* (*pfnfgets)(char *s, int n, FILE *pf);
+char* (*pfngets)(char *s);
+int (*pfnfgetc)(FILE *pf);
+int (*pfnputc)(int c, FILE *pf);
+int (*pfnputs)(const char *s);
+int (*pfngetchar)(void);
+int (*pfnputchar)(int c);
+int (*pfnfscanf)(FILE *pf, const char *format, ...);
+int (*pfnscanf)(const char *format, ...);
+void* (*pfnmalloc)(size_t size);
+void* (*pfncalloc)(size_t numitems, size_t size);
+void* (*pfnrealloc)(void *block, size_t size);
+void (*pfnfree)(void *block);
+int signature_end;
} WIN32_IOSUBSYSTEM;
typedef WIN32_IOSUBSYSTEM *PWIN32_IOSUBSYSTEM;
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 4b4b9973d3..4606563d0e 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -63,6 +63,23 @@ EXT int win32_mkdir(const char *dir, int mode);
EXT int win32_rmdir(const char *dir);
EXT int win32_chdir(const char *dir);
EXT int win32_flock(int fd, int oper);
+EXT int win32_execvp(const char *cmdname, const char *const *argv);
+EXT void win32_perror(const char *str);
+EXT void win32_setbuf(FILE *pf, char *buf);
+EXT int win32_setvbuf(FILE *pf, char *buf, int type, size_t size);
+EXT int win32_flushall(void);
+EXT int win32_fcloseall(void);
+EXT char* win32_fgets(char *s, int n, FILE *pf);
+EXT char* win32_gets(char *s);
+EXT int win32_fgetc(FILE *pf);
+EXT int win32_putc(int c, FILE *pf);
+EXT int win32_puts(const char *s);
+EXT int win32_getchar(void);
+EXT int win32_putchar(int c);
+EXT void* win32_malloc(size_t size);
+EXT void* win32_calloc(size_t numitems, size_t size);
+EXT void* win32_realloc(void *block, size_t size);
+EXT void win32_free(void *block);
/*
* these two are win32 specific but still io related
@@ -80,7 +97,8 @@ long stolen_get_osfhandle(int fd);
#include <win32io.h> /* pull in the io sub system structure */
-void * SetIOSubSystem(void *piosubsystem);
+EXT PWIN32_IOSUBSYSTEM SetIOSubSystem(void *piosubsystem);
+EXT PWIN32_IOSUBSYSTEM GetIOSubSystem(void);
/*
* the following six(6) is #define in stdio.h
@@ -97,6 +115,9 @@ void * SetIOSubSystem(void *piosubsystem);
#ifdef __BORLANDC__
#undef ungetc
#undef getc
+#undef putc
+#undef getchar
+#undef putchar
#undef fileno
#endif
@@ -137,6 +158,7 @@ void * SetIOSubSystem(void *piosubsystem);
#define tmpfile() win32_tmpfile()
#define abort() win32_abort()
#define fstat(fd,bufptr) win32_fstat(fd,bufptr)
+#define stat(pth,bufptr) win32_stat(pth,bufptr)
#define setmode(fd,mode) win32_setmode(fd,mode)
#define lseek(fd,offset,orig) win32_lseek(fd,offset,orig)
#define tell(fd) win32_tell(fd)
@@ -154,6 +176,25 @@ void * SetIOSubSystem(void *piosubsystem);
#define rmdir win32_rmdir
#define chdir win32_chdir
#define flock(fd,o) win32_flock(fd,o)
+#define execvp win32_execvp
+#define perror win32_perror
+#define setbuf win32_setbuf
+#define setvbuf win32_setvbuf
+#define flushall win32_flushall
+#define fcloseall win32_fcloseall
+#define fgets win32_fgets
+#define gets win32_gets
+#define fgetc win32_fgetc
+#define putc win32_putc
+#define puts win32_puts
+#define getchar win32_getchar
+#define putchar win32_putchar
+#define fscanf (GetIOSubSystem()->pfnfscanf)
+#define scanf (GetIOSubSystem()->pfnscanf)
+#define malloc win32_malloc
+#define calloc win32_calloc
+#define realloc win32_realloc
+#define free win32_free
#endif /* WIN32IO_IS_STDIO */
#endif /* WIN32IOP_H */
diff --git a/win32/win32sck.c b/win32/win32sck.c
index fe5b2e7153..d541a7e3ba 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -694,9 +694,12 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
d->s_name = s->s_name;
d->s_aliases = s->s_aliases;
d->s_port = s->s_port;
+#ifndef __BORLANDC__ /* Buggy on Win95 and WinNT-with-Borland-WSOCK */
if (!IsWin95() && s->s_proto && strlen(s->s_proto))
d->s_proto = s->s_proto;
- else if (proto && strlen(proto))
+ else
+#endif
+ if (proto && strlen(proto))
d->s_proto = (char *)proto;
else
d->s_proto = "tcp";
View Lorry Controller Status