diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1997-04-15 00:00:00 +1200 |
|---|---|---|
| committer | Chip Salzenberg <chip@atlantic.net> | 1997-04-15 00:00:00 +1200 |
| commit | 137443ea0a858c43f5a720730cac6209a7d41948 (patch) | |
| tree | ea114bc1f5281a6ec91ebc67e34ed7f30571daee | |
| parent | 683d4eee6f3b749aec29cc849f45404c6acda85e (diff) | |
| download | perl-5.003_97e.tar.gz | |
[inseparable changes from patch from perl-5.003_97d to perl-5.003_97e]perl-5.003_97e
CORE LANGUAGE CHANGES
Subject: New operator: sysseek()
From: Chip Salzenberg <chip@perl.com>
Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm global.sym keywords.pl opcode.pl pod/perldelta.pod pod/perlfunc.pod pp_sys.c t/op/sysio.t toke.c
Subject: Allow recursive substitution again
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c
CORE PORTABILITY
Subject: Use size_t for socket size parameters of GNU libc
From: Chip Salzenberg <chip@perl.com>
Files: doio.c pp_sys.c
Subject: Win32 update (four patches)
From: Gurusamy Sarathy <gsar@engin.umich.edu>
Files: MANIFEST README.win32 dosish.h ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm perl.c utils/perlbug.PL utils/perldoc.PL win32/Makefile win32/TEST win32/config.H win32/config.w32 win32/config_h.PL win32/config_sh.PL win32/perllib.c win32/runperl.c win32/win32.c win32/win32io.c win32/win32sck.c
DOCUMENTATION
Subject: Add CGI to perldelta.pod and improve its description in MANIFEST
From: Chip Salzenberg <chip@perl.com>
Files: MANIFEST pod/perldelta.pod
Subject: Describe probs with majordomo 1.94.1
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldelta.pod
Subject: Fix description of /\G/g
From: Chip Salzenberg <chip@perl.com>
Files: pod/perlop.pod
Subject: Mention '...' operator in precedence table
Date: Sun, 13 Apr 1997 11:24:16 -0600
From: Tom Christiansen <tchrist@perl.com>
Files: pod/perlop.pod
private-msgid: 199704131724.LAA23120@jhereg.perl.com
OTHER CORE CHANGES
Subject: New API function: perl_eval_pv()
Date: Mon, 14 Apr 1997 17:13:41 -0400
From: Doug MacEachern <dougm@opengroup.org>
Files: perl.c pod/perlcall.pod pod/perldelta.pod pod/perlembed.pod pod/perlguts.pod proto.h
private-msgid: 199704142113.RAA06823@postman.osf.org
Subject: Fix C< s//whatever/ >, which reuses old pattern
From: Chip Salzenberg <chip@perl.com>
Files: pp_hot.c regexec.c
47 files changed, 1109 insertions, 773 deletions
@@ -46,6 +46,162 @@ And the Keepers of the Patch Pumpkin: ------------------- + Version 5.003_97e +------------------- + +Y'know, I've heard of this "beta" thing, but it's been so long since +I've seen one, I'm not sure it really exists... + + CORE LANGUAGE CHANGES + + Title: "New operator: sysseek()" + From: Chip Salzenberg + Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm global.sym + keywords.pl opcode.pl pod/perldelta.pod pod/perlfunc.pod + pp_sys.c t/op/sysio.t toke.c + + Title: "Allow recursive substitution again" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c + + CORE PORTABILITY + + Title: "Use size_t for socket size parameters of GNU libc" + From: Chip Salzenberg + Files: doio.c pp_sys.c + + Title: "Fix STMT_{START,END} under g++" + From: Steven Parkes <parkes@sierravista.com> + Msg-ID: <199704141935.MAA11240@monterey.sierravista.com> + Date: Mon, 14 Apr 1997 12:35:34 -0700 + Files: perl.h + + Title: "Win32 update (four patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: MANIFEST README.win32 dosish.h ext/SDBM_File/Makefile.PL + ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.c + ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm perl.c + utils/perlbug.PL utils/perldoc.PL win32/Makefile win32/TEST + win32/config.H win32/config.w32 win32/config_h.PL + win32/config_sh.PL win32/perllib.c win32/runperl.c + win32/win32.c win32/win32io.c win32/win32sck.c + + OTHER CORE CHANGES + + Title: "New API function: perl_eval_pv()" + From: Doug MacEachern + Msg-ID: <199704142113.RAA06823@postman.osf.org> + Date: Mon, 14 Apr 1997 17:13:41 -0400 + Files: perl.c pod/perlcall.pod pod/perldelta.pod pod/perlembed.pod + pod/perlguts.pod proto.h + + Title: "Fix C< s//whatever/ >, which reuses old pattern" + From: Chip Salzenberg + Files: pp_hot.c regexec.c + + Title: "Return a value from PerlIO_{,un}getc" + From: Hallvard B Furuseth + Msg-ID: <199704131228.OAA05695@bombur2.uio.no> + Date: Sun, 13 Apr 1997 14:28:14 +0200 (MET DST) + Files: perlio.c + + Title: "Fix for environment leak" + From: skimo@breughel.ufsia.ac.be (Sven Verdoolaege) + Msg-ID: <19970415103246.NN46698@breughel.ufsia.ac.be> + Date: Tue, 15 Apr 1997 10:32:46 +0200 + Files: util.c + + Title: "Fix comments in seed()" + From: Hallvard B Furuseth + Msg-ID: <199704141758.TAA06895@bombur2.uio.no> + Date: Mon, 14 Apr 1997 19:58:38 +0200 (MET DST) + Files: pp.c + + BUILD PROCESS + + Title: "Put extensions' autoload files in $archlib" + From: Chip Salzenberg + Files: installperl + + Title: "Use '-fPIC' for debugging compiles under Solaris with gcc" + From: Hallvard B Furuseth + Files: Configure + + LIBRARY AND EXTENSIONS + + Title: "Refresh CGI to 2.34" + From: Chip Salzenberg + Files: eg/cgi/customize.cgi eg/cgi/tryit.cgi lib/CGI.pm + lib/CGI/Apache.pm + + Title: "Debugger update" + From: Ilya Zakharevich + Msg-ID: <199704142115.RAA09923@monk.mps.ohio-state.edu> + Date: Mon, 14 Apr 1997 17:15:27 -0400 (EDT) + Files: lib/perl5db.pl + + Title: "diagnostics: $/ gotcha" + From: Andreas Koenig + Msg-ID: <199704151814.UAA03404@anna.in-berlin.de> + Date: Tue, 15 Apr 1997 20:14:01 +0200 + Files: lib/diagnostics.pm + + Title: "Update File::Path" + From: Andreas Koenig + Msg-ID: <199704151401.QAA02556@anna.in-berlin.de> + Date: Tue, 15 Apr 1997 16:01:07 +0200 + Files: lib/File/Path.pm t/lib/filepath.t + + Title: "User::pwent.pm: g{,e}cos" + From: Tom Christiansen + Msg-ID: <199704130135.TAA23274@jhereg.perl.com> + Date: Sat, 12 Apr 1997 19:35:54 -0600 + Files: lib/User/pwent.pm + + Title: "Sys::Syslog: hyphens in hostnames" + From: Jarkko Hietaniemi + Msg-ID: <199704151421.RAA19693@alpha.hut.fi> + Date: Tue, 15 Apr 1997 17:21:53 +0300 (EET DST) + Files: lib/Sys/Syslog.pm + + Title: "Clean up format of dlopen() debug info" + From: Hallvard B Furuseth + Files: ext/DynaLoader/dl_dlopen.xs + + TESTS + + (no changes) + + UTILITIES + + Title: "xsubpp incorrectly handles 'class::newthing()'" + From: "John Q. Linux" <jql@jql.accessone.com> + Msg-ID: <199704122201.PAA01780@jql.accessone.com> + Date: Sat, 12 Apr 1997 15:01:33 -0700 + Files: lib/ExtUtils/xsubpp + + DOCUMENTATION + + Title: "Add CGI to perldelta.pod and improve its description in MANIFEST" + From: Chip Salzenberg + Files: MANIFEST pod/perldelta.pod + + Title: "Describe probs with majordomo 1.94.1" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Fix description of /\G/g" + From: Chip Salzenberg + Files: pod/perlop.pod + + Title: "Mention '...' operator in precedence table" + From: Tom Christiansen + Msg-ID: <199704131724.LAA23120@jhereg.perl.com> + Date: Sun, 13 Apr 1997 11:24:16 -0600 + Files: pod/perlop.pod + + +------------------- Version 5.003_97d ------------------- @@ -309,12 +309,12 @@ lib/AutoLoader.pm Autoloader base class lib/AutoSplit.pm Split up autoload functions lib/Benchmark.pm Measure execution time lib/Bundle/CPAN.pm The CPAN bundle -lib/CGI.pm Web server interface -lib/CGI/Apache.pm Web server interface -lib/CGI/Carp.pm Web server interface -lib/CGI/Fast.pm Web server interface -lib/CGI/Push.pm Web server interface -lib/CGI/Switch.pm Web server interface +lib/CGI.pm Web server interface ("Common Gateway Interface") +lib/CGI/Apache.pm Support for Apache's Perl module +lib/CGI/Carp.pm Log server errors with helpful context +lib/CGI/Fast.pm Support for FastCGI (persistent server process) +lib/CGI/Push.pm Support for server push +lib/CGI/Switch.pm Simple interface for multiple server types lib/CPAN.pm Interface to Comprehensive Perl Archive Network lib/CPAN/FirstTime.pm Utility for creating CPAN config files lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions @@ -810,25 +810,8 @@ vms/vms.c VMS-specific C code for Perl core vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms vms/vmsish.h VMS-specific C header for Perl core vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions -win32/Fcntl.mak Win32 port -win32/IO.mak Win32 port win32/Makefile Win32 port -win32/Opcode.mak Win32 port -win32/SDBM_File.mak Win32 port -win32/Socket.mak Win32 port win32/TEST Win32 port -win32/VC-2.0/Fcntl.mak Win32 port -win32/VC-2.0/IO.mak Win32 port -win32/VC-2.0/Opcode.mak Win32 port -win32/VC-2.0/SDBM_File.mak Win32 port -win32/VC-2.0/Socket.mak Win32 port -win32/VC-2.0/libperl.mak Win32 port -win32/VC-2.0/miniperl.mak Win32 port -win32/VC-2.0/modules.mak Win32 port -win32/VC-2.0/perl.mak Win32 port -win32/VC-2.0/perldll.mak Win32 port -win32/VC-2.0/perlglob.mak Win32 port -win32/VC-2.0/pod.mak Win32 port win32/autosplit.pl Win32 port win32/bin/network.pl Win32 port win32/bin/pl2bat.bat Win32 port @@ -837,32 +820,25 @@ win32/bin/test.bat Win32 port win32/bin/webget.bat Win32 port win32/bin/www.pl Win32 port win32/config.H Win32 config header (suffix not ".h" for metaconfig) -win32/config.w32 Win32 port +win32/config.w32 Win32 base line config.sh +win32/config_h.PL Perl code to convert Win32 config.sh to config.h +win32/config_sh.PL Perl code to update Win32 config.sh from Makefile win32/dl_win32.xs Win32 port -win32/dosish.diff Win32 port win32/genxsdef.pl Win32 port win32/include/arpa/inet.h Win32 port win32/include/dirent.h Win32 port win32/include/netdb.h Win32 port win32/include/sys/socket.h Win32 port -win32/libperl.mak Win32 port win32/makedef.pl Win32 port win32/makemain.pl Win32 port win32/makeperldef.pl Win32 port -win32/miniperl.mak Win32 port -win32/modules.mak Win32 port -win32/perl.mak Win32 port -win32/perl.rc Win32 port -win32/perldll.mak Win32 port win32/perlglob.c Win32 port -win32/perlglob.mak Win32 port win32/perllib.c Win32 port win32/pod.mak Win32 port win32/runperl.c Win32 port win32/splittree.pl Win32 port win32/win32.c Win32 port win32/win32.h Win32 port -win32/win32aux.c Win32 port win32/win32io.c Win32 port win32/win32io.h Win32 port win32/win32iop.h Win32 port diff --git a/README.win32 b/README.win32 index 0128469d88..40badf2901 100644 --- a/README.win32 +++ b/README.win32 @@ -78,60 +78,30 @@ but it doesn't hurt to do so. =back -=head2 Building and Installation +=head2 Building =over 4 =item * -The "win32" directory contains *.mak files for use with the NMAKE that -comes with Visual C++ ver. 4.0 and above. If you wish to build perl -using Visual C++ versions between 2.0 and 4.0, do the following two -additional steps (these steps are not required if you are -using Visual C++ versions 4.0 and above): - -=over 8 - -=item 1. - -Overwrite the *.mak files in the win32 subdirectory with the versions -in the win32\VC-2.0 directory. - -=item 2. - -Reset your INCLUDE environment variable to the MSVC include directory. -For example: - - set INCLUDE=E:\MSVC20\INCLUDE - -This must have only one directory (a list of directories will not work). -VCVARS32.BAT may put multiple locations in there, which is why this step -is required. - -=back - -=item * - Make sure you are in the "win32" subdirectory under the perl toplevel. +This directory contains a "Makefile" that will work with +versions of NMAKE that come with Visual C++ ver. 2.0 and above. =item * -Type "nmake" while in the "win32" subdirectory. This should build -everything. Specifically, it will create perl.exe, perl.dll, and -perlglob.exe at the perl toplevel, and various other extension dll's -under the lib\auto directory. If the make fails for any reason, make -sure you have done the previous steps correctly. +Edit the Makefile and change the values of INST_DRV and INST_TOP +if you want perl to be installed in a location other than "C:\PERL". =item * -Type "nmake install". This will put the newly built perl and the -libraries under C:\PERL. If you want to alter this location, to say, -D:\FOO\PERL, you will have to say: - - nmake install INST_TOP=D:\FOO\PERL +If you are using Visual C++ ver. 4.0 and above: type "nmake". +If you are using a Visual C++ ver. 2.0: type "nmake CCTYPE=MSVC20". -instead. To use the Perl you just installed, make sure you set your -PATH environment variable to C:\PERL\BIN (or D:\FOO\PERL\BIN). +This should build everything. Specifically, it will create perl.exe, +perl.dll, and perlglob.exe at the perl toplevel, and various other +extension dll's under the lib\auto directory. If the make fails for +any reason, make sure you have done the previous steps correctly. =back @@ -141,14 +111,18 @@ Type "nmake test". This will run most of the tests from the testsuite (many tests will be skipped, and but no test should fail). If some tests do fail, it may be because you are using a different command -shell than the native "cmd.exe". To get a more detailed breakdown of the -tests that failed, you may want to say: - - cd ..\t - .\perl harness +shell than the native "cmd.exe". Please report any failures as described under L<BUGS AND CAVEATS>. +=head2 Installation + +Type "nmake install". This will put the newly built perl and the +libraries under "C:\PERL" (actually whatever you set INST_TOP to +in the Makefile). To use the Perl you just installed, set your +PATH environment variable to "C:\PERL\BIN" (or $(INST_TOP)\BIN, if you +changed the default as above). + =head1 BUGS AND CAVEATS This is still very much an experimental port, and should be considered @@ -255,6 +229,6 @@ at the time. Nick Ing-Simmons and Gurusamy Sarathy have made numerous and sundry hacks since then. -Last updated: 05 April 1997 +Last updated: 13 April 1997 =cut @@ -68,7 +68,7 @@ /* Put this after #includes because <unistd.h> defines _XOPEN_*. */ #ifndef Sock_size_t -# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) # define Sock_size_t Size_t # else # define Sock_size_t int @@ -689,22 +689,18 @@ long pos; int whence; { register IO *io; + register PerlIO *fp; - if (!gv) - goto nuts; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto nuts; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_seek(IoIFP(io), pos, whence) >= 0; - -nuts: + if (op->op_type == OP_SYSSEEK) + return lseek(PerlIO_fileno(fp), pos, whence) >= 0; + else + return PerlIO_seek(fp, pos, whence) >= 0; + } if (dowarn) warn("seek() on unopened file"); SETERRNO(EBADF,RMS$_IFI); @@ -1,6 +1,8 @@ #define ABORT() abort(); +#ifndef SH_PATH #define SH_PATH "/bin/sh" +#endif #ifdef DJGPP # define BIT_BUCKET "nul" @@ -815,6 +815,7 @@ #define pp_syscall Perl_pp_syscall #define pp_sysopen Perl_pp_sysopen #define pp_sysread Perl_pp_sysread +#define pp_sysseek Perl_pp_sysseek #define pp_system Perl_pp_system #define pp_syswrite Perl_pp_syswrite #define pp_tell Perl_pp_tell diff --git a/ext/Opcode/Makefile.PL b/ext/Opcode/Makefile.PL index cfc8246aea..400ae7caa0 100644 --- a/ext/Opcode/Makefile.PL +++ b/ext/Opcode/Makefile.PL @@ -1,6 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Opcode', + MAN3PODS => ' ', VERSION_FROM => 'Opcode.pm', - MAN3PODS => ' ' + XS_VERSION => '1.00' ); diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 5db658d601..fe96e25567 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -2,9 +2,10 @@ package Opcode; require 5.002; -use vars qw($VERSION @ISA @EXPORT_OK); +use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK); -$VERSION = "1.01"; +$VERSION = "1.02"; +$XS_VERSION = "1.00"; use strict; use Carp; @@ -27,7 +28,7 @@ sub opset_to_hex ($); sub opdump (;$); use subs @EXPORT_OK; -bootstrap Opcode $VERSION; +bootstrap Opcode $XS_VERSION; _init_optags(); @@ -379,7 +380,7 @@ such as open would need to be enabled. formline enterwrite leavewrite - print sysread syswrite send recv eof tell seek + print sysread syswrite send recv eof tell seek sysseek readdir telldir seekdir rewinddir diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL index 8fc9411768..210879f90b 100644 --- a/ext/SDBM_File/Makefile.PL +++ b/ext/SDBM_File/Makefile.PL @@ -5,19 +5,22 @@ use ExtUtils::MakeMaker; # config, all, clean, realclean and sdbm/Makefile # which perform the corresponding actions in the subdirectory. +$define = ($^O eq 'MSWin32') ? '/D "MSDOS"' : ''; + WriteMakefile( NAME => 'SDBM_File', MYEXTLIB => 'sdbm/libsdbm$(LIB_EXT)', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'SDBM_File.pm', + DEFINE => $define, ); sub MY::postamble { ' $(MYEXTLIB): sdbm/Makefile - cd sdbm; $(MAKE) all + cd sdbm && $(MAKE) all '; } diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL index a64cb13e29..b844147482 100644 --- a/ext/SDBM_File/sdbm/Makefile.PL +++ b/ext/SDBM_File/sdbm/Makefile.PL @@ -1,27 +1,31 @@ use ExtUtils::MakeMaker; + +$define = '-DSDBM -DDUFF'; +$define .= ' -DWIN32' if ($^O eq 'MSWin32'); + WriteMakefile( NAME => 'SDBM_File/sdbm', # doesn't matter what the name is here LINKTYPE => 'static', - DEFINE => '-DSDBM -DDUFF', - SKIP => [qw(static static_lib dynamic dynamic_lib)], + DEFINE => $define, + SKIP => [qw(dynamic dynamic_lib)], + OBJECT => '$(O_FILES)', clean => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'}, H => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)], C => [qw(sdbm.c pair.c hash.c)] ); +sub MY::post_constants { +' +INST_STATIC = libsdbm$(LIB_EXT) +' +} sub MY::top_targets { ' all :: static -static :: libsdbm$(LIB_EXT) - config :: -libsdbm$(LIB_EXT): $(O_FILES) - $(AR) cr libsdbm$(LIB_EXT) $(O_FILES) - $(RANLIB) libsdbm$(LIB_EXT) - lint: lint -abchx $(LIBSRCS) '; diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c index a62334c45e..c2d9cbd47d 100644 --- a/ext/SDBM_File/sdbm/sdbm.c +++ b/ext/SDBM_File/sdbm/sdbm.c @@ -32,6 +32,7 @@ static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; /* * externals */ +#ifndef WIN32 #ifndef sun extern int errno; #endif @@ -39,6 +40,7 @@ extern int errno; extern Malloc_t malloc proto((MEM_SIZE)); extern Free_t free proto((Malloc_t)); extern Off_t lseek(); +#endif /* * forward @@ -135,7 +137,7 @@ int mode; * open the files in sequence, and stat the dirfile. * If we fail anywhere, undo everything, return NULL. */ -#if defined(OS2) || defined(MSDOS) +#if defined(OS2) || defined(MSDOS) || defined(WIN32) flags |= O_BINARY; # endif if ((db->pagf = open(pagname, flags, mode)) > -1) { diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index 4eeb147f43..fdd9165145 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -120,7 +120,7 @@ extern long sdbm_hash proto((char *, int)); #include <unistd.h> #endif -#ifndef MSDOS +#if !defined(MSDOS) && !defined(WIN32) # ifdef PARAM_NEEDS_TYPES # include <sys/types.h> # endif diff --git a/global.sym b/global.sym index 1524c035cc..728cb6ef46 100644 --- a/global.sym +++ b/global.sym @@ -947,6 +947,7 @@ pp_symlink pp_syscall pp_sysopen pp_sysread +pp_sysseek pp_system pp_syswrite pp_tell diff --git a/keywords.h b/keywords.h index cd08665563..2be133b748 100644 --- a/keywords.h +++ b/keywords.h @@ -211,36 +211,37 @@ #define KEY_syscall 210 #define KEY_sysopen 211 #define KEY_sysread 212 -#define KEY_system 213 -#define KEY_syswrite 214 -#define KEY_tell 215 -#define KEY_telldir 216 -#define KEY_tie 217 -#define KEY_tied 218 -#define KEY_time 219 -#define KEY_times 220 -#define KEY_tr 221 -#define KEY_truncate 222 -#define KEY_uc 223 -#define KEY_ucfirst 224 -#define KEY_umask 225 -#define KEY_undef 226 -#define KEY_unless 227 -#define KEY_unlink 228 -#define KEY_unpack 229 -#define KEY_unshift 230 -#define KEY_untie 231 -#define KEY_until 232 -#define KEY_use 233 -#define KEY_utime 234 -#define KEY_values 235 -#define KEY_vec 236 -#define KEY_wait 237 -#define KEY_waitpid 238 -#define KEY_wantarray 239 -#define KEY_warn 240 -#define KEY_while 241 -#define KEY_write 242 -#define KEY_x 243 -#define KEY_xor 244 -#define KEY_y 245 +#define KEY_sysseek 213 +#define KEY_system 214 +#define KEY_syswrite 215 +#define KEY_tell 216 +#define KEY_telldir 217 +#define KEY_tie 218 +#define KEY_tied 219 +#define KEY_time 220 +#define KEY_times 221 +#define KEY_tr 222 +#define KEY_truncate 223 +#define KEY_uc 224 +#define KEY_ucfirst 225 +#define KEY_umask 226 +#define KEY_undef 227 +#define KEY_unless 228 +#define KEY_unlink 229 +#define KEY_unpack 230 +#define KEY_unshift 231 +#define KEY_untie 232 +#define KEY_until 233 +#define KEY_use 234 +#define KEY_utime 235 +#define KEY_values 236 +#define KEY_vec 237 +#define KEY_wait 238 +#define KEY_waitpid 239 +#define KEY_wantarray 240 +#define KEY_warn 241 +#define KEY_while 242 +#define KEY_write 243 +#define KEY_x 244 +#define KEY_xor 245 +#define KEY_y 246 diff --git a/keywords.pl b/keywords.pl index 8920a3b5bc..aebb3ee2e7 100755 --- a/keywords.pl +++ b/keywords.pl @@ -237,6 +237,7 @@ symlink syscall sysopen sysread +sysseek system syswrite tell diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 6f85c8cc45..b2466f1c3e 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -5,7 +5,7 @@ use Config; use File::Basename qw(basename dirname fileparse); use DirHandle; use strict; -use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS +use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Verbose %pm %static $Xsubpp_Version); $VERSION = substr q$Revision: 1.114 $, 10; @@ -15,7 +15,8 @@ Exporter::import('ExtUtils::MakeMaker', qw( $Verbose &neatvalue)); $Is_OS2 = $^O eq 'os2'; -$Is_Mac = $^O eq "MacOS"; +$Is_Mac = $^O eq 'MacOS'; +$Is_Win32 = $^O eq 'MSWin32'; if ($Is_VMS = $^O eq 'VMS') { require VMS::Filespec; @@ -1431,9 +1432,9 @@ sub init_main { if ($self->{PERL_SRC}){ $self->{PERL_LIB} ||= $self->catdir("$self->{PERL_SRC}","lib"); $self->{PERL_ARCHLIB} = $self->{PERL_LIB}; - $self->{PERL_INC} = $self->{PERL_SRC}; - # catch a situation that has occurred a few times in the past: + $self->{PERL_INC} = ($Is_Win32) ? $self->catdir($self->{PERL_LIB},"CORE") : $self->{PERL_SRC}; + # catch a situation that has occurred a few times in the past: unless ( -s $self->catfile($self->{PERL_SRC},'cflags') or @@ -1442,6 +1443,8 @@ sub init_main { -s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt') or $Is_Mac + or + $Is_Win32 ){ warn qq{ You cannot build extensions below the perl source tree after executing @@ -212,145 +212,146 @@ typedef enum { OP_PRTF, /* 205 */ OP_PRINT, /* 206 */ OP_SYSOPEN, /* 207 */ - OP_SYSREAD, /* 208 */ - OP_SYSWRITE, /* 209 */ - OP_SEND, /* 210 */ - OP_RECV, /* 211 */ - OP_EOF, /* 212 */ - OP_TELL, /* 213 */ - OP_SEEK, /* 214 */ - OP_TRUNCATE, /* 215 */ - OP_FCNTL, /* 216 */ - OP_IOCTL, /* 217 */ - OP_FLOCK, /* 218 */ - OP_SOCKET, /* 219 */ - OP_SOCKPAIR, /* 220 */ - OP_BIND, /* 221 */ - OP_CONNECT, /* 222 */ - OP_LISTEN, /* 223 */ - OP_ACCEPT, /* 224 */ - OP_SHUTDOWN, /* 225 */ - OP_GSOCKOPT, /* 226 */ - OP_SSOCKOPT, /* 227 */ - OP_GETSOCKNAME, /* 228 */ - OP_GETPEERNAME, /* 229 */ - OP_LSTAT, /* 230 */ - OP_STAT, /* 231 */ - OP_FTRREAD, /* 232 */ - OP_FTRWRITE, /* 233 */ - OP_FTREXEC, /* 234 */ - OP_FTEREAD, /* 235 */ - OP_FTEWRITE, /* 236 */ - OP_FTEEXEC, /* 237 */ - OP_FTIS, /* 238 */ - OP_FTEOWNED, /* 239 */ - OP_FTROWNED, /* 240 */ - OP_FTZERO, /* 241 */ - OP_FTSIZE, /* 242 */ - OP_FTMTIME, /* 243 */ - OP_FTATIME, /* 244 */ - OP_FTCTIME, /* 245 */ - OP_FTSOCK, /* 246 */ - OP_FTCHR, /* 247 */ - OP_FTBLK, /* 248 */ - OP_FTFILE, /* 249 */ - OP_FTDIR, /* 250 */ - OP_FTPIPE, /* 251 */ - OP_FTLINK, /* 252 */ - OP_FTSUID, /* 253 */ - OP_FTSGID, /* 254 */ - OP_FTSVTX, /* 255 */ - OP_FTTTY, /* 256 */ - OP_FTTEXT, /* 257 */ - OP_FTBINARY, /* 258 */ - OP_CHDIR, /* 259 */ - OP_CHOWN, /* 260 */ - OP_CHROOT, /* 261 */ - OP_UNLINK, /* 262 */ - OP_CHMOD, /* 263 */ - OP_UTIME, /* 264 */ - OP_RENAME, /* 265 */ - OP_LINK, /* 266 */ - OP_SYMLINK, /* 267 */ - OP_READLINK, /* 268 */ - OP_MKDIR, /* 269 */ - OP_RMDIR, /* 270 */ - OP_OPEN_DIR, /* 271 */ - OP_READDIR, /* 272 */ - OP_TELLDIR, /* 273 */ - OP_SEEKDIR, /* 274 */ - OP_REWINDDIR, /* 275 */ - OP_CLOSEDIR, /* 276 */ - OP_FORK, /* 277 */ - OP_WAIT, /* 278 */ - OP_WAITPID, /* 279 */ - OP_SYSTEM, /* 280 */ - OP_EXEC, /* 281 */ - OP_KILL, /* 282 */ - OP_GETPPID, /* 283 */ - OP_GETPGRP, /* 284 */ - OP_SETPGRP, /* 285 */ - OP_GETPRIORITY, /* 286 */ - OP_SETPRIORITY, /* 287 */ - OP_TIME, /* 288 */ - OP_TMS, /* 289 */ - OP_LOCALTIME, /* 290 */ - OP_GMTIME, /* 291 */ - OP_ALARM, /* 292 */ - OP_SLEEP, /* 293 */ - OP_SHMGET, /* 294 */ - OP_SHMCTL, /* 295 */ - OP_SHMREAD, /* 296 */ - OP_SHMWRITE, /* 297 */ - OP_MSGGET, /* 298 */ - OP_MSGCTL, /* 299 */ - OP_MSGSND, /* 300 */ - OP_MSGRCV, /* 301 */ - OP_SEMGET, /* 302 */ - OP_SEMCTL, /* 303 */ - OP_SEMOP, /* 304 */ - OP_REQUIRE, /* 305 */ - OP_DOFILE, /* 306 */ - OP_ENTEREVAL, /* 307 */ - OP_LEAVEEVAL, /* 308 */ - OP_ENTERTRY, /* 309 */ - OP_LEAVETRY, /* 310 */ - OP_GHBYNAME, /* 311 */ - OP_GHBYADDR, /* 312 */ - OP_GHOSTENT, /* 313 */ - OP_GNBYNAME, /* 314 */ - OP_GNBYADDR, /* 315 */ - OP_GNETENT, /* 316 */ - OP_GPBYNAME, /* 317 */ - OP_GPBYNUMBER, /* 318 */ - OP_GPROTOENT, /* 319 */ - OP_GSBYNAME, /* 320 */ - OP_GSBYPORT, /* 321 */ - OP_GSERVENT, /* 322 */ - OP_SHOSTENT, /* 323 */ - OP_SNETENT, /* 324 */ - OP_SPROTOENT, /* 325 */ - OP_SSERVENT, /* 326 */ - OP_EHOSTENT, /* 327 */ - OP_ENETENT, /* 328 */ - OP_EPROTOENT, /* 329 */ - OP_ESERVENT, /* 330 */ - OP_GPWNAM, /* 331 */ - OP_GPWUID, /* 332 */ - OP_GPWENT, /* 333 */ - OP_SPWENT, /* 334 */ - OP_EPWENT, /* 335 */ - OP_GGRNAM, /* 336 */ - OP_GGRGID, /* 337 */ - OP_GGRENT, /* 338 */ - OP_SGRENT, /* 339 */ - OP_EGRENT, /* 340 */ - OP_GETLOGIN, /* 341 */ - OP_SYSCALL, /* 342 */ + OP_SYSSEEK, /* 208 */ + OP_SYSREAD, /* 209 */ + OP_SYSWRITE, /* 210 */ + OP_SEND, /* 211 */ + OP_RECV, /* 212 */ + OP_EOF, /* 213 */ + OP_TELL, /* 214 */ + OP_SEEK, /* 215 */ + OP_TRUNCATE, /* 216 */ + OP_FCNTL, /* 217 */ + OP_IOCTL, /* 218 */ + OP_FLOCK, /* 219 */ + OP_SOCKET, /* 220 */ + OP_SOCKPAIR, /* 221 */ + OP_BIND, /* 222 */ + OP_CONNECT, /* 223 */ + OP_LISTEN, /* 224 */ + OP_ACCEPT, /* 225 */ + OP_SHUTDOWN, /* 226 */ + OP_GSOCKOPT, /* 227 */ + OP_SSOCKOPT, /* 228 */ + OP_GETSOCKNAME, /* 229 */ + OP_GETPEERNAME, /* 230 */ + OP_LSTAT, /* 231 */ + OP_STAT, /* 232 */ + OP_FTRREAD, /* 233 */ + OP_FTRWRITE, /* 234 */ + OP_FTREXEC, /* 235 */ + OP_FTEREAD, /* 236 */ + OP_FTEWRITE, /* 237 */ + OP_FTEEXEC, /* 238 */ + OP_FTIS, /* 239 */ + OP_FTEOWNED, /* 240 */ + OP_FTROWNED, /* 241 */ + OP_FTZERO, /* 242 */ + OP_FTSIZE, /* 243 */ + OP_FTMTIME, /* 244 */ + OP_FTATIME, /* 245 */ + OP_FTCTIME, /* 246 */ + OP_FTSOCK, /* 247 */ + OP_FTCHR, /* 248 */ + OP_FTBLK, /* 249 */ + OP_FTFILE, /* 250 */ + OP_FTDIR, /* 251 */ + OP_FTPIPE, /* 252 */ + OP_FTLINK, /* 253 */ + OP_FTSUID, /* 254 */ + OP_FTSGID, /* 255 */ + OP_FTSVTX, /* 256 */ + OP_FTTTY, /* 257 */ + OP_FTTEXT, /* 258 */ + OP_FTBINARY, /* 259 */ + OP_CHDIR, /* 260 */ + OP_CHOWN, /* 261 */ + OP_CHROOT, /* 262 */ + OP_UNLINK, /* 263 */ + OP_CHMOD, /* 264 */ + OP_UTIME, /* 265 */ + OP_RENAME, /* 266 */ + OP_LINK, /* 267 */ + OP_SYMLINK, /* 268 */ + OP_READLINK, /* 269 */ + OP_MKDIR, /* 270 */ + OP_RMDIR, /* 271 */ + OP_OPEN_DIR, /* 272 */ + OP_READDIR, /* 273 */ + OP_TELLDIR, /* 274 */ + OP_SEEKDIR, /* 275 */ + OP_REWINDDIR, /* 276 */ + OP_CLOSEDIR, /* 277 */ + OP_FORK, /* 278 */ + OP_WAIT, /* 279 */ + OP_WAITPID, /* 280 */ + OP_SYSTEM, /* 281 */ + OP_EXEC, /* 282 */ + OP_KILL, /* 283 */ + OP_GETPPID, /* 284 */ + OP_GETPGRP, /* 285 */ + OP_SETPGRP, /* 286 */ + OP_GETPRIORITY, /* 287 */ + OP_SETPRIORITY, /* 288 */ + OP_TIME, /* 289 */ + OP_TMS, /* 290 */ + OP_LOCALTIME, /* 291 */ + OP_GMTIME, /* 292 */ + OP_ALARM, /* 293 */ + OP_SLEEP, /* 294 */ + OP_SHMGET, /* 295 */ + OP_SHMCTL, /* 296 */ + OP_SHMREAD, /* 297 */ + OP_SHMWRITE, /* 298 */ + OP_MSGGET, /* 299 */ + OP_MSGCTL, /* 300 */ + OP_MSGSND, /* 301 */ + OP_MSGRCV, /* 302 */ + OP_SEMGET, /* 303 */ + OP_SEMCTL, /* 304 */ + OP_SEMOP, /* 305 */ + OP_REQUIRE, /* 306 */ + OP_DOFILE, /* 307 */ + OP_ENTEREVAL, /* 308 */ + OP_LEAVEEVAL, /* 309 */ + OP_ENTERTRY, /* 310 */ + OP_LEAVETRY, /* 311 */ + OP_GHBYNAME, /* 312 */ + OP_GHBYADDR, /* 313 */ + OP_GHOSTENT, /* 314 */ + OP_GNBYNAME, /* 315 */ + OP_GNBYADDR, /* 316 */ + OP_GNETENT, /* 317 */ + OP_GPBYNAME, /* 318 */ + OP_GPBYNUMBER, /* 319 */ + OP_GPROTOENT, /* 320 */ + OP_GSBYNAME, /* 321 */ + OP_GSBYPORT, /* 322 */ + OP_GSERVENT, /* 323 */ + OP_SHOSTENT, /* 324 */ + OP_SNETENT, /* 325 */ + OP_SPROTOENT, /* 326 */ + OP_SSERVENT, /* 327 */ + OP_EHOSTENT, /* 328 */ + OP_ENETENT, /* 329 */ + OP_EPROTOENT, /* 330 */ + OP_ESERVENT, /* 331 */ + OP_GPWNAM, /* 332 */ + OP_GPWUID, /* 333 */ + OP_GPWENT, /* 334 */ + OP_SPWENT, /* 335 */ + OP_EPWENT, /* 336 */ + OP_GGRNAM, /* 337 */ + OP_GGRGID, /* 338 */ + OP_GGRENT, /* 339 */ + OP_SGRENT, /* 340 */ + OP_EGRENT, /* 341 */ + OP_GETLOGIN, /* 342 */ + OP_SYSCALL, /* 343 */ OP_max } opcode; -#define MAXO 343 +#define MAXO 344 #ifndef DOINIT EXT char *op_name[]; @@ -564,6 +565,7 @@ EXT char *op_name[] = { "prtf", "print", "sysopen", + "sysseek", "sysread", "syswrite", "send", @@ -914,6 +916,7 @@ EXT char *op_desc[] = { "printf", "print", "sysopen", + "sysseek", "sysread", "syswrite", "send", @@ -1293,6 +1296,7 @@ OP * pp_leavewrite _((void)); OP * pp_prtf _((void)); OP * pp_print _((void)); OP * pp_sysopen _((void)); +OP * pp_sysseek _((void)); OP * pp_sysread _((void)); OP * pp_syswrite _((void)); OP * pp_send _((void)); @@ -1641,6 +1645,7 @@ EXT OP * (*ppaddr[])() = { pp_prtf, pp_print, pp_sysopen, + pp_sysseek, pp_sysread, pp_syswrite, pp_send, @@ -1991,6 +1996,7 @@ EXT OP * (*check[]) _((OP *op)) = { ck_listiob, /* prtf */ ck_listiob, /* print */ ck_fun, /* sysopen */ + ck_fun, /* sysseek */ ck_fun, /* sysread */ ck_fun, /* syswrite */ ck_fun, /* send */ @@ -2341,6 +2347,7 @@ EXT U32 opargs[] = { 0x00002e15, /* prtf */ 0x00002e15, /* print */ 0x00911604, /* sysopen */ + 0x00011604, /* sysseek */ 0x0091761d, /* sysread */ 0x0091161d, /* syswrite */ 0x0091161d, /* send */ @@ -470,6 +470,7 @@ prtf printf ck_listiob ims F? L print print ck_listiob ims F? L sysopen sysopen ck_fun s F S S S? +sysseek sysseek ck_fun s F S S sysread sysread ck_fun imst F R S S? syswrite syswrite ck_fun imst F S S S? diff --git a/patchlevel.h b/patchlevel.h index 8002c9371f..32aafef935 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -42,6 +42,7 @@ static char *local_patches[] = { ,"Dev97B - Second development patch to 5.003_97" ,"Dev97C - Third development patch to 5.003_97" ,"Dev97D - Fourth development patch to 5.003_97" + ,"Dev97E - Fifth development patch to 5.003_97" ,NULL }; @@ -1223,6 +1223,28 @@ I32 flags; /* See G_* flags in cop.h */ return retval; } +SV* +perl_eval_pv(p, croak_on_error) +char* p; +I32 croak_on_error; +{ + dSP; + SV* sv = newSVpv(p, 0); + + PUSHMARK(sp); + perl_eval_sv(sv, G_SCALAR); + SvREFCNT_dec(sv); + + SPAGAIN; + sv = POPs; + PUTBACK; + + if (croak_on_error && SvTRUE(GvSV(errgv))) + croak(SvPVx(GvSV(errgv), na)); + + return sv; +} + /* Require a module. */ void @@ -2293,6 +2315,9 @@ register char **env; if (!(s = strchr(*env,'='))) continue; *s++ = '\0'; +#ifdef WIN32 + (void)strupr(*env); +#endif sv = newSVpv(s--,0); (void)hv_store(hv, *env, s - *env, sv, 0); *s = '='; diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 5a689d0304..f90e09f238 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1922,35 +1922,16 @@ anonymous subroutine. However, our example showed how Perl script invoking an XSUB to preform this operation. Let's see how it can be done inside our C code: - SV *perl_eval(char *string, int croak_on_error) - { - dSP; - SV *sv = newSVpv(string,0); - - PUSHMARK(sp); - perl_eval_sv(sv, G_SCALAR); - SvREFCNT_dec(sv); - - SPAGAIN; - sv = POPs; - PUTBACK; - - if (croak_on_error && SvTRUE(GvSV(errgv))) - croak(SvPV(GvSV(errgv),na)); - - return sv; - } - ... - SV *cvrv = perl_eval("sub { print 'You will not find me cluttering any namespace!' }", TRUE); + SV *cvrv = perl_eval_pv("sub { print 'You will not find me cluttering any namespace!' }", TRUE); ... perl_call_sv(cvrv, G_VOID|G_NOARGS); -L<perl_eval_sv> is used to compile the anonymous subroutine, which can -then be POPed off the stack. Once this code reference is in hand, it +L<perlguts/perl_eval_pv> is used to compile the anonymous subroutine, which +will be the return value as well. Once this code reference is in hand, it can be mixed in with all the previous examples we've shown. =head1 SEE ALSO @@ -1969,4 +1950,4 @@ and Larry Wall. =head1 DATE -Version 1.2, 16th Jan 1996 +Version 1.3, 14th Apr 1997 diff --git a/pod/perldelta.pod b/pod/perldelta.pod index fdd4dde722..b1e11f414b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -291,7 +291,7 @@ the loop, but not beyond it. Note that you still cannot use my() on global punctuation variables such as $_ and the like. -=item unpack() and pack() +=item pack() and unpack() A new format 'w' represents a BER compressed integer (as defined in ASN.1). Its format is a sequence of one or more bytes, each of which @@ -299,6 +299,11 @@ provides seven bits of the total value, with the most significant first. Bit eight of each byte is set, except for the last byte, in which bit eight is clear. +=item sysseek() + +This is a variant of seek() that works on the system file pointer. +It is the only reliable way to seek before sysread() or syswrite(). + =item use VERSION If the first argument to C<use> is a number, it is treated as a version @@ -657,10 +662,14 @@ with Perl 5.003, there are a few exceptions: Module Required Version for Perl 5.004 ------ ------------------------------- - Filter 1.12 - LWP 5.08 + Filter Filter-1.12 + LWP libwww-perl-5.08 Tk Tk400.202 (-w makes noise) +Also, the majordomo mailing list program, version 1.94.1, doesn't work +with Perl 5.004 (nor with perl 4), because it executes an invalid +regular expression. This bug is fixed in majordomo version 1.94.2. + =head2 Installation directories The I<installperl> script now places the Perl source files for @@ -676,9 +685,16 @@ shared libraries. Brand new modules, arranged by topic rather than strictly alphabetically: - CPAN interface to Comprehensive Perl Archive Network - CPAN::FirstTime create a CPAN configuration file - CPAN::Nox run CPAN while avoiding compiled extensions + CGI.pm Web server interface ("Common Gateway Interface") + CGI/Apache.pm Support for Apache's Perl module + CGI/Carp.pm Log server errors with helpful context + CGI/Fast.pm Support for FastCGI (persistent server process) + CGI/Push.pm Support for server push + CGI/Switch.pm Simple interface for multiple server types + + CPAN Interface to Comprehensive Perl Archive Network + CPAN::FirstTime Utility for creating CPAN configuration file + CPAN::Nox Runs CPAN while avoiding compiled extensions IO.pm Top-level interface to IO::* classes IO/File.pm IO::File extension Perl module @@ -887,6 +903,13 @@ C<perl_call_sv> is Perl's producing an "Undefined subroutine called" error on the I<second> call to a given method (since there is no cache on the first call). +=item C<perl_eval_pv> + +A new function handy for eval'ing strings of Perl code inside C code. +This function returns the value from the eval statement, which can +be used instead of fetching globals from the symbol table. See +L<perlguts>, L<perlembed> and L<perlcall> for details and examples. + =item Extended API for manipulating hashes Internal handling of hash keys has changed. The old hashtable API is @@ -1156,12 +1179,6 @@ commas if you don't want them to appear in your data: qw! a b c !; -=item Recursive substitution detected - -(F) The replacement string of a substitution caused the recursive -execution of that very same substituion. Perl cannot keep track of -special variables (C<$1>, etc.) under such circumstances. - =item Scalar value @%s{%s} better written as $%s{%s} (W) You've used a hash slice (indicated by @) to select a single element of diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 080c2a76d7..0152662f8c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1914,12 +1914,6 @@ which is why it's currently left out of your copy. (F) More than 100 levels of inheritance were used. Probably indicates an unintended loop in your inheritance hierarchy. -=item Recursive substitution detected - -(F) The replacement string of a substitution caused the recursive -execution of that very same substituion. Perl cannot keep track of -special variables (C<$1>, etc.) under such circumstances. - =item Reference miscount in sv_replace() (W) The internal sv_replace() function was handed a new SV with a diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 9e3fb5250a..79783a7d30 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -263,57 +263,49 @@ your C program>. =head2 Evaluating a Perl statement from your C program -One way to evaluate pieces of Perl code is to use -L<perlguts/perl_eval_sv()>. We've wrapped this inside our own -I<perl_eval()> function, which converts a command string to an SV, -passing this and the L<perlcall/G_DISCARD> flag to -L<perlguts/perl_eval_sv()>. - -Arguably, this is the only routine you'll ever need to execute -snippets of Perl code from within your C program. Your string can be +Perl provides two API functions to evaluate pieces of Perl code. +These are L<perlguts/perl_eval_sv()> and L<perlguts/perl_eval_pv()>. + +Arguably, these are the only routines you'll ever need to execute +snippets of Perl code from within your C program. Your code can be as long as you wish; it can contain multiple statements; it can employ L<perlfunc/use>, L<perlfunc/require> and L<perlfunc/do> to include external Perl files. -Our I<perl_eval()> lets us evaluate individual Perl strings, and then +I<perl_eval_pv()> lets us evaluate individual Perl strings, and then extract variables for coercion into C types. The following program, I<string.c>, executes three Perl strings, extracting an C<int> from the first, a C<float> from the second, and a C<char *> from the third. #include <EXTERN.h> #include <perl.h> - + static PerlInterpreter *my_perl; - - I32 perl_eval(char *string) - { - return perl_eval_sv(newSVpv(string,0), G_DISCARD); - } - + main (int argc, char **argv, char **env) { - char *embedding[] = { "", "-e", "0" }; - STRLEN length; - - my_perl = perl_alloc(); - perl_construct( my_perl ); - - perl_parse(my_perl, NULL, 3, embedding, NULL); - perl_run(my_perl); - /** Treat $a as an integer **/ - perl_eval("$a = 3; $a **= 2"); - printf("a = %d\n", SvIV(perl_get_sv("a", FALSE))); - - /** Treat $a as a float **/ - perl_eval("$a = 3.14; $a **= 2"); - printf("a = %f\n", SvNV(perl_get_sv("a", FALSE))); - - /** Treat $a as a string **/ - perl_eval("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a); "); - printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), length)); - - perl_destruct(my_perl); - perl_free(my_perl); + char *embedding[] = { "", "-e", "0" }; + + my_perl = perl_alloc(); + perl_construct( my_perl ); + + perl_parse(my_perl, NULL, 3, embedding, NULL); + perl_run(my_perl); + + /** Treat $a as an integer **/ + perl_eval_pv("$a = 3; $a **= 2", TRUE); + printf("a = %d\n", SvIV(perl_get_sv("a", FALSE))); + + /** Treat $a as a float **/ + perl_eval_pv("$a = 3.14; $a **= 2", TRUE); + printf("a = %f\n", SvNV(perl_get_sv("a", FALSE))); + + /** Treat $a as a string **/ + perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE); + printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), na)); + + perl_destruct(my_perl); + perl_free(my_perl); } All of those strange functions with I<sv> in their names help convert Perl scalars to C types. They're described in L<perlguts>. @@ -329,28 +321,10 @@ I<SvPV()> to create a string: In the example above, we've created a global variable to temporarily store the computed value of our eval'd expression. It is also possible and in most cases a better strategy to fetch the return value -from L<perl_eval_sv> instead. Example: - - SV *perl_eval(char *string, int croak_on_error) - { - dSP; - SV *sv = newSVpv(string,0); +from L<perl_eval_pv> instead. Example: - PUSHMARK(sp); - perl_eval_sv(sv, G_SCALAR); - SvREFCNT_dec(sv); - - SPAGAIN; - sv = POPs; - PUTBACK; - - if (croak_on_error && SvTRUE(GvSV(errgv))) - croak(SvPV(GvSV(errgv),na)); - - return sv; - } ... - SV *val = perl_eval("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE); + SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE); printf("%s\n", SvPV(val,na)); ... @@ -359,7 +333,7 @@ variables and we've simplified our code as well. =head2 Performing Perl pattern matches and substitutions from your C program -Our I<perl_eval()> lets us evaluate strings of Perl code, so we can +The I<perl_eval_pv()> function lets us evaluate strings of Perl code, so we can define some functions that use it to "specialize" in matches and substitutions: I<match()>, I<substitute()>, and I<matches()>. @@ -390,10 +364,7 @@ been wrapped here): #include <perl.h> static PerlInterpreter *my_perl; - I32 perl_eval(char *string) - { - return perl_eval_sv(newSVpv(string,0), G_DISCARD); - } + /** match(string, pattern) ** ** Used for matches in a scalar context. @@ -406,7 +377,7 @@ been wrapped here): command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 37); sprintf(command, "$string = '%s'; $return = $string =~ %s", string, pattern); - perl_eval(command); + perl_eval_pv(command, TRUE); free(command); return SvIV(perl_get_sv("return", FALSE)); } @@ -424,7 +395,7 @@ been wrapped here): command = malloc(sizeof(char) * strlen(*string) + strlen(pattern) + 35); sprintf(command, "$string = '%s'; $ret = ($string =~ %s)", *string, pattern); - perl_eval(command); + perl_eval_pv(command, TRUE); free(command); *string = SvPV(perl_get_sv("string", FALSE), length); return SvIV(perl_get_sv("ret", FALSE)); @@ -447,7 +418,7 @@ been wrapped here): command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38); sprintf(command, "$string = '%s'; @array = ($string =~ %s)", string, pattern); - perl_eval(command); + perl_eval_pv(command, TRUE); free(command); array = perl_get_av("array", FALSE); num_matches = av_len(array) + 1; /** assume $[ is 0 **/ @@ -990,7 +961,7 @@ Dov Grobgeld, and Ilya Zakharevich. Check out Doug's article on embedding in Volume 1, Issue 4 of The Perl Journal. Info about TPJ is available from http://tpj.com. -February 1, 1997 +April 14, 1997 Some of this material is excerpted from Jon Orwant's book: I<Perl 5 Interactive>, Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 84a794adb2..cba3f2a35f 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2582,7 +2582,12 @@ call of stdio. FILEHANDLE may be an expression whose value gives the name of the filehandle. The values for WHENCE are 0 to set the file pointer to POSITION, 1 to set the it to current plus POSITION, and 2 to set it to EOF plus offset. You may use the values SEEK_SET, SEEK_CUR, and SEEK_END for -this from the POSIX module. Returns 1 upon success, 0 otherwise. +this from either the IO::Seekable or the POSIX module. Returns 1 upon +success, 0 otherwise. + +If you want to position a file pointer for sysread() or syswrite(), don't +use seek() -- buffering makes its effect on the system file pointer +unpredictable and non-portable. Use sysseek() instead. On some systems you have to do a seek whenever you switch between reading and writing. Amongst other things, this may have the effect of calling @@ -3326,10 +3331,10 @@ into that kind of thing. Attempts to read LENGTH bytes of data into variable SCALAR from the specified FILEHANDLE, using the system call read(2). It bypasses -stdio, so mixing this with other kinds of reads may cause confusion. -Returns the number of bytes actually read, or undef if there was an -error. SCALAR will be grown or shrunk so that the last byte actually -read is the last byte of the scalar after the read. +stdio, so mixing this with other kinds of reads or with seek() may +cause confusion. Returns the number of bytes actually read, or undef +if there was an error. SCALAR will be grown or shrunk so that the +last byte actually read is the last byte of the scalar after the read. An OFFSET may be specified to place the read data at some place in the string other than the beginning. A negative OFFSET specifies @@ -3338,6 +3343,17 @@ string. A positive OFFSET greater than the length of SCALAR results in the string being padded to the required size with "\0" bytes before the result of the read is appended. +=item sysseek FILEHANDLE,POSITION,WHENCE + +Randomly positions the system file pointer for FILEHANDLE using the +system call lseek(2). It bypasses stdio, so mixing this with read(), +print(), write(), or seek() may cause confusion. FILEHANDLE may be an +expression whose value gives the name of the filehandle. The values for +WHENCE are 0 to set the file pointer to POSITION, 1 to set the it to +current plus POSITION, and 2 to set it to EOF plus offset. You may use +the values SEEK_SET, SEEK_CUR, and SEEK_END for this from either the +IO::Seekable or the POSIX module. Returns 1 upon success, 0 otherwise. + =item system LIST Does exactly the same thing as "exec LIST" except that a fork is done @@ -3388,10 +3404,10 @@ signals and core dumps. Attempts to write LENGTH bytes of data from variable SCALAR to the specified FILEHANDLE, using the system call write(2). It bypasses -stdio, so mixing this with prints may cause confusion. Returns the -number of bytes actually written, or undef if there was an error. -If the length is greater than the available data, only as much data as -is available will be written. +stdio, so mixing this with prints or with seek() may cause confusion. +Returns the number of bytes actually written, or undef if there was an +error. If the length is greater than the available data, only as much +data as is available will be written. An OFFSET may be specified to write the data from some part of the string other than the beginning. A negative OFFSET specifies writing diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 382c6c2e00..7b4e4c718b 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1960,6 +1960,12 @@ Tells Perl to C<eval> the string in the SV. I32 perl_eval_sv _((SV* sv, I32 flags)); +=item perl_eval_pv + +Tells Perl to C<eval> the given string and return an SV* result. + + SV* perl_eval_pv _((char* p, I32 croak_on_error)); + =item perl_free Releases a Perl interpreter. See L<perlembed>. @@ -2930,4 +2936,4 @@ API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.5: 1997/4/1 +Version 31.6: 1997/4/14 diff --git a/pod/perlop.pod b/pod/perlop.pod index 3bd4f21511..3734477ecf 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -27,7 +27,7 @@ operate on scalar values only, not array values. left | ^ left && left || - nonassoc .. + nonassoc .. ... right ?: right = += -= *= etc. left , => @@ -722,7 +722,7 @@ beginning. Examples: print "$sentences\n"; # using m//g with \G - $_ = "ppooqppq"; + $_ = "ppooqppqq"; while ($i++ < 2) { print "1: '"; print $1 while /(o)/g; print "', pos=", pos, "\n"; @@ -735,14 +735,11 @@ beginning. Examples: The last example should print: 1: 'oo', pos=4 - 2: 'q', pos=4 + 2: 'q', pos=5 3: 'pp', pos=7 1: '', pos=7 - 2: 'q', pos=7 - 3: '', pos=7 - -Note how C<m//g> matches change the value reported by C<pos()>, but the -non-global match doesn't. + 2: 'q', pos=8 + 3: '', pos=8 A useful idiom for C<lex>-like scanners is C</\G.../g>. You can combine several regexps like this to process a string part-by-part, diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 858d783ea2..ef59edbc9b 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -860,10 +860,10 @@ $^E, $^H, $^M =item New and changed builtin functions delete on slices, flock, printf and sprintf, keys as an lvalue, my() in -Control Structures, unpack() and pack(), use VERSION, use Module VERSION -LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not reset -search position on failure, C<m//x> ignores whitespace before ?*+{}, nested -C<sub{}> closures work now, formats work right on changing lexicals +Control Structures, pack() and unpack(), sysseek(), use VERSION, use Module +VERSION LIST, prototype(FUNCTION), srand, $_ as Default, C<m//g> does not +reset search position on failure, C<m//x> ignores whitespace before ?*+{}, +nested C<sub{}> closures work now, formats work right on changing lexicals =item New builtin methods @@ -925,7 +925,8 @@ C<void> XSUBs now default to returning nothing =item C Language API Changes -C<gv_fetchmethod> and C<perl_call_sv>, Extended API for manipulating hashes +C<gv_fetchmethod> and C<perl_call_sv>, C<perl_eval_pv>, Extended API for +manipulating hashes =item Documentation Changes @@ -947,16 +948,15 @@ number, Integer overflow in octal number, internal error: glob failed, Name "%s::%s" used only once: possible typo, Null picture in formline, Offset outside string, Out of memory!, Out of memory during request for %s, Possible attempt to put comments in qw() list, Possible attempt to separate -words with commas, Recursive substitution detected, Scalar value @%s{%s} -better written as $%s{%s}, Stub found while resolving method `%s' -overloading `%s' in package `%s', Too late for "B<-T>" option, untie -attempted while %d inner references still exist, Unrecognized character %s, -Unsupported function fork, Use of "$$<digit>" to mean "${$}<digit>" is -deprecated, Value of %s can be "0"; test with defined(), Variable "%s" may -be unavailable, Variable "%s" will not stay shared, Warning: something's -wrong, Ill-formed logical name |%s| in prime_env_iter, Got an error from -DosAllocMem, Malformed PERLLIB_PREFIX, PERL_SH_DIR too long, Process -terminated by SIG%s +words with commas, Scalar value @%s{%s} better written as $%s{%s}, Stub +found while resolving method `%s' overloading `%s' in package `%s', Too +late for "B<-T>" option, untie attempted while %d inner references still +exist, Unrecognized character %s, Unsupported function fork, Use of +"$$<digit>" to mean "${$}<digit>" is deprecated, Value of %s can be "0"; +test with defined(), Variable "%s" may be unavailable, Variable "%s" will +not stay shared, Warning: something's wrong, Ill-formed logical name |%s| +in prime_env_iter, Got an error from DosAllocMem, Malformed PERLLIB_PREFIX, +PERL_SH_DIR too long, Process terminated by SIG%s =item BUGS @@ -1220,16 +1220,16 @@ srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, study, sub BLOCK, sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, sysopen FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, sysread -FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, system -LIST, syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite -FILEHANDLE,SCALAR,LENGTH, tell FILEHANDLE, tell, telldir DIRHANDLE, tie -VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate -FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, -ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack -TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module LIST, use -Module, use Module VERSION LIST, use VERSION, utime LIST, values HASH, vec -EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn LIST, write -FILEHANDLE, write EXPR, write, y/// +FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, sysseek +FILEHANDLE,POSITION,WHENCE, system LIST, syswrite +FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite FILEHANDLE,SCALAR,LENGTH, tell +FILEHANDLE, tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied +VARIABLE, time, times, tr///, truncate FILEHANDLE,LENGTH, truncate +EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef +EXPR, undef, unlink LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE, +unshift ARRAY,LIST, use Module LIST, use Module, use Module VERSION LIST, +use VERSION, utime LIST, values HASH, vec EXPR,OFFSET,BITS, wait, waitpid +PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y/// =back @@ -2339,8 +2339,8 @@ mg_get, mg_len, mg_magical, mg_set, Move, na, New, Newc, Newz, newAV, newHV, newRV_inc, newRV_noinc, newSV, newSViv, newSVnv, newSVpv, newSVrv, newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc, perl_call_argv, perl_call_method, perl_call_pv, -perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, perl_free, -perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse, +perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv, +perl_free, perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse, perl_require_pv, perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi, PUSHn, PUSHp, PUSHs, PUTBACK, Renew, Renewc, RETVAL, safefree, safemalloc, saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE, @@ -2962,7 +2962,9 @@ Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu), Stephen Dahmen =item DESCRIPTION -=item NOTE +=item NOTE 1 + +=item NOTE 2 =item SEE ALSO @@ -818,7 +818,8 @@ PP(pp_match) } if (!rx->nparens && !global) gimme = G_SCALAR; /* accidental array context? */ - safebase = (((gimme == G_ARRAY) || global) && !sawampersand); + safebase = (((gimme == G_ARRAY) || global || !rx->nparens) + && !sawampersand); if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); multiline = pm->op_pmflags & PMf_MULTILINE; @@ -1387,13 +1388,6 @@ PP(pp_iter) RETPUSHYES; } -static void -leave_subst(p) -void *p; -{ - ((PMOP*)p)->op_private &= ~OPpLVAL_INTRO; -} - PP(pp_subst) { dSP; dTARG; @@ -1435,13 +1429,6 @@ PP(pp_subst) force_on_match = 1; TAINT_NOT; - if (pm->op_private & OPpLVAL_INTRO) - croak("Recursive substitution detected"); - if (!dstr) { - SAVEDESTRUCTOR(leave_subst, pm); - pm->op_private |= OPpLVAL_INTRO; - } - force_it: if (!pm || !s) DIE("panic: do_subst"); @@ -1498,7 +1485,7 @@ PP(pp_subst) c = dstr ? SvPV(dstr, clen) : Nullch; /* can do inplace substitution? */ - if (c && clen <= rx->minlen) { + if (c && clen <= rx->minlen && safebase) { if (! pregexec(rx, s, strend, orig, 0, SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { PUSHs(&sv_no); @@ -1510,8 +1497,6 @@ PP(pp_subst) s = SvPV_force(TARG, len); goto force_it; } - if (rx->subbase) /* oops, no we can't */ - goto long_way; d = s; curpm = pm; SvSCREAM_off(TARG); /* disable possible screamer */ @@ -1592,7 +1577,6 @@ PP(pp_subst) if (pregexec(rx, s, strend, orig, 0, SvSCREAM(TARG) ? TARG : Nullsv, safebase)) { - long_way: if (force_on_match) { force_on_match = 0; s = SvPV_force(TARG, len); @@ -91,7 +91,7 @@ extern int h_errno; /* Put this after #includes because <unistd.h> defines _XOPEN_*. */ #ifndef Sock_size_t -# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) # define Sock_size_t Size_t # else # define Sock_size_t int @@ -1162,7 +1162,9 @@ PP(pp_sysread) MAGIC *mg; gv = (GV*)*++MARK; - if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (op->op_type == OP_READ && + SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) + { SV *sv; PUSHMARK(MARK-1); @@ -1368,6 +1370,11 @@ PP(pp_tell) PP(pp_seek) { + return pp_sysseek(ARGS); +} + +PP(pp_sysseek) +{ dSP; GV *gv; int whence = POPi; @@ -333,6 +333,7 @@ I32 perl_call_pv _((char* subname, I32 flags)); I32 perl_call_sv _((SV* sv, I32 flags)); void perl_construct _((PerlInterpreter* sv_interp)); void perl_destruct _((PerlInterpreter* sv_interp)); +SV* perl_eval_pv _((char* p, I32 croak_on_error)); I32 perl_eval_sv _((SV* sv, I32 flags)); void perl_free _((PerlInterpreter* sv_interp)); SV* perl_get_sv _((char* name, I32 create)); @@ -529,18 +529,26 @@ got_it: prog->exec_tainted = regtainted; /* make sure $`, $&, $', and $digit will work later */ - if (!safebase && (strbeg != prog->subbase)) { - I32 i = strend - startpos + (stringarg - strbeg); - s = savepvn(strbeg, i); - Safefree(prog->subbase); - prog->subbase = s; - prog->subbeg = prog->subbase; - prog->subend = prog->subbase + i; - s = prog->subbase + (stringarg - strbeg); - for (i = 0; i <= prog->nparens; i++) { - if (prog->endp[i]) { - prog->startp[i] = s + (prog->startp[i] - startpos); - prog->endp[i] = s + (prog->endp[i] - startpos); + if (strbeg != prog->subbase) { + if (safebase) { + if (prog->subbase) { + Safefree(prog->subbase); + prog->subbase = Nullch; + } + } + else { + I32 i = strend - startpos + (stringarg - strbeg); + s = savepvn(strbeg, i); + Safefree(prog->subbase); + prog->subbase = s; + prog->subbeg = prog->subbase; + prog->subend = prog->subbase + i; + s = prog->subbase + (stringarg - strbeg); + for (i = 0; i <= prog->nparens; i++) { + if (prog->endp[i]) { + prog->startp[i] = s + (prog->startp[i] - startpos); + prog->endp[i] = s + (prog->endp[i] - startpos); + } } } } diff --git a/t/op/sysio.t b/t/op/sysio.t index ee274c1692..f2e72cfb6b 100755 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -1,6 +1,6 @@ #!./perl -print "1..30\n"; +print "1..32\n"; chdir('op') || die "sysio.t: cannot look for myself: $!"; @@ -164,6 +164,18 @@ print "ok 29\n"; print 'not ' unless ($b eq '#!ererl'); print "ok 30\n"; +# test sysseek + +sysseek(I, 2, 0); +sysread(I, $b, 3); +print 'not ' unless $b eq 'ere'; +print "ok 31\n"; + +sysseek(I, -2, 1); +sysread(I, $b, 4); +print 'not ' unless $b eq 'rerl'; +print "ok 32\n"; + close(I); unlink $outfile; @@ -3533,6 +3533,9 @@ yylex() case KEY_sysread: LOP(OP_SYSREAD,XTERM); + case KEY_sysseek: + LOP(OP_SYSSEEK,XTERM); + case KEY_syswrite: LOP(OP_SYSWRITE,XTERM); @@ -4180,10 +4183,11 @@ I32 len; if (strEQ(d,"system")) return -KEY_system; break; case 7: - if (strEQ(d,"sysopen")) return -KEY_sysopen; - if (strEQ(d,"sysread")) return -KEY_sysread; if (strEQ(d,"symlink")) return -KEY_symlink; if (strEQ(d,"syscall")) return -KEY_syscall; + if (strEQ(d,"sysopen")) return -KEY_sysopen; + if (strEQ(d,"sysread")) return -KEY_sysread; + if (strEQ(d,"sysseek")) return -KEY_sysseek; break; case 8: if (strEQ(d,"syswrite")) return -KEY_syswrite; diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 9ac6fb4315..23acde403e 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -49,7 +49,7 @@ use strict; sub paraprint; -my($Version) = "1.16"; +my($Version) = "1.17"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -68,6 +68,7 @@ my($Version) = "1.16"; # Changed in 1.15 to add warnings to stop people using perlbug for non-bugs. # Also report selected environment variables. # Changed in 1.16 to include @INC, and allow user to re-edit if no changes. +# Changed in 1.17 Win32 support added. GSAR 97-04-12 # TODO: Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -75,7 +76,7 @@ my($Version) = "1.16"; my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $subject, $from, $verbose, $ed, - $fh, $me, $Is_VMS, $msg, $body, $andcc, %REP); + $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP); Init(); @@ -102,6 +103,7 @@ sub Init { # -------- Setup -------- + $Is_MSWin32 = $^O eq 'MSWin32'; $Is_VMS = $^O eq 'VMS'; getopts("dhva:s:b:f:r:e:SCc:t"); @@ -149,12 +151,12 @@ sub Init { # Editor $ed = ( $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || - ($Is_VMS ? "edit/tpu" : "vi") + ($Is_VMS ? "edit/tpu" : $Is_MSWin32 ? "notepad" : "vi") ); # My username - $me = getpwuid($<); + $me = ($Is_MSWin32 ? $ENV{'USERNAME'} : getpwuid($<)); } @@ -212,6 +214,8 @@ EOF if($::HaveUtil) { $domain = Mail::Util::maildomain(); + } elsif ($Is_MSWin32) { + $domain = $ENV{'USERDOMAIN'}; } elsif ($Is_VMS) { require Sys::Hostname; $domain = Sys::Hostname::hostname(); @@ -345,7 +349,8 @@ EOF # Generate scratch file to edit report in { - my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/'; + my($dir) = ($Is_VMS ? 'sys$scratch:' : + ($Is_MSWin32 and $ENV{'TEMP'} ? $ENV{'TEMP'} : '/tmp/')); $filename = "bugrep0$$"; $filename++ while -e "$dir$filename"; $filename = "$dir$filename"; diff --git a/utils/perldoc.PL b/utils/perldoc.PL index feb1366ec4..129d985882 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -57,6 +57,7 @@ EOF use Getopt::Std; $Is_VMS = $^O eq 'VMS'; +$Is_MSWin32 = $^O eq 'MSWin32'; sub usage{ warn "@_\n" if @_; @@ -67,12 +68,13 @@ perldoc [options] PageName|ModuleName|ProgramName... perldoc [options] -f BuiltinFunction Options: - -h Display this help message. - -t Display pod using pod2text instead of pod2man and nroff. + -h Display this help message + -t Display pod using pod2text instead of pod2man and nroff + (-t is the default on win32) -u Display unformatted pod text -m Display modules file in its entirety -l Display the modules file name - -v Verbosely describe what's going on. + -v Verbosely describe what's going on PageName|ModuleName... is the name of a piece of documentation that you want to look at. You @@ -100,7 +102,11 @@ getopts("mhtluvf:") || usage; usage if $opt_h || $opt_h; # avoid -w warning -usage("only one of -t, -u, -m or -l") if $opt_t + $opt_u + $opt_m + $opt_l > 1; +if ($opt_t + $opt_u + $opt_m + $opt_l > 1) { + usage("only one of -t, -u, -m or -l") +} elsif ($Is_MSWin32) { + $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l; +} if ($opt_t) { require Pod::Text; import Pod::Text; } @@ -132,7 +138,7 @@ sub containspod { local($")="/"; my(@p,$p,$cip); foreach $p (split(/\//, $file)){ - if (($Is_VMS or $^O eq 'os2') and not scalar @p) { + if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) { # VMSish filesystems don't begin at '/' push(@p,$p); next; @@ -176,8 +182,10 @@ sub containspod { if (( $ret = minus_f_nocase "$dir/$s.pod") or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret)) or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret)) - or ( $Is_VMS and + or ( $Is_VMS and $ret = minus_f_nocase "$dir/$s.com" and containspod($ret)) + or ( $Is_MSWin32 and + $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret)) or ( $ret = minus_f_nocase "$dir/pod/$s.pod") or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret))) { return $ret; } @@ -207,6 +215,8 @@ foreach (@pages) { for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) { push(@searchdirs,$trn); } + } elsif ($Is_MSWin32) { + push(@searchdirs, grep(-d, split(';', $ENV{'PATH'}))); } else { push(@searchdirs, grep(-d, split(':', $ENV{'PATH'}))); } @@ -241,13 +251,17 @@ if ($opt_l) { if( ! -t STDOUT ) { $no_tty = 1 } -unless($Is_VMS) { - $tmp = "/tmp/perldoc1.$$"; - push @pagers, qw( more less pg view cat ); +if ($Is_MSWin32) { + $tmp = "$ENV{TEMP}\\perldoc1.$$"; + push @pagers, qw( more< less notepad ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; -} else { +} elsif ($Is_VMS) { $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$; push @pagers, qw( most more less type/page ); +} else { + $tmp = "/tmp/perldoc1.$$"; + push @pagers, qw( more less pg view cat ); + unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER}; @@ -428,6 +442,9 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu> =cut # +# Version 1.12: Sat Apr 12 22:41:09 EST 1997 +# Gurusamy Sarathy <gsar@umich.edu> +# -various fixes for win32 # Version 1.11: Tue Dec 26 09:54:33 EST 1995 # Kenneth Albanowski <kjahds@kjahds.com> # -added Charles Bailey's further VMS patches, and -u switch diff --git a/win32/Makefile b/win32/Makefile index 3da20e77aa..0e7068fa6d 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -5,25 +5,81 @@ # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. # -# There's no support for building an all-static perl yet. -# Doesn't build any of the stuff in ..\utils yet. -# No support for installing documentation, uh, yet. + +# +# Set these to wherever you want "nmake install" to put your +# newly built perl. # +INST_DRV=c: +INST_TOP=$(INST_DRV)\perl + + +##################### CHANGE THESE ONLY IF YOU MUST ##################### + +# +# Programs to compile, build .lib files and link +# +CC=cl.exe +LINK32=link.exe +LIB32=$(LINK32) -lib # -# Set this to wherever you want "nmake install" to put your -# newly built perl. If you change this, you better change -# all occurrences of this prefix in $(INST_TOP)\lib\Config.pm -# as well. +# Options +# +PERLDLL = -D "PERLDLL" +RUNTIME = -MD +INCLUDES = -I ".\include" -I "." -I ".." +#PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX +DEFINES = -D "WIN32" -D "_CONSOLE" -D "PERLDLL" +SUBSYS = console +LIBFILES = kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib \ + advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib + +!IF "$(RUNTIME)" == "-MD" +WINIOMAYBE = +!ELSE +WINIOMAYBE = win32io.obj +!ENDIF + +!IF "$(CFG)" == "Debug" +! IF "$(CCTYPE)" == "MSVC20" +OPTIMIZE = -Od $(RUNTIME) -Z7 -D "_DEBUG" +! ELSE +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D "_DEBUG" +! ENDIF +LINK_DBG = -pdb:$(*B).pdb +!ELSE +! IF "$(CCTYPE)" == "MSVC20" +OPTIMIZE = -Od $(RUNTIME) -D "NDEBUG" +! ELSE +OPTIMIZE = -O2 $(RUNTIME) -D "NDEBUG" +! ENDIF +LINK_DBG = -release +!ENDIF -INST_TOP=C:\perl +CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386 + +#################### do not edit below this line ####################### +############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## + +# +# Rules +# +.SUFFIXES : +.SUFFIXES : .c .obj .dll .lib .exe + +.c.obj: + $(CC) -c $(CFLAGS) -Fo$@ $< + +.obj.dll: + $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def -out:$@ $(LINK_FLAGS) $< $(LIBPERL) -#################### do not edit below this line ######################## # INST_BIN=$(INST_TOP)\bin INST_LIB=$(INST_TOP)\lib -INST_POD=$(INST_TOP)\pod +INST_POD=$(INST_LIB)\pod INST_HTML=$(INST_POD)\html LIBDIR=..\lib EXTDIR=..\ext @@ -32,25 +88,24 @@ EXTUTILSDIR=$(LIBDIR)\extutils # # various targets -PERLLIB=..\libperl.lib PERLIMPLIB=..\perl.lib MINIPERL=..\miniperl.exe PERLDLL=..\perl.dll PERLEXE=..\perl.exe GLOBEXE=..\perlglob.exe +CONFIGPM=..\lib\Config.pm PL2BAT=bin\PL2BAT.BAT -MAKE=nmake /nologo +MAKE=nmake -nologo XCOPY=xcopy /i /d /f /r NULL= # # filenames given to xsubpp must have forward slashes (since it puts # full pathnames in #line strings) -XSUBPP=..\$(MINIPERL) ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes +XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes -CORE_C= \ - ..\av.c \ +CORE_C= ..\av.c \ ..\deb.c \ ..\doio.c \ ..\doop.c \ @@ -77,6 +132,78 @@ CORE_C= \ ..\universal.c \ ..\util.c +CORE_OBJ=..\av.obj \ + ..\deb.obj \ + ..\doio.obj \ + ..\doop.obj \ + ..\dump.obj \ + ..\globals.obj \ + ..\gv.obj \ + ..\hv.obj \ + ..\mg.obj \ + ..\op.obj \ + ..\perl.obj \ + ..\perlio.obj \ + ..\perly.obj \ + ..\pp.obj \ + ..\pp_ctl.obj \ + ..\pp_hot.obj \ + ..\pp_sys.obj \ + ..\regcomp.obj \ + ..\regexec.obj \ + ..\run.obj \ + ..\scope.obj \ + ..\sv.obj \ + ..\taint.obj \ + ..\toke.obj \ + ..\universal.obj \ + ..\util.obj + +WIN32_C = perllib.c \ + win32.c \ + win32io.c \ + win32sck.c \ + +WIN32_OBJ = win32.obj \ + win32io.obj \ + win32sck.obj \ + +DLL_OBJ = perllib.obj $(DYNALOADER).obj + +CORE_H = "..\av.h"\ + "..\cop.h"\ + "..\cv.h"\ + "..\dosish.h"\ + "..\embed.h"\ + "..\form.h"\ + "..\gv.h"\ + "..\handy.h"\ + "..\hv.h"\ + "..\mg.h"\ + "..\nostdio.h"\ + "..\op.h"\ + "..\opcode.h"\ + "..\perl.h"\ + "..\perlio.h"\ + "..\perlsdio.h"\ + "..\perlsfio.h"\ + "..\perly.h"\ + "..\pp.h"\ + "..\proto.h"\ + "..\regexp.h"\ + "..\scope.h"\ + "..\sv.h"\ + "..\unixish.h"\ + "..\util.h"\ + "..\XSUB.h"\ + ".\config.h"\ + "..\EXTERN.h"\ + ".\include\dirent.h"\ + ".\include\netdb.h"\ + ".\include\sys\socket.h"\ + ".\win32.h" + + EXTENSIONS=DynaLoader Socket IO Fcntl Opcode SDBM_File DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader @@ -105,54 +232,72 @@ POD2MAN=$(PODDIR)\pod2man POD2LATEX=$(PODDIR)\pod2latex POD2TEXT=$(PODDIR)\pod2text -ALL: $(PERLEXE) $(GLOBEXE) $(DYNALOADMODULES) +# +# Top targets +# -!IF "$(CFG)" =="" -CFG=Release -!ENDIF +ALL: $(PERLEXE) $(GLOBEXE) $(DYNALOADMODULES) -modules.lib : $(DYNALOADER).c - $(MAKE) -A -f modules.mak CFG="modules - Win32 $(CFG)" +$(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c -$(GLOBEXE): - $(MAKE) -f perlglob.mak CFG="perlglob - Win32 Release" +#------------------------------------------------------------ -$(PERLLIB): $(CORE_C) - $(MAKE) -f libperl.mak CFG="libperl - Win32 $(CFG)" +$(GLOBEXE): perlglob.obj + $(LINK32) $(LINK_FLAGS) -out:$@ -subsystem:$(SUBSYS) perlglob.obj setargv.obj -$(MINIPERL): $(PERLLIB) - $(MAKE) -A -f miniperl.mak CFG="miniperl - Win32 $(CFG)" - copy config.w32 ..\config.sh - cd .. - miniperl configpm - cd win32 +perlglob.obj : perlglob.c + +..\miniperlmain.obj : ..\miniperlmain.c $(CORE_H) + +..\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" config.w32 > ..\config.sh + +$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL + cd .. && miniperl configpm if exist lib\* $(XCOPY) /e lib\*.* ..\lib\$(NULL) - copy bin\test.bat ..\t + $(XCOPY) ..\*.h ..\lib\CORE\*.* + $(XCOPY) *.h ..\lib\CORE\*.* + $(XCOPY) /S include ..\lib\CORE\*.* + $(MINIPERL) -I..\lib config_h.PL || $(MAKE) RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) + +$(MINIPERL) : ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ) + $(LINK32) -subsystem:console -out:$@ @<< + $(LINK_FLAGS) ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ) +<< + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) -$(PERLDLL): $(MINIPERL) $(PERLLIB) +perldll.def : $(MINIPERL) $(CONFIGPM) $(MINIPERL) -w makedef.pl > perldll.def - $(MAKE) -A -f perldll.mak CFG="perldll - Win32 $(CFG)" -$(PERLEXE): $(MINIPERL) modules.lib $(PERLDLL) -# $(MINIPERL) makemain.pl $(STATICLINKMODUES) > perlmain.c -# $(MINIPERL) makeperldef.pl $(STATICLINKMODUES) > perl.def - $(MINIPERL) makeperldef.pl $(NULL) > perl.def +$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) + $(LINK32) -dll -def:perldll.def -out:$@ @<< + $(LINK_FLAGS) $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +<< + $(XCOPY) $(PERLIMPLIB) ..\lib\CORE + +perl.def : $(MINIPERL) makeperldef.pl + $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def + +perlmain.c : runperl.c copy runperl.c perlmain.c - $(MAKE) -A -f perl.mak CFG="perl - Win32 $(CFG)" - copy ..\_perl.exe $(PERLEXE) - del ..\_perl.exe - del ..\*.exp + +perlmain.obj : perlmain.c + $(CC) $(CFLAGS) -U "PERLDLL" -c perlmain.c + +$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj + $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB) + copy perl.exe $@ + del perl.exe copy splittree.pl .. - $(MINIPERL) ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" attrib -r ..\t\*.* copy test ..\t - $(XCOPY) ..\*.h ..\lib\CORE\*.* - $(XCOPY) $(PERLIMPLIB) ..\lib\CORE - $(XCOPY) $(PERLLIB) ..\lib\CORE - $(XCOPY) *.h ..\lib\CORE - $(XCOPY) /S include ..\lib\CORE -$(DYNALOADER).c: $(EXTDIR)\DynaLoader\dl_win32.xs +$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist ..\lib\auto md ..\lib\auto $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) @@ -162,67 +307,40 @@ $(DYNALOADER).c: $(EXTDIR)\DynaLoader\dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs -$(SOCKET).c: $(SOCKET).xs - if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) - $(MINIPERL) genxsdef.pl $(*B) > $(*B).def - $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) +$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs cd $(EXTDIR)\$(*B) - $(XSUBPP) $(*B).xs > $(*B).c + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) cd ..\..\win32 -$(IO).c: $(IO).xs - if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) - $(MINIPERL) genxsdef.pl $(*B) > $(*B).def - $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) - $(XCOPY) /s $(EXTDIR)\$(*B)\lib\*.* $(LIBDIR) +$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs cd $(EXTDIR)\$(*B) - $(XSUBPP) $(*B).xs > $(*B).c + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) cd ..\..\win32 -$(SDBM_FILE).c: $(SDBM_FILE).xs - if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) - $(MINIPERL) genxsdef.pl $(*B) > $(*B).def - $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) +$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs cd $(EXTDIR)\$(*B) - $(XSUBPP) -typemap ./typemap $(*B).xs > $(*B).c + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) cd ..\..\win32 -$(FCNTL).c: $(FCNTL).xs - if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) - $(MINIPERL) genxsdef.pl $(*B) > $(*B).def - $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) +$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs cd $(EXTDIR)\$(*B) - $(XSUBPP) $(*B).xs > $(*B).c + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) cd ..\..\win32 -$(OPCODE).c: $(OPCODE).xs - if not exist ..\lib\auto\$(*B) md ..\lib\auto\$(*B) - $(MINIPERL) genxsdef.pl $(*B) > $(*B).def - $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) - $(XCOPY) $(EXTDIR)\$(*B)\*.pm $(LIBDIR)\$(NULL) +$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) cd $(EXTDIR)\$(*B) - $(XSUBPP) $(*B).xs > $(*B).c + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) cd ..\..\win32 -$(SOCKET_DLL): $(SOCKET).c $(PERLDLL) - $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" - -$(IO_DLL): $(IO).c $(PERLDLL) - $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" - -$(SDBM_FILE_DLL): $(SDBM_FILE).c $(PERLDLL) - $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" - -$(FCNTL_DLL): $(FCNTL).c $(PERLDLL) - $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" - -$(OPCODE_DLL): $(OPCODE).c $(PERLDLL) - $(MAKE) -f $(*B).mak CFG="$(*B) - Win32 $(CFG)" - doc: $(PERLEXE) - cd $(PODDIR) - nmake -f ../win32/pod.mak - cd ..\win32 + cd $(PODDIR) + nmake -f ../win32/pod.mak + cd ..\win32 utils: $(PERLEXE) cd ..\utils @@ -232,9 +350,9 @@ utils: $(PERLEXE) $(XCOPY) *.bat ..\win32\bin\*.* cd ..\win32 -distclean: - -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) $(PERLLIB) \ - $(PERLIMPLIB) ..\miniperl.lib modules.lib +distclean: clean + -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ + $(PERLIMPLIB) ..\miniperl.lib -del /f *.def -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ $(OPCODE_DLL) @@ -244,7 +362,6 @@ distclean: -del /f $(PODDIR)\*.bat -rmdir /s /q ..\lib\auto -rmdir /s /q ..\lib\CORE - -rmdir /s /q release -rmdir /s /q debug install : ALL doc utils @@ -259,15 +376,41 @@ install : ALL doc utils $(XCOPY) ..\pod\*.pod $(INST_POD)\*.* $(XCOPY) ..\pod\*.html $(INST_HTML)\*.* -inst_lib : +inst_lib : $(CONFIGPM) copy splittree.pl .. - $(MINIPERL) ..\splittree.pl "../LIB" "../LIB/auto" + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" $(XCOPY) /e ..\lib $(INST_LIB)\*.* +minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) + $(XCOPY) $(MINIPERL) ..\t\perl.exe + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) + attrib -r ..\t\*.* + copy test ..\t + cd ..\t + $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t + cd ..\win32 + test : all $(XCOPY) $(PERLEXE) ..\t\$(NULL) $(XCOPY) $(PERLDLL) ..\t\$(NULL) $(XCOPY) $(GLOBEXE) ..\t\$(NULL) - cd ..\t - $(PERLEXE) test + cd ..\t + $(PERLEXE) -I..\lib harness cd ..\win32 + +clean : + -@erase miniperlmain.obj + -@erase $(MINIPERL) + -@erase perlglob.obj + -@erase perlmain.obj + -@erase $(GLOBEXE) + -@erase $(PERLEXE) + -@erase $(PERLDLL) + -@erase $(CORE_OBJ) + -@erase $(WIN32_OBJ) + -@erase $(DLL_OBJ) + -@erase ..\*.obj *.obj ..\*.lib ..\*.exp + -@erase *.ilk + -@erase *.pdb + + diff --git a/win32/TEST b/win32/TEST index a7e074ed9c..1bda4ef793 100644 --- a/win32/TEST +++ b/win32/TEST @@ -33,6 +33,10 @@ if ($ARGV[0] eq '') { grep( s/.*t\\//, @ARGV ); # @ARGV = split(/[ \n]/, # `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); +} else { + +@ARGV = map(glob($_),@ARGV); + } if ($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'qnx' || 1) { diff --git a/win32/config.H b/win32/config.H index fc70d4dd47..37b50a5efd 100644 --- a/win32/config.H +++ b/win32/config.H @@ -1,6 +1,7 @@ /* - * This file was produced by running the config_h.SH script, on a UNIX machine - * with config.sh set to conif.w32 from this directory + * This file was produced by running the config_h.SH script, which + * gets its values from config.sh, which is generally produced by + * running Configure. * * Feel free to modify any of this as the need arises. Note, however, * that running config_h.SH again will wipe out any changes you've made. @@ -1412,11 +1413,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* This added by hand */ -#define APPLLIB_EXP (win32PerlLibPath()) - #define ARCHLIB "C:\\perl\\lib" /**/ -/* #define ARCHLIB_EXP "C:\\perl\\lib" /**/ +#define ARCHLIB_EXP "C:\\perl\\lib" /**/ /* BINCOMPAT3: * This symbol, if defined, indicates that Perl 5.004 should be @@ -1672,7 +1670,7 @@ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as * D:/bin/sh.exe. */ -#define SH_PATH "/bin/sh" /**/ +#define SH_PATH "cmd /c" /**/ /* SIG_NAME: * This symbol contains a list of signal names in order of @@ -1719,7 +1717,7 @@ * in programs that are not prepared to deal with ~ expansion at run-time. */ #define SITEARCH "C:\\perl\\lib\\site" /**/ -/* #define SITEARCH_EXP "C:\\perl\\lib\\site" /**/ +#define SITEARCH_EXP "C:\\perl\\lib\\site" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1776,7 +1774,8 @@ #define M_VOID /* Xenix strikes again */ #endif +#endif #include <win32.h> +#define ARCHLIBEXP (win32PerlLibPath()) #define DEBUGGING #define MULTIPLCITY -#endif diff --git a/win32/config.w32 b/win32/config.w32 index cadbdfa80f..95697fca50 100644 --- a/win32/config.w32 +++ b/win32/config.w32 @@ -5,22 +5,22 @@ ## Target system: WIN32 # -archlibexp='C:\perl\lib' +archlibexp='~INST_TOP~\lib' archname='MSWin32' cc='cl' -ccflags='' -cppflags='' +ccflags='-MD -DWIN32' +cppflags='-DWIN32' dlsrc='dl_win32.xs' dynamic_ext='Fcntl IO Opcode SDBM_File Socket' extensions='Fcntl IO Opcode SDBM_File Socket' -installarchlib='C:\perl\lib' -installprivlib='C:\perl\lib' +installarchlib='~INST_TOP~\lib' +installprivlib='~INST_TOP~\lib' libpth='' libs='' osname='MSWin32' osvers='4.0' -prefix='C:' -privlibexp='C:\perl\lib' +prefix='~INST_DRV~' +privlibexp='~INST_TOP~\lib' sharpbang='#!' shsharp='true' sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM USR1 USR2 CHLD PWR WINCH URG IO STOP TSTP CONT TTIN TTOU VTALRM PROF XCPU XFSZ WAITING LWP FREEZE THAW RTMIN NUM37 NUM38 NUM39 NUM40 NUM41 NUM42 RTMAX IOT CLD POLL' @@ -46,13 +46,13 @@ afs='false' alignbytes='8' aphostname='' ar='ar' -archlib='C:\perl\lib' +archlib='~INST_TOP~\lib' archobjs='' awk='awk' baserev='5.0' bash='' -bin='C:\perl\bin' -binexp='C:\perl\bin' +bin='~INST_TOP~\bin' +binexp='~INST_TOP~\bin' bison='' byacc='byacc' byteorder='1234' @@ -208,7 +208,7 @@ d_setreuid='undef' d_setrgid='undef' d_setruid='undef' d_setsid='undef' -d_sfio='undef'; +d_sfio='undef' d_shm='undef' d_shmat='undef' d_shmatprototype='undef' @@ -311,7 +311,7 @@ i_locale='define' i_malloc='define' i_math='define' i_memory='undef' -i_ndbm='define' +i_ndbm='undef' i_neterrno='undef' i_niin='undef' i_pwd='undef' @@ -350,12 +350,12 @@ i_varhdr='varargs.h' i_vfork='undef' incpath='' inews='' -installbin='C:\perl\bin' -installman1dir='C:\perl\man\man1' -installman3dir='C:\perl\lib\perl5\man\man3' -installscript='C:\perl\bin' -installsitearch='C:\perl\lib\site' -installsitelib='C:\perl\lib\site' +installbin='~INST_TOP~\bin' +installman1dir='~INST_TOP~\man\man1' +installman3dir='~INST_TOP~\man\man3' +installscript='~INST_TOP~\bin' +installsitearch='~INST_TOP~\lib\site' +installsitelib='~INST_TOP~\lib\site' intsize='4' known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket' ksh='' @@ -365,7 +365,7 @@ lddlflags='-dll' ldflags='-nologo -subsystem:windows' less='less' lib_ext='.lib' -libc='/lib/libc.so.1.9.2' +libc='msvcrt.lib' libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x' line='line' lint='' @@ -385,11 +385,11 @@ make='nmake' mallocobj='malloc.o' mallocsrc='malloc.c' malloctype='void *' -man1dir='C:\perl\man\man1' -man1direxp='C:\perl\man\man1' +man1dir='~INST_TOP~\man\man1' +man1direxp='~INST_TOP~\man\man1' man1ext='1' -man3dir='C:\perl\lib\perl5\man\man3' -man3direxp='C:\perl\lib\perl5\man\man3' +man3dir='~INST_TOP~\man\man3' +man3direxp='~INST_TOP~\man\man3' man3ext='3' medium='' mips='' @@ -397,7 +397,7 @@ mips_type='' mkdir='mkdir' models='none' modetype='mode_t' -more='more' +more='more /e' mv='' myarchname='MSWin32' mydomain='' @@ -406,7 +406,7 @@ myuname='' n='-n' nm_opt='' nm_so_opt='' -nroff='nroff' +nroff='' o_nonblock='O_NONBLOCK' obj_ext='.obj' oldarchlib='' @@ -414,20 +414,20 @@ oldarchlibexp='' optimize='-O' orderlib='false' package='perl5' -pager='cmd /c more' +pager='more /e' passcat='' patchlevel='2' path_sep=';' perl='perl' perladmin='' -perlpath='C:\perl\bin\perl.exe' +perlpath='~INST_TOP~\bin\perl.exe' pg='pg' phostname='hostname' plibpth='' pmake='' pr='' -prefixexp='C:' -privlib='C:\perl\lib' +prefixexp='~INST_DRV~' +privlib='~INST_TOP~\lib' prototype='define' randbits='15' ranlib='' @@ -435,22 +435,22 @@ rd_nodata='-1' rm='rm' rmail='' runnm='true' -scriptdir='C:\perl\bin' -scriptdirexp='C:\perl\bin' +scriptdir='~INST_TOP~\bin' +scriptdirexp='~INST_TOP~\bin' sed='sed' selecttype='int *' sendmail='blat' -sh='cmd /c' +sh='cmd /x /c' shar='' shmattype='void *' shortsize='2' shrpdir='none' sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 6 18 22' signal_t='void' -sitearch='C:\perl\lib\site' -sitearchexp='C:\perl\lib\site' -sitelib='C:\perl\lib\site' -sitelibexp='C:\perl\lib\site' +sitearch='~INST_TOP~\lib\site' +sitearchexp='~INST_TOP~\lib\site' +sitelib='~INST_TOP~\lib\site' +sitelibexp='~INST_TOP~\lib\site' sizetype='size_t' sleep='' smail='' @@ -484,12 +484,12 @@ uidtype='uid_t' uname='uname' uniq='uniq' usedl='define' -usemymalloc='y' -usenm='true' +usemymalloc='n' +usenm='false' useperlio='undef' useposix='true' usesafe='true' -usevfork='true' +usevfork='false' usrinc='/usr/include' uuname='' vi='' diff --git a/win32/config_h.PL b/win32/config_h.PL new file mode 100644 index 0000000000..d266f6557f --- /dev/null +++ b/win32/config_h.PL @@ -0,0 +1,89 @@ +# +use Config; +use File::Compare qw(compare); +use File::Copy qw(copy); +my $name = $0; +$name =~ s#^(.*)\.PL$#../$1.SH#; +open(SH,"<$name") || die "Cannot open $name:$!"; +while (<SH>) + { + last if /^sed/; + } +($term,$file,$pat) = /^sed\s+<<(\S+)\s+>(\S+)\s+(.*)$/; + +my $str = "sub munge\n{\n"; + +while ($pat =~ s/-e\s+'([^']*)'\s*//) + { + my $e = $1; + $e =~ s/\\([\(\)])/$1/g; + $e =~ s/\\(\d)/\$$1/g; + $str .= "$e;\n"; + } +$str .= "}\n"; + +eval $str; + +die "$str:$@" if $@; + +open(H,">$file.new") || die "Cannot open $file.new:$!"; +while (<SH>) + { + last if /^$term$/o; + s/\$([\w_]+)/Config($1)/eg; + s/`([^\`]*)`/BackTick($1)/eg; + munge(); + s/\\\$/\$/g; + s#/[ *\*]*\*/#/**/#; + if (/#define\s+ARCHLIBEXP/) + { + } + print H; + } +print H "#include <win32.h> +#define ARCHLIBEXP (win32PerlLibPath()) +#define DEBUGGING +"; +close(H); +close(SH); + + +chmod(0666,"../lib/CORE/config.h"); +copy("$file.new","../lib/CORE/config.h") || die "Cannot copy:$!"; +chmod(0444,"../lib/CORE/config.h"); + +if (compare("$file.new",$file)) + { + warn "$file has changed\n"; + chmod(0666,$file); + unlink($file); + rename("$file.new",$file); + chmod(0444,$file); + exit(1); + } + +sub Config +{ + my $var = shift; + my $val = $Config{$var}; + $val = 'undef' unless defined $val; + $val =~ s/\\/\\\\/g; + return $val; +} + +sub BackTick +{ + my $cmd = shift; + if ($cmd =~ /^echo\s+(.*?)\s*\|\s+sed\s+'(.*)'\s*$/) + { + local ($data,$pat) = ($1,$2); + $data =~ s/\s+/ /g; + eval "\$data =~ $pat"; + return $data; + } + else + { + die "Cannot handle \`$cmd\`"; + } + return $cmd; +} diff --git a/win32/config_sh.PL b/win32/config_sh.PL new file mode 100644 index 0000000000..d397a1b53b --- /dev/null +++ b/win32/config_sh.PL @@ -0,0 +1,13 @@ +my %opt; +while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/) + { + $opt{$1}=$2; + shift(@ARGV); + } +while (<>) + { + s/~([\w_]+)~/$opt{$1}/g; + $_ = "$1='$opt{$1}'\n" if (/^([\w_]+)=/ && exists($opt{$1})); + print; + } + diff --git a/win32/perllib.c b/win32/perllib.c index 9d2aaa9e2b..9d24a2ac18 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -65,7 +65,6 @@ xs_init() { char *file = __FILE__; dXSUB_SYS; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } diff --git a/win32/runperl.c b/win32/runperl.c index 507b3831f5..07e2bd6f83 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -1,10 +1,18 @@ #include <stdio.h> #include <win32io.h> -extern WIN32_IOSUBSYSTEM win32stdio; +#ifndef _DLL +extern WIN32_IOSUBSYSTEM win32stdio; +#endif + extern int RunPerl(int argc, char **argv, char **env, void *iosubsystem); +int main(int argc, char **argv, char **env) { - return (RunPerl(argc, argv, env, &win32stdio)); +#ifdef _DLL + return (RunPerl(argc, argv, env, NULL)); +#else + return (RunPerl(argc, argv, env, &win32stdio)); +#endif } diff --git a/win32/win32.c b/win32/win32.c index ed24251ba6..909036477d 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -54,22 +54,18 @@ IsWinNT(void) { void * SetIOSubSystem(void *p) { + PWIN32_IOSUBSYSTEM old = pIOSubSystem; if (p) { PWIN32_IOSUBSYSTEM pio = (PWIN32_IOSUBSYSTEM)p; - if (pio->signature_begin == 12345678L && pio->signature_end == 87654321L) { - PWIN32_IOSUBSYSTEM pold = pIOSubSystem; pIOSubSystem = pio; - return pold; } } else { - /* re-assign our stuff */ -/* pIOSubSystem = &win32stdio; */ - pIOSubSystem = NULL; + pIOSubSystem = &win32stdio; } - return pIOSubSystem; + return old; } char * diff --git a/win32/win32io.c b/win32/win32io.c index c9cc8e24e2..e75754abb9 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -65,6 +65,12 @@ dummy_globalmode(int mode) return o; } +#ifdef _DLL +/* It may or may not be fixed (ok on NT), but DLL runtime + does not export the functions used in the workround +*/ +#define WIN95_OSFHANDLE_FIXED +#endif #if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) @@ -172,7 +178,7 @@ my_open_osfhandle(long osfhandle, int flags) #else int __cdecl -stolen_open_osfhandle(long osfhandle, int flags) +my_open_osfhandle(long osfhandle, int flags) { return _open_osfhandle(osfhandle, flags); } diff --git a/win32/win32sck.c b/win32/win32sck.c index 7acb02871c..45f7ac1cbf 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -22,13 +22,8 @@ #ifdef USE_SOCKETS_AS_HANDLES /* thanks to Beverly Brown (beverly@datacube.com) */ -# if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) -/*# define OPEN_SOCKET(x) _patch_open_osfhandle(x, _O_RDWR | _O_BINARY) */ -# define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) -# else -# define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) -# endif -# define TO_SOCKET(x) _get_osfhandle(x) +#define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) +#define TO_SOCKET(x) _get_osfhandle(x) #else @@ -37,123 +32,9 @@ #endif /* USE_SOCKETS_AS_HANDLES */ -/* - * This is a clone of fdopen so that we can handle the version of - * sockets that NT gets to use. - * - * The problem is that sockets are not real file handles and - * cannot be fdopen'ed. This causes problems in the do_socket - * routine in doio.c, since it tries to create two file pointers - * for the socket just created. We'll fake out an fdopen and see - * if we can prevent perl from trying to do stdio on sockets. - */ - -#if defined(_WIN32) && !defined(WIN95_OSFHANDLE_FIXED) && defined(_M_IX86) - -# ifdef __cplusplus -#define EXT_C_FUNC extern "C" -# else -#define EXT_C_FUNC extern -# endif - -EXT_C_FUNC int __cdecl _alloc_osfhnd(void); -EXT_C_FUNC int __cdecl _set_osfhnd(int fh, long value); -EXT_C_FUNC void __cdecl _lock_fhandle(int); -EXT_C_FUNC void __cdecl _unlock_fhandle(int); -EXT_C_FUNC void __cdecl _unlock(int); -EXT_C_FUNC struct servent* win32_savecopyservent(struct servent*d, - struct servent*s, const char *proto); - -#if (_MSC_VER >= 1000) -typedef struct { - long osfhnd; /* underlying OS file HANDLE */ - char osfile; /* attributes of file (e.g., open in text mode?) */ - char pipech; /* one char buffer for handles opened on pipes */ -#if defined (_MT) && !defined (DLL_FOR_WIN32S) - int lockinitflag; - CRITICAL_SECTION lock; -#endif /* defined (_MT) && !defined (DLL_FOR_WIN32S) */ -} ioinfo; - -EXT_C_FUNC ioinfo * __pioinfo[]; - -#define IOINFO_L2E 5 -#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) -#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1))) -#define _osfile(i) (_pioinfo(i)->osfile) -#else /* (_MSC_VER >= 1000) */ - extern char _osfile[]; -#endif /* (_MSC_VER >= 1000) */ - -#define FOPEN 0x01 /* file handle open */ -#define FAPPEND 0x20 /* file handle opened O_APPEND */ -#define FDEV 0x40 /* file handle refers to device */ -#define FTEXT 0x80 /* file handle is in text mode */ - -#define _STREAM_LOCKS 26 /* Table of stream locks */ -#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) /* Last stream lock */ -#define _FH_LOCKS (_LAST_STREAM_LOCK+1) /* Table of fh locks */ - -/*** -*int _patch_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle -* -*Purpose: -* This function allocates a free C Runtime file handle and associates -* it with the Win32 HANDLE specified by the first parameter. This is a -* temperary fix for WIN95's brain damage GetFileType() error on socket -* we just bypass that call for socket -* -*Entry: -* long osfhandle - Win32 HANDLE to associate with C Runtime file handle. -* int flags - flags to associate with C Runtime file handle. -* -*Exit: -* returns index of entry in fh, if successful -* return -1, if no free entry is found -* -*Exceptions: -* -*******************************************************************************/ - -int __cdecl -_patch_open_osfhandle(long osfhandle, int flags) -{ - int fh; - char fileflags; /* _osfile flags */ - - /* copy relevant flags from second parameter */ - fileflags = FDEV; - - if(flags & _O_APPEND) - fileflags |= FAPPEND; - - if(flags & _O_TEXT) - fileflags |= FTEXT; - - /* attempt to allocate a C Runtime file handle */ - if((fh = _alloc_osfhnd()) == -1) { - errno = EMFILE; /* too many open files */ - _doserrno = 0L; /* not an OS error */ - return -1; /* return error to caller */ - } - - /* the file is open. now, set the info in _osfhnd array */ - _set_osfhnd(fh, osfhandle); - - fileflags |= FOPEN; /* mark as open */ - -#if (_MSC_VER >= 1000) - _osfile(fh) = fileflags; /* set osfile entry */ - _unlock_fhandle(fh); -#else - _osfile[fh] = fileflags; /* set osfile entry */ - _unlock(fh+_FH_LOCKS); /* unlock handle */ -#endif - - return fh; /* return handle */ -} -#endif /* _M_IX86 */ - +static struct servent* win32_savecopyservent(struct servent*d, + struct servent*s, + const char *proto); #define SOCKETAPI PASCAL typedef SOCKET (SOCKETAPI *LPSOCKACCEPT)(SOCKET, struct sockaddr *, int *); @@ -806,4 +687,24 @@ win32_setservent(int stayopen) CROAK("setservent not implemented!\n"); } +#define WIN32IO_IS_STDIO +#include <io.h> +#include "win32iop.h" + +static struct servent* +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; + if (!IsWin95() && s->s_proto && strlen(s->s_proto)) + d->s_proto = s->s_proto; + else if (proto && strlen(proto)) + d->s_proto = (char *)proto; + else + d->s_proto = "tcp"; + + return d; +} + |