diff options
128 files changed, 6421 insertions, 1004 deletions
@@ -20,7 +20,6 @@ current addresses (as of March 1997): Kenneth Albanowski <kjahds@kjahds.com> Graham Barr <gbarr@ti.com> Spider Boardman <spider@orb.nashua.nh.us> - Tim Bunce <Tim.Bunce@ig.co.uk> Tom Christiansen <tchrist@perl.com> Hallvard B Furuseth <h.b.furuseth@usit.uio.no> M. J. T. Guy <mjtg@cus.cam.ac.uk> @@ -30,12 +29,14 @@ current addresses (as of March 1997): Andreas Koenig <a.koenig@mind.de> Doug MacEachern <dougm@opengroup.org> Paul Marquess <pmarquess@bfsec.bt.co.uk> + Hans Mulder <hansm@euronet.nl> Jeff Okamoto <okamoto@hpcc123.corp.hp.com> Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> Tom Phoenix <rootbeer@teleport.com> Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> Dean Roehrich <roehrich@cray.com> Roderick Schertler <roderick@argon.org> + Larry W. Virden <lvirden@cas.org> Ilya Zakharevich <ilya@math.ohio-state.edu> And the Keepers of the Patch Pumpkin: @@ -43,6 +44,414 @@ And the Keepers of the Patch Pumpkin: Charles Bailey <bailey@hmivax.humgen.upenn.edu> Andy Dougherty <doughera@lafcol.lafayette.edu> Chip Salzenberg <chip@perl.com> + Tim Bunce <Tim.Bunce@ig.co.uk> + + +---------------- +Version 5.004_01 Maintenance release 1 for 5.004 +---------------- + +"Practice random kindness and senseless acts of beauty" + -- Anne Herbert + + HEADLINES FOR THIS MAINTENANCE RELEASE + + (..., undef, ...) = split(...) bug fixed. + Win32 support greatly improved, now very strong. + Memory leak using Tied hashes and arrays fixed. + Documentation updates. + Many other bug fixes and enhancements. + + CORE LANGUAGE + + Title: "[PATCH] first true value returned by scalar C<...> is wrong" + From: hansm@euronet.nl + Files: pp_ctl.c t/op/flip.t + + Title: "Regex Bug in 5.003_26 thru 003_99a" + From: Andreas Karrer <karrer@ife.ee.ethz.ch>, Chip Salzenberg + <chip@atlantic.net> + Msg-ID: <199705152303.BAA08890@kuru.ee.ethz.ch>, + <199705161915.PAA18721@rio.atlantic.net> + Files: regcomp.h regcomp.c regexec.c + + Title: "[PATCH] -w interacts badly with -Dt" + From: Spider Boardman <spider@Orb.Nashua.NH.US> + Files: sv.c + + Title: "No DESTROY on untie. Tie memory leak fixed." + From: Gurusamy Sarathy <gsar@engin.umich.edu>, Jay Rogers <jay@rgrs.com>, + pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <199705170235.WAA00267@fluffy.rgrs.com>, + <199705172156.RAA20561@aatma.engin.umich.edu>, + <9705171506.AA04491@claudius.bfsec.bt.co.uk> + Files: pp_hot.c + + Title: "magic_clear_all_env proto should match svt_clear" + From: Nick Ing-Simmons <nik@tiuk.ti.com> + Files: proto.h mg.c + + Title: "[PATCH] ENV leaks on win32 (was Re: Comments on ENV patch sought)", + "[PATCH] for NETaa13787: %ENV=(); doesn't clear the environment" + From: hansm@euronet.nl, pvhp@forte.com (Peter Prymmer) + Msg-ID: <199705292240.AAA01135@mail.euronet.nl> + Files: embed.h perl.h proto.h global.sym mg.c t/op/magic.t + + Title: "Patch to show @INC when require dies" + From: avera@hal.com (Jim Avera) + Msg-ID: <9705230121.AA27872@membrane.hal.com> + Files: pp_ctl.c + + Title: "[PATCH] bug with m// nested inside s///e" + From: hansm@euro.net + Files: op.c t/op/subst.t + + DOCUMENTATION + + Title: "[PATCH] perlembed Win32 update" + From: Doug MacEachern <dougm@opengroup.org> + Files: pod/perlembed.pod + + Title: "perldiag.pod patch - "(W) substr outside string" is "(S)evere" if + used as lvalue." + From: John Hughes <john@AtlanTech.COM> + Files: pod/perldiag.pod + + Title: "local(%ENV) looses magic - document behaviour" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: pod/perlsub.pod + + Title: "[PATCH] perlguts caveats", "perlguts additions" + From: Gurusamy Sarathy <gsar@engin.umich.edu>, ilya@math.ohio-state.edu + (Ilya Zakharevich) + Msg-ID: <199705180052.UAA22066@aatma.engin.umich.edu>, + <199705180202.WAA22826@aatma.engin.umich.edu>, + <199705301341.JAA05204@aatma.engin.umich.edu>, + <1997May17.235722.2033087@hmivax.humgen.upenn.edu> + Files: pod/perlguts.pod + + Title: "pod2man produces broken pages", "weird condition in perldelta breaks + nroff" + From: Davin Milun <milun@cs.Buffalo.EDU>, Hans Mulder <hansm@icgned.nl> + Msg-ID: <199705310447.AAA15721@obelix.cs.Buffalo.EDU>, + <1997May25.192350.2055977@hmivax.humgen.upenn.edu> + Files: pod/pod2man.PL + + Title: "Perl 5 pod2man fix", "perlguts man page corrupted" + From: chen@adi.com (Franklin Chen), gnat@frii.com, lvirden@cas.org, tom + (Tom Dinger on Feste), tom@edc.com (Tom Dinger on Feste) + Msg-ID: <199705210013.UAA09599@menhaden.adi.com>, + <199706011305.JAA18271@cas.org>, + <199706012116.PAA14102@elara.frii.com>, + <9504250959.AA23419@feste.edc.com>, + <9504251700.AA23823@feste.edc.com> + Files: pod/pod2man.PL + + Title: "[PATCH] reference form chomp to chop in perlfunc" + From: hansm@euronet.nl + Files: pod/perlfunc.pod + + Title: "pod2man gags if "=pod" is before "=head1 NAME"" + From: whyde@pezz.sps.mot.com (Warren Hyde) + Msg-ID: <9705212115.AA21730@pezz.sps.mot.com> + Files: pod/pod2man.PL + + Title: "perlfunc.pod unclear about return value range of rand" + From: "Tuomas J. Lukka" <tjl@lukka.student.harvard.edu> + Msg-ID: <m0wSMiC-000C9xC@lukka.student.harvard.edu> + Files: pod/perlfunc.pod + + Title: "Error in perllol manpage", "Error in perllol manpage (fwd)" + From: Chris Wick <cwick@lmc.com> + Files: pod/perllol.pod + + Title: "5.004 removed deprecated %OVERLOAD support silently" + From: jon@sems.com (Jonathan Biggar) + Msg-ID: <199705232319.QAA28388@clamp.netlabs.com> + Files: pod/perldelta.pod + + Title: "[PATCH] Documentation bugs" + From: Stephen Potter <spp@psa.pencom.com> + Files: pod/perldata.pod pod/perldiag.pod pod/perlfaq8.pod pod/perlfaq9.pod + pod/perlop.pod pod/perlsub.pod pod/perltoot.pod + + Title: "5.004 POD stuff", "make html - any takers?", "make html --> unusable + xref links", "pod/*.html -- all hyperlinks are invalid" + From: "Darren/Torin/Who Ever..." <torin@daft.com>, "Paul D. Smith" + <psmith@BayNetworks.COM>, Gurusamy Sarathy + <gsar@engin.umich.edu>, Jarkko Hietaniemi <jhi@iki.fi>, + Michael R Cook <mcook@cognex.com>, avera@hal.com (Jim + Avera), lvirden@cas.org + Msg-ID: <199705162008.XAA06906@alpha.hut.fi>, + <199705171830.OAA15652@erawan.cognex.com>, + <199706081749.NAA04552@aatma.engin.umich.edu>, + <1997May16.191039.2033079@hmivax.humgen.upenn.edu>, + <87hgg2y1h4.fsf@perv.daft.com>, + <9705161931.AA01075@membrane.hal.com>, + <9705191839.AA28702@lemming.engeast> + Files: INSTALL pod/perldiag.pod installhtml + + Title: "checkpods- forget blank line status when starting a new file" + From: Larry Parmelee <parmelee@CS.Cornell.EDU> + Files: pod/checkpods.PL + + Title: "installhtml: Fix 'no title' & 'unexpected ...' warnings. Double speed." + From: Tim Bunce + Files: installhtml lib/Pod/Html.pm pod/splitpod + + LIBRARY AND EXTENSIONS + + Title: "sdbm can fail if a config.h exists in system directories" + From: Tim Bunce + Files: ext/SDBM_File/sdbm/Makefile.PL + + Title: "LWP and SIG __DIE__ traps not playing well together!" + From: Gisle Aas <aas@bergen.sn.no> + Files: lib/AutoLoader.pm + + Title: "Memory Consumption of autosplit_lib_modules/sv_gets (workaround)" + From: Matthias Neeracher <neeri@iis.ee.ethz.ch> + Files: lib/AutoSplit.pm + + Title: "Comments of this Sys::Syslog patch", "Unusual Sys::Syslog behaviour + with FQDN ? [Even in 5.004 - a bug?]" + From: Jarkko Hietaniemi <jhi@iki.fi>, Russ Allbery <rra@stanford.edu>, + alansz@mellers1.psych.berkeley.edu (Alan Schwartz) + Msg-ID: <199705231621.TAA16790@alpha.hut.fi>, <5m4fjr$rhs@agate.berkeley.edu> + Files: lib/Sys/Syslog.pm + + Title: "Patch to CPAN.pm (perl5.004) for ncftp" + From: "Richard L. Maus, Jr." <rmaus@monmouth.com> + Msg-ID: <337FBAC8.167EB0E7@monmouth.com> + Files: lib/CPAN.pm + + Title: "[PATCH] Harness.pm bug w/perl5.004 & VMS" + From: Dan Sugalski <sugalsd@lbcc.cc.or.us> + Msg-ID: <3.0.1.32.19970530102300.008a2730@stargate.lbcc.cc.or.us> + Files: lib/Test/Harness.pm + + Title: "more Fcntl constants [PATCH]" + From: Jarkko Hietaniemi <jhi@iki.fi> + Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + + Title: "5.004 breaks ftp.pl due to missing (although obsolete) chat2.pl" + From: Tim Bunce + Files: lib/chat2.pl + + BUILD PROCESS + + Title: "make test && ... doesn't work" + From: Tim Bunce + Files: Makefile.SH + + Title: "[PATCH] INSTALL-1.18" + From: Andy Dougherty <doughera@fractal.phys.lafayette.edu> + Msg-ID: <Pine.SOL.3.95q.970529142739.662D-100000@fractal.lafayette.edu> + Files: INSTALL + + Title: "improved gnuwin32 Configure support" + From: Chris Faylor <cgf@bbc.com> + Msg-ID: <199706070318.XAA09214@hardy.bbc.com> + Files: Configure + + Title: "installhtml problems finding splitpod" + From: lvirden@cas.org + Files: installhtml INSTALL + + Title: "perl 5.004 (and 01) man pages not generated and installed" + From: lvirden@cas.org (Larry W. Virden) + Files: installman + + Title: "oddity in Configure" + From: Mike Stok <mike@stok.co.uk> + Files: Configure + + Title: "perl5.004 on AIX: Patches", "perl5.004 on FreeBSD and AIX" + From: Peter van Heusden <pvh@junior.uwc.ac.za> + Msg-ID: <Pine.A32.3.93.970519142625.22442B-100000@junior.uwc.ac.za>, + <Pine.A32.3.93.970519163700.25188A-100000@junior.uwc.ac.za> + Files: Makefile.SH perl_exp.SH ext/DynaLoader/dl_aix.xs perlio.sym + + Title: "Compiling perl5.004 on NEWS-OS 4.x" + From: Makoto MATSUSHITA (=?ISO-2022-JP?B?GyRCJF4kRCQ3JD8kXiQzJEgbKEI=?=) + <matusita@ics.es.osaka-u.ac.jp> + Msg-ID: <19970521132814F.matusita@ics.es.osaka-u.ac.jp> + Files: Configure hints/newsos4.sh + + PORTABILITY + + Title: "win32: additional default libraries" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199705291332.JAA21560@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Win32.pm + + Title: "[PATCH] win32 minor fixes" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm win32/config.bc + + Title: "[PATCH] clean up perlocal.pod output on VMS" + From: pvhp@forte.com (Peter Prymmer) + Files: lib/ExtUtils/MM_VMS.pm + + Title: "[PATCH] Re: Term::ReadKey on Win32: set console" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: lib/Term/ReadLine.pm + + Title: "[PATCH] Pod::Text nit for Win32" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: lib/Pod/Text.pm + + Title: "pathname bug in xsubpp on win32" + From: jon@sems.com (Jonathan Biggar) + Msg-ID: <199705230126.SAA23401@clamp.netlabs.com> + Files: lib/ExtUtils/xsubpp + + Title: "MakeMaker stumbles on Win32 UNC paths" + From: Warren Jones <wjones@TC.FLUKE.COM> + Files: lib/ExtUtils/MM_Win32.pm + + Title: "build problem on SGI R10000 PowerChallenge (IRIX 6.2) lseek proto" + From: Jarkko Hietaniemi <jhi@iki.fi> + Files: doio.c + + Title: "Perl 5.004 + Linux 2.0.30 & semctl()" + From: Andy Dougherty <doughera@fractal.phys.lafayette.edu>, Jordan + Mendelson <jordy@snappy.wserv.com> + Files: doio.c + + Title: "lib/io_udp.t fails on VMS" + From: Jonathan.Hudson@jrhudson.demon.co.uk + Msg-ID: <XFMail.970522181042.Jonathan.Hudson@jrhudson.demon.co.uk> + Files: pp_sys.c + + Title: "Compilation of mg.c from perl5.004m1t2 fails on OpenVMS/AXP" + From: Henrik Tougaard <ht.000@foa.dk> + Files: mg.c t/op/taint.t + + Title: "[PATCH] (NEXT|OPEN)STEP hints" + From: Gerd Knops <gerti@BITart.com> + Files: hints/next_3.sh hints/next_4.sh + + Title: "win32: user defined shell" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199705291339.JAA21682@aatma.engin.umich.edu> + Files: pod/perlrun.pod win32/win32.c + + Title: "misc perl5.004 doc fixes, especially vms" + From: lvirden@cas.org (Larry W. Virden) + Msg-ID: <199705160419.AAA16317@cas.org> + Files: pod/perlfaq4.pod vms/perlvms.pod lib/Pod/Html.pm pod/roffitall + vms/ext/DCLsym/DCLsym.pm vms/ext/Stdio/Stdio.pm + + Title: "[PATCH] gen_shrfls.pl too picky for Dec C 5.6 preprocessor output" + From: Dan Sugalski <sugalsd@lbcc.cc.or.us> + Files: vms/gen_shrfls.pl + + Title: "[PATCH] win32: Configure cf_email" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Msg-ID: <199705301335.JAA05079@aatma.engin.umich.edu> + Files: win32/Makefile win32/config.bc win32/config.vc win32/config_sh.PL + win32/makefile.mk + + Title: "[PATCH] README.win32 nits" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: README.win32 + + Title: "Document cause and remedy for op/taint.t failure" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: README.win32 + + Title: "SVR4 hints for DDE SMES Supermax Enterprise Server" + From: Jarkko Hietaniemi <jhi@iki.fi> + Files: hints/svr4.sh + + Title: "porting.help" + From: Tim Bunce + Files: Porting/pumpkin.pod Porting/preprel + + Title: "Major 5.004 Win32 update (Borland win32 support, and other patches)", + "($a,undef,$b) = qw(a b c) and ties delaying DESTROY fixes" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: MANIFEST pod/perlguts.pod win32/include/sys/socket.h EXTERN.h + opcode.h perl.h regcomp.h ext/Fcntl/Fcntl.pm + ext/SDBM_File/Makefile.PL lib/ExtUtils/Install.pm + lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm + lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + lib/File/DosGlob.pm t/op/mkdir.t t/op/stat.t win32/win32.h + win32/win32io.h win32/win32iop.h README.win32 doio.c gv.c + mg.c op.c perlio.c pp.c pp_ctl.c pp_hot.c pp_sys.c util.c + win32/Makefile win32/config.bc win32/config.vc + win32/config_H.bc win32/config_H.vc win32/makedef.pl + win32/makefile.mk win32/makeperldef.pl win32/perlglob.c + win32/perllib.c win32/win32.c win32/win32io.c + win32/win32sck.c + + Title: "[PATCH] Re: Maintenance release (remove PERL_DUMMY_SIZE)" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: opcode.h perl.h regcomp.h win32/win32.h gv.c + + Title: "[PATCH] ENV leaks on win32 (was Re: Comments on ENV patch sought)" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: win32/win32.h win32/win32io.h win32/win32iop.h global.sym mg.c perl.c + t/op/magic.t util.c win32/makedef.pl win32/win32.c + win32/win32io.c + + Title: "[PATCH] win32: ExtUtils::Liblist support" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm win32/Makefile win32/config.bc + win32/makefile.mk + + Title: "[PATCH] Re: borland C++Perl embedding failures re __declspec()" + From: Gurusamy Sarathy <gsar@engin.umich.edu> + Files: win32/win32.c + + Title: "No need to use `pwd` in t/op/magic.t test for amigaos" + From: Norbert Pueschel <pueschel@imsdd.meb.uni-bonn.de> + Files: t/op/magic.t + + TESTS + + Title: "Tests depend on locale" + From: "Jan D." <jan.djarv@mbox200.swipnet.se>, Jarkko Hietaniemi + <jhi@iki.fi> + Msg-ID: <199705191127.NAA08148@ostrich.gaia.swipnet.se>, + <199705191230.PAA21070@alpha.hut.fi> + Files: t/lib/safe2.t t/op/mkdir.t + + Title: "op/groups test fails on Linux (groups in /bin)" + From: "Jan D." <jan.djarv@mbox200.swipnet.se> + Msg-ID: <199705191120.NAA08130@ostrich.gaia.swipnet.se> + Files: t/op/groups.t + + Title: "More simple regexp tests and test docs" + From: Hans Mulder <hansm@euronet.nl> + Files: t/op/re_tests t/op/regexp.t + + Title: "[PATCH] Re: Using undef to ignore values returned from split" + From: Hugo van der Sanden <hv@crypt.compulink.co.uk> + Files: t/op/split.t + + UTILITIES + + Title: "bad test of -A flag in h2xs" + From: "Jeffrey S. Haemer" <jsh@woodcock.boulder.qms.com> + Files: utils/h2xs.PL + + Title: "[PATCH] h2xs missing from utils/Makefile" + From: hansm@euronet.nl + Files: utils/Makefile + + Title: "PATCH: bug in perlbug w.r.t. environment variables", "bug in perlbug + w.r.t. environment variables" + From: "Jan D." <jan.djarv@mbox200.swipnet.se>, Jarkko Hietaniemi + <jhi@iki.fi> + Msg-ID: <199705191841.UAA00969@ostrich.gaia.swipnet.se>, + <199705191857.VAA09154@alpha.hut.fi> + Files: utils/perlbug.PL + + Title: "[PATCH] final newline missing in MANIFEST generated by h2xs" + From: hansm@euronet.nl + Files: utils/h2xs.PL ------------- @@ -1704,7 +1704,6 @@ EOM esac;; [23]100) osname=mips ;; next*) osname=next ;; - news*) osname=news ;; i386*) if $test -f /etc/kconfig; then osname=isc @@ -1772,6 +1771,12 @@ EOM netbsd*) osname=netbsd osvers="$3" ;; + news-os) osvers="$3" + case "$3" in + 4*) osname=newsos4 ;; + *) osname=newsos ;; + esac + ;; bsd386) osname=bsd386 osvers=`$uname -r` ;; @@ -1872,10 +1877,10 @@ EOM ;; esac else - if test -f /vmunix -a -f news_os.sh; then + if test -f /vmunix -a -f newsos4.sh; then (what /vmunix | ../UU/tr '[A-Z]' '[a-z]') > ../UU/kernel.what 2>&1 if $contains news-os ../UU/kernel.what >/dev/null 2>&1; then - osname=news_os + osname=newsos4 fi $rm -f ../UU/kernel.what elif test -d c:/.; then @@ -4574,30 +4579,30 @@ $undef) *) case "$useshrplib" in '') case "$osname" in svr4*|dgux|dynixptx|esix|powerux) - dflt='yes' + dflt=y also='Building a shared libperl is required for dynamic loading to work on your system.' ;; next*) case "$osvers" in - 4*) dflt='yes' + 4*) dflt=y also='Building a shared libperl is needed for MAB support.' ;; - *) dflt='no' + *) dflt=n ;; esac ;; sunos) - dflt='no' + dflt=n also='Building a shared libperl will definitely not work on SunOS 4.' ;; - *) dflt='no' + *) dflt=n ;; esac ;; $define|true|[Yy]*) - dflt='yes' + dflt=y ;; - *) dflt='no' + *) dflt=n ;; esac $cat << EOM @@ -5350,7 +5355,7 @@ EOH case "$ans" in none) startperl=": # use perl";; *) startperl="#!$ans" - if $test 33 -lt `echo "$ans" | wc -c`; then + if $test 30 -lt `echo "$ans" | wc -c`; then $cat >&4 <<EOM WARNING: Some systems limit the #! command to 32 characters. @@ -9097,7 +9102,7 @@ EOP $cat >signal_cmd <<EOS $startsh $test -s signal.lst && exit 0 -if $cc $ccflags signal.c -o signal $ldflags >/dev/null 2>&1; then +if $cc $ccflags $ldflags signal.c -o signal >/dev/null 2>&1; then ./signal | $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst else echo "(I can't seem be able to compile the test program -- Guessing)" @@ -9109,7 +9114,7 @@ else 0) set HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM;; esac echo \$@ | $tr ' ' '\012' | \ - $awk '{ printf $1; printf " %d\n", ++s; }' >signal.lst + $awk '{ printf \$1; printf " %d\n", ++s; }' >signal.lst fi $rm -f signal.c signal signal.o EOS @@ -23,24 +23,17 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if defined(_MSC_VER) && defined(_WIN32) +# if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__)) # ifdef PERLDLL -# define EXT __declspec(dllexport) +# define EXT extern __declspec(dllexport) # define dEXT -# define EXTCONST __declspec(dllexport) const +# define EXTCONST extern __declspec(dllexport) const # define dEXTCONST const # else -# if defined(__cplusplus) -# define EXT extern __declspec(dllimport) -# define dEXT -# define EXTCONST extern __declspec(dllimport) const -# define dEXTCONST const -# else -# define EXT __declspec(dllimport) -# define dEXT -# define EXTCONST __declspec(dllimport) const -# define dEXTCONST const -# endif +# define EXT extern __declspec(dllimport) +# define dEXT +# define EXTCONST extern __declspec(dllimport) const +# define dEXTCONST const # endif # else # define EXT extern @@ -14,7 +14,7 @@ The basic steps to build and install perl5 on a Unix system are: # You may also wish to add these: (cd /usr/include && h2ph *.h sys/*.h) - (cd pod && make html && mv *.html <www home dir>) + (installhtml --help) (cd pod && make tex && <process the latex files>) Each of these is explained in further detail below. @@ -381,13 +381,11 @@ use that management software to move perl to its final destination. This section describes how to do this. Someday, Configure may support an option -Dinstallprefix=/foo to simplify this. -Suppose you want to install perl under the /tmp/perl5 directory. -You can edit config.sh and change all the install* variables to -point to /tmp/perl5 instead of /usr/local/wherever. You could -also set them all from the Configure command line. Or, you can -automate this process by placing the following lines in a file -config.over before you run Configure (replace /tmp/perl5 by a -directory of your choice): +Suppose you want to install perl under the /tmp/perl5 directory. You +can edit config.sh and change all the install* variables to point to +/tmp/perl5 instead of /usr/local/wherever. Or, you can automate this +process by placing the following lines in a file config.over before you +run Configure (replace /tmp/perl5 by a directory of your choice): installprefix=/tmp/perl5 test -d $installprefix || mkdir $installprefix @@ -619,7 +617,7 @@ that you might not be able to. The installation directory is encoded in the perl binary with the LD_RUN_PATH environment variable (or equivalent ld command-line option). On Solaris, you can override that with LD_LIBRARY_PATH; on Linux you can't. On Digital Unix, you can -ovveride LD_LIBRARY_PATH by setting the _RLD_ROOT environment variable +override LD_LIBRARY_PATH by setting the _RLD_ROOT environment variable to point to the perl build directory. The only reliable answer is that you should specify a different @@ -1332,14 +1330,31 @@ to hand-edit some of the converted files to get them to parse correctly. For example, h2ph breaks spectacularly on type casting and certain structures. -=head1 cd pod && make html && mv *.html (www home dir) +=head installhtml --help -Some sites may wish to make the documentation in the pod/ directory -available in HTML format. Type +Some sites may wish to make perl documentation available in HTML +format. The installhtml utility can be used to convert pod +documentation into linked HTML files and install install them. - cd pod && make html && mv *.html <www home dir> +The following command-line is an example of the one we use to convert +perl documentation: -where F<www home dir> is wherever your site keeps HTML files. + ./installhtml \ + --podroot=. \ + --podpath=lib:ext:pod:vms \ + --recurse \ + --htmldir=/perl/nmanual \ + --htmlroot=/perl/nmanual \ + --splithead=pod/perlipc \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --verbose + +See the documentation in installhtml for more details. It can take +many minutes to execute a large installation and you should expect to +see warnings like "no title", "unexpected directive" and "cannot +resolve" as the files are processed. We are aware of these problems +(and would welcome patches for them). =head1 cd pod && make tex && (process the latex files) @@ -1395,4 +1410,4 @@ feedback from the perl5-porters@perl.org folks. =head1 LAST MODIFIED -$Id: INSTALL,v 1.17 1997/05/08 21:08:15 doughera Released $ +$Id: INSTALL,v 1.18 1997/05/29 18:24:10 doughera Exp $ @@ -14,6 +14,8 @@ INTERN.h Included before domestic .h files MANIFEST This list of files Makefile.SH A script that generates Makefile Porting/Glossary Glossary of config.sh variables +Porting/makerel Release making utility +Porting/patchls Flexible patch file listing utility Porting/pumpkin.pod Guidelines and hints for Perl maintainers README The Instructions README.amiga Notes about AmigaOS port @@ -267,6 +269,7 @@ hints/mpc.sh Hints for named architecture hints/mpeix.sh Hints for named architecture hints/ncr_tower.sh Hints for named architecture hints/netbsd.sh Hints for named architecture +hints/newsos4.sh Hints for named architecture hints/next_3.sh Hints for named architecture hints/next_3_0.sh Hints for named architecture hints/next_4.sh Hints for named architecture @@ -343,6 +346,7 @@ lib/File/Basename.pm Emulate the basename program lib/File/CheckTree.pm Perl module supporting wholesale file mode validation lib/File/Compare.pm Emulation of cmp command lib/File/Copy.pm Emulation of cp command +lib/File/DosGlob.pm Win32 DOS-globbing module lib/File/Find.pm Routines to do a find lib/File/Path.pm Do things like `mkdir -p' and `rm -r' lib/File/stat.pm By-name interface to Perl's builtin stat @@ -401,6 +405,7 @@ lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" lib/cacheout.pl Manages output filehandles when you need too many +lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead) lib/complete.pl A command completion subroutine lib/constant.pm For "use constant" lib/ctime.pl A ctime workalike @@ -412,7 +417,7 @@ lib/fastcwd.pl a faster but more dangerous getcwd lib/find.pl A find emulator--used by find2perl lib/finddepth.pl A depth-first find emulator--used by find2perl lib/flush.pl Routines to do single flush -lib/ftp.pl FTP code +lib/ftp.pl FTP code (obsolete, use Net::FTP instead) lib/getcwd.pl A getcwd() emulator lib/getopt.pl Perl library supporting option parsing lib/getopts.pl Perl library supporting option parsing @@ -503,6 +508,7 @@ perl.h Global declarations perl_exp.SH Creates list of exported symbols for AIX perlio.c C code for PerlIO abstraction perlio.h Interface to PerlIO abstraction +perlio.sym Symbols for PerlIO abstraction perlsdio.h Fake stdio using perlio perlsfio.h Prototype sfio mapping for PerlIO perlsh A poor man's perl shell @@ -809,7 +815,7 @@ 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/Makefile Win32 port +win32/Makefile Win32 makefile for NMAKE (Visual C++ build) win32/TEST Win32 port win32/autosplit.pl Win32 port win32/bin/network.pl Win32 port @@ -818,8 +824,10 @@ win32/bin/search.bat Win32 port 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 base line config.sh +win32/config.bc Win32 base line config.sh (Borland C++ build) +win32/config.vc Win32 base line config.sh (Visual C++ build) +win32/config_H.bc Win32 config header (Borland C++ build) +win32/config_H.vc Win32 config header (Visual C++ build) 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 @@ -829,6 +837,7 @@ win32/include/dirent.h Win32 port win32/include/netdb.h Win32 port win32/include/sys/socket.h Win32 port win32/makedef.pl Win32 port +win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds) win32/makemain.pl Win32 port win32/makeperldef.pl Win32 port win32/perlglob.c Win32 port diff --git a/Makefile.SH b/Makefile.SH index ec99d02e5c..61d2ca49d7 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -41,7 +41,14 @@ true) ;; aix*) shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" - shrpldflags="$shrpldflags -b noentry $ldflags $libs $cryptlib" + case "$osvers" in + 3*) + shrpldflags="$shrpldflags -e _nostart $ldflags $libs $cryptlib" + ;; + *) + shrpldflags="$shrpldflags -b noentry $ldflags $libs $cryptlib" + ;; + esac aixinstdir=`pwd | sed 's/\/UU$//'` linklibperl="-L $archlibexp/CORE -L $aixinstdir -lperl" ;; @@ -489,8 +496,15 @@ depend: makedepend makedepend: makedepend.SH config.sh sh ./makedepend.SH -check test: miniperl perl preplibrary $(dynamic_ext) - - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty +test-prep: miniperl perl preplibrary $(dynamic_ext) + cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) + +test check: test-prep + cd t && ./perl TEST </dev/tty + +# For testing without a tty or controling terminal. See t/op/stat.t +test-notty: test-prep + cd t && PERL_SKIP_TTY_TEST=1 ./perl TEST # Can't depend on lib/Config.pm because that might be where miniperl # is crashing. diff --git a/Porting/makerel b/Porting/makerel new file mode 100644 index 0000000000..0476ab52b3 --- /dev/null +++ b/Porting/makerel @@ -0,0 +1,90 @@ +#!/bin/env perl -w + +# A first attempt at some automated support for making a perl release. +# Very basic but functional - if you're on a unix system. +# +# No matter how automated this gets, you'll always need to read +# and re-read pumpkin.pod checking for things to be done at various +# stages of the process. +# +# Tim Bunce, June 1997 + +use ExtUtils::Manifest qw(fullcheck); + +$|=1; +$relroot = ".."; # XXX make an option + +die "Must be in root of the perl source tree.\n" + unless -f "./MANIFEST" and -f "patchlevel.h"; + +$patchlevel_h = `grep '#define ' patchlevel.h`; +print $patchlevel_h; +$patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/; +$subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/; +die "Unable to parse patchlevel.h" unless $subversion > 0; +$vers = sprintf("5.%03d", $patchlevel); +$vers.= sprintf( "_%02d", $subversion) if $subversion; + +$perl = "perl$vers"; +$reldir = "$relroot/$perl"; + +print "\nMaking a release for $perl in $reldir\n\n"; + + +print "Cross-checking the MANIFEST...\n"; +($missfile, $missentry) = fullcheck(); +warn "Can't make a release with MANIFEST files missing.\n" if @$missfile; +warn "Can't make a release with files not listed in MANIFEST.\n" if @$missentry; +die "Aborted.\n" if @$missentry or @$missfile; +print "\n"; + + +print "Setting file permissions...\n"; +system("find . -type f -print | xargs chmod -w"); +system("chmod +w configure"); # special case (see pumpkin.pod) +@exe = qw( + Configure + configpm + configure + embed.pl + installperl + installman + keywords.pl + myconfig + opcode.pl + perly.fixer + t/TEST + t/*/*.t + *.SH + vms/ext/Stdio/test.pl + vms/ext/filespec.t + vms/fndvers.com + x2p/*.SH + Porting/patchls + Porting/makerel +); +system("chmod +x @exe"); +print "\n"; + + +print "Creating $reldir release directory...\n"; +die "$reldir release directory already exists\n" if -e "../$perl"; +die "$reldir.tar.gz release file already exists\n" if -e "../$perl.tar.gz"; +mkdir($reldir, 0755) or die "mkdir $reldir: $!\n"; +print "\n"; + + +print "Copying files to release directory...\n"; +# ExtUtils::Manifest maniread does not preserve the order +$cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $reldir"; +system($cmd) == 0 or die "$cmd failed"; +print "\n"; + +chdir $relroot or die $!; + +print "Creating and compressing the tar file...\n"; +$cmd = "tar cf - $perl | gzip --best > $perl.tar.gz"; +system($cmd) == 0 or die "$cmd failed"; +print "\n"; + +system("ls -ld $perl*"); diff --git a/Porting/patchls b/Porting/patchls new file mode 100644 index 0000000000..b3e968de4b --- /dev/null +++ b/Porting/patchls @@ -0,0 +1,324 @@ +#!/bin/perl -w +# +# patchls - patch listing utility +# +# Input is one or more patchfiles, output is a list of files to be patched. +# +# Copyright (c) 1997 Tim Bunce. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# With thanks to Tom Horsley for the seed code. +# +# $Id: patchls,v 1.3 1997/06/10 21:38:45 timbo Exp $ + +use Getopt::Std; +use Text::Wrap qw(wrap $columns); +use Text::Tabs qw(expand unexpand); +use strict; + +sub usage { +die qq{ + + patchls [options] patchfile [ ... ] + + -i Invert: for each patched file list which patch files patch it + -h no filename headers (like grep), only the listing + -l no listing (like grep), only the filename headers + -c Categorise the patch and sort by category (perl specific) + -m print formatted Meta-information (Subject,From,Msg-ID etc) + -p N strip N levels of directory Prefix (like patch), else automatic + -v more verbose (-d for noisy debugging) + +} +} + +$columns = 70; + +$::opt_p = undef; # undef != 0 +$::opt_d = 0; +$::opt_v = 0; +$::opt_m = 0; +$::opt_i = 0; +$::opt_h = 0; +$::opt_l = 0; +$::opt_c = 0; + +usage unless @ARGV; + +getopts("mihlvcp:") or usage; + +my %cat_title = ( + 'TEST' => 'TESTS', + 'DOC' => 'DOCUMENTATION', + 'UTIL' => 'UTILITIES', + 'PORT' => 'PORTABILITY', + 'LIB' => 'LIBRARY AND EXTENSIONS', + 'CORE' => 'CORE LANGUAGE', + 'BUILD' => 'BUILD PROCESS', + 'OTHER' => 'OTHER', +); + +my %ls; + +# Style 1: +# *** perl-5.004/embed.h Sat May 10 03:39:32 1997 +# --- perl-5.004.fixed/embed.h Thu May 29 19:48:46 1997 +# *************** +# *** 308,313 **** +# --- 308,314 ---- +# +# Style 2: +# --- perl5.004001/mg.c Sun Jun 08 12:26:24 1997 +# +++ perl5.004-bc/mg.c Sun Jun 08 11:56:08 1997 +# @@ -656,9 +656,27 @@ +# or (rcs, note the different date format) +# --- 1.18 1997/05/23 19:22:04 +# +++ ./pod/perlembed.pod 1997/06/03 21:41:38 +# +# Variation: +# Index: embed.h + +my($in, $prevline, $prevtype, $ls); + +foreach my $argv (@ARGV) { + $in = $argv; + unless (open F, "<$in") { + warn "Unable to open $in: $!\n"; + next; + } + print "Reading $in...\n" if $::opt_v and @ARGV > 1; + $ls = $ls{$in} ||= { is_in => 1, in => $in }; + my $type; + while (<F>) { + unless (/^([-+*]{3}) / || /^(Index):/) { + # not an interesting patch line but possibly meta-information + next unless $::opt_m; + $ls->{From}{$1}=1 if /^From: (.*\S)/i; + $ls->{Title}{$1}=1 if /^Subject: (?:Re: )?(.*\S)/i; + $ls->{'Msg-ID'}{$1}=1 if /^Message-Id: (.*\S)/i; + $ls->{Date}{$1}=1 if /^Date: (.*\S)/i; + next; + } + $type = $1; + next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/; + + print "Last: $prevline","This: ${_}Got: $1\n\n" if $::opt_d; + + # Some patches have Index lines but not diff headers + # Patch copes with this, so must we. It's also handy for + # documenting manual changes by simply adding Index: lines + # to the file which describes the problem bing fixed. + add_file($ls, $1), next if /^Index:\s+(.*)/; + + if ( ($type eq '---' and $prevtype eq '***') # Style 1 + or ($type eq '+++' and $prevtype eq '---') # Style 2 + ) { + if (/^[-+*]{3} (\S+)\s+.*\d\d:\d\d:\d\d/) { # double check + add_file($ls, $1); + } + else { + warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_"; + } + } + } + continue { + $prevline = $_; + $prevtype = $type; + $type = ''; + } + # if we don't have a title for -m then use the file name + $ls->{Title}{$in}=1 if $::opt_m + and !$ls->{Title} and $ls->{out}; + + $ls->{category} = $::opt_c + ? categorize_files([keys %{ $ls->{out} }], $::opt_v) : ''; +} +print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1; + + +my @ls = sort { + $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in} +} values %ls; + +unless ($::opt_c and $::opt_m) { + foreach $ls (@ls) { + next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; + list_files_by_patch($ls); + } +} +else { + my $c = ''; + foreach $ls (@ls) { + next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in}; + print "\n $cat_title{$ls->{category}}\n" if $ls->{category} ne $c; + $c = $ls->{category}; + unless ($::opt_i) { + list_files_by_patch($ls); + } + else { + my $out = $ls->{in}; + print "\n$out patched by:\n"; + # find all the patches which patch $out and list them + my @p = grep { $_->{out}->{$out} } values %ls; + foreach $ls (@p) { + list_files_by_patch($ls, ''); + } + } + } + print "\n"; +} + +exit 0; + + +# --- + + +sub add_file { + my $ls = shift; + my $out = trim_name(shift); + + $ls->{out}->{$out} = 1; + + # do the -i inverse as well, even if we're not doing -i + my $i = $ls{$out} ||= { + is_out => 1, + in => $out, + category => $::opt_c ? categorize_files([ $out ], $::opt_v) : '', + }; + $i->{out}->{$in} = 1; +} + + +sub trim_name { # reduce/tidy file paths from diff lines + my $name = shift; + $name = "$name ($in)" if $name eq "/dev/null"; + if (defined $::opt_p) { + # strip on -p levels of directory prefix + my $dc = $::opt_p; + $name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0; + } + else { # try to strip off leading path to perl directory + # if absolute path, strip down to any *perl* directory first + $name =~ s:^/.*?perl.*?/::i; + $name =~ s:.*perl[-_]?5\.[-_a-z0-9.]+/::i; + $name =~ s:^\./::; + } + return $name; +} + + +sub list_files_by_patch { + my($ls, $name) = @_; + $name = $ls->{in} unless defined $name; + my @meta; + if ($::opt_m) { + foreach(qw(Title From Msg-ID)) { + next unless $ls->{$_}; + my @list = sort keys %{$ls->{$_}}; + push @meta, sprintf "%7s: ", $_; + @list = map { "\"$_\"" } @list if $_ eq 'Title'; + push @meta, my_wrap(""," ", join(", ",@list)."\n"); + } + $name = "\n$name" if @meta and $name; + } + # don't print the header unless the file contains something interesting + return if !@meta and !$ls->{out}; + print("$ls->{in}\n"),return if $::opt_l; # -l = no listing + + # a twisty maze of little options + my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : ""; + print "$name$cat: " unless ($::opt_h and !$::opt_v) or !"$name$cat"; + print join('',"\n",@meta) if @meta; + + my @v = sort PATORDER keys %{ $ls->{out} }; + my $v = "@v\n"; + print $::opt_m ? " Files: ".my_wrap(""," ",$v) : $v; +} + + +sub my_wrap { + return expand(wrap(@_)); +} + + + +sub categorize_files { + my($files, $verb) = @_; + my(%c, $refine); + + foreach (@$files) { # assign a score to a file path + # the order of some of the tests is important + $c{TEST} += 5,next if m:^t/:; + $c{DOC} += 5,next if m:^pod/:; + $c{UTIL} += 10,next if m:^(utils|x2p|h2pl)/:; + $c{PORT} += 15,next + if m:^(cygwin32|os2|plan9|qnx|vms|win32)/: + or m:^(hints|Porting|ext/DynaLoader)/: + or m:^README\.:; + $c{LIB} += 10,next + if m:^(lib|ext)/:; + $c{'CORE'} += 15,next + if m:^[^/]+[\._]([chH]|sym)$:; + $c{BUILD} += 10,next + if m:^[A-Z]+$: or m:^[^/]+\.SH$: + or m:^(install|configure):i; + print "Couldn't categorise $_\n" if $::opt_v; + $c{OTHER} += 1; + } + if (keys %c > 1) { # sort to find category with highest score + refine: + ++$refine; + my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c; + my @v = map { $c{$_} } @c; + if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/ + and $c[0] =~ m/^(DOC|TESTS|OTHER)/) { # rare + print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d; + ++$c{$c[1]}; + goto refine; + } + print " ".@$files." patches: ", join(", ", map { "$_: $c{$_}" } @c),".\n" + if $verb; + return $c[0] || 'OTHER'; + } + else { + my($c, $v) = %c; + $c ||= 'OTHER'; $v ||= 0; + print " ".@$files." patches: $c: $v\n" if $verb; + return $c; + } +} + + +sub PATORDER { # PATORDER sort by Chip Salzenberg + my ($i, $j); + + $i = ($a =~ m#^[A-Z]+$#); + $j = ($b =~ m#^[A-Z]+$#); + return $j - $i if $i != $j; + + $i = ($a =~ m#configure|hint#i) || ($a =~ m#[S_]H$#); + $j = ($b =~ m#configure|hint#i) || ($b =~ m#[S_]H$#); + return $j - $i if $i != $j; + + $i = ($a =~ m#\.pod$#); + $j = ($b =~ m#\.pod$#); + return $j - $i if $i != $j; + + $i = ($a =~ m#include/#); + $j = ($b =~ m#include/#); + return $j - $i if $i != $j; + + if ((($i = $a) =~ s#/+[^/]*$##) + && (($j = $b) =~ s#/+[^/]*$##)) { + return $i cmp $j if $i ne $j; + } + + $i = ($a =~ m#\.h$#); + $j = ($b =~ m#\.h$#); + return $j - $i if $i != $j; + + return $a cmp $b; +} + diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index d047d928bd..5260e65fcf 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -219,7 +219,8 @@ learned how to use yet. Some of them may make this all a bit easier. Here are the steps I go through to prepare a patch & distribution. -Lots of it could doubtless be automated but isn't. +Lots of it could doubtless be automated but isn't. The Porting/makerel +(make release) perl script does now help automate some parts of it. =head2 Announce your intentions @@ -244,6 +245,8 @@ directory. Before you C<make spotless> (if you do), and if you have changed any documentation in any module or pod file, change to the F<pod> directory and run C<make toc>. +=head2 run installhtml to check the validity of the pod files + =head2 update patchlevel.h Don't be shy about using the subversion number, even for a relatively @@ -264,7 +267,7 @@ will regenerate Configure and config_h.SH. More information on obtaining and running metaconfig is in the F<U/README> file that comes with Perl's metaconfig units. Perl's metaconfig units should be available the same place you found this file. On CPAN, look under my -directory F<id/ANDYD/> for a file such as F<5.003_07-02.U.tar.gz>. +directory F<authors/id/ANDYD/> for a file such as F<5.003_07-02.U.tar.gz>. That file should be unpacked in your main perl source directory. It contains the files needed to run B<metaconfig> to reproduce Perl's Configure script. (Those units are for 5.003_07. There have been @@ -279,12 +282,10 @@ place for your changes. Make sure the MANIFEST is up-to-date. You can use dist's B<manicheck> program for this. You can also use - perl -MExtUtils::Manifest -e fullcheck + perl -w -MExtUtils::Manifest=fullcheck -e fullcheck -to do half the job. This will make sure everything listed in MANIFEST -is included in the distribution. dist's B<manicheck> command will -also list extra files in the directory that are not listed in -MANIFEST. +Both commands will also list extra files in the directory that are not +listed in MANIFEST. The MANIFEST is normally sorted, with one exception. Perl includes both a F<Configure> script and a F<configure> script. The @@ -321,7 +322,6 @@ In all, the following files should probably be executable: installperl installman keywords.pl - lib/splain myconfig opcode.pl perly.fixer @@ -425,7 +425,7 @@ and effort by manually running C<make regen_headers> myself rather than answering all the questions and complaints about the failing command. -=head2 global.sym and interp.sym +=head2 global.sym, interp.sym and perlio.sym Make sure these files are up-to-date. Read the comments in these files and in perl_exp.SH to see what to do. @@ -448,7 +448,7 @@ Let's not force people to keep changing it. Be sure to update the F<Changes> file. Try to include both an overall summary as well as detailed descriptions of the changes. Your -audience will include bother developers and users, so describe +audience will include other developers and users, so describe user-visible changes (if any) in terms they will understand, not in code like "initialize foo variable in bar function". @@ -487,20 +487,28 @@ do something like the following tar cf perl5.004_08.tar perl5.004_08 gzip --best perl5.004_08.tar +These steps, with extra checks, are automated by the Porting/makerel +script. + =head2 Making a new patch I find the F<makepatch> utility quite handy for making patches. You can obtain it from any CPAN archive under -http://www.perl.com/CPAN/authors/Johan_Vromans/ . The only -difference between my version and the standard one is that I have mine -do a +http://www.perl.com/CPAN/authors/Johan_Vromans/ . There are a couple +of differences between my version and the standard one. I have mine do +a # Print a reassuring "End of Patch" note so people won't # wonder if their mailer truncated patches. print "\n\nEnd of Patch.\n"; -at the end. That's because I used to get questions from people asking if -their mail was truncated. +at the end. That's because I used to get questions from people asking +if their mail was truncated. + +It also writes Index: lines which include the new directory prefix +(change Index: print, approx line 294 or 310 depending on the version, +to read: print PATCH ("Index: $newdir$new\n");). That helps patches +work with more POSIX conformant patch programs. Here's how I generate a new patch. I'll use the hypothetical 5.004_07 to 5.004_08 patch as an example. @@ -1108,16 +1116,9 @@ a nice malloc that is well-tuned for the system.) =over 4 -=item Win95, WinNT, and Win32 support - -We need to get something into the distribution for 32-bit Windows. -I'm tired of all the private e-mail questions I get, and I'm saddened -that so many folks keep trying to reinvent the same wheel. - =item MacPerl -Get some of the Macintosh stuff folded back into the main -distribution. +Get some of the Macintosh stuff folded back into the main distribution. =item gconvert replacement @@ -1166,4 +1167,4 @@ All opinions expressed herein are those of the authorZ<>(s). =head1 LAST MODIFIED -$Id: pumpkin.pod,v 1.10 1997/04/16 20:46:47 doughera Released $ +$Id: pumpkin.pod,v 1.10.1.1 1997/06/10 20:46:47 timbo Exp $ @@ -62,15 +62,16 @@ in MANIFEST. Installation -1) Detailed instructions are in the file INSTALL. In brief, the -following should work on most systems: +1) Detailed instructions are in the file INSTALL which you should read. +In brief, the following should work on most systems: rm -f config.sh sh Configure make make test make install -For most systems, it should be safe to accept all the Configure -defaults. +For most systems, it should be safe to accept all the Configure defaults. +(It is recommended that you accept the defaults the first time you build +or if you have any problems building.) 2) Read the manual entries before running perl. diff --git a/README.win32 b/README.win32 index fe5d85ab07..8d14a2da4c 100644 --- a/README.win32 +++ b/README.win32 @@ -9,12 +9,13 @@ perlwin32 - Perl under Win32 =head1 SYNOPSIS These are instructions for building Perl under Windows NT (versions -3.51 or 4.0), using Visual C++ (versions 2.0 through 5.0). Currently, -this port may also build under Windows95, but you can expect problems -stemming from the unmentionable command shell that infests that -platform. Note this caveat is only about B<building> perl. Once -built, you should be able to B<use> it on either Win32 platform (modulo -the problems arising from the inferior command shell). +3.51 or 4.0), using Visual C++ (versions 2.0 through 5.0) or Borland +C++ (version 5.x). Currently, this port may also build under Windows95, +but you can expect problems stemming from the unmentionable command +shell that infests that platform. Note this caveat is only about +B<building> perl. Once built, you should be able to B<use> it on +either Win32 platform (modulo the problems arising from the inferior +command shell). =head1 DESCRIPTION @@ -33,8 +34,8 @@ particular, you can safely ignore any information that talks about You may also want to look at two other options for building a perl that will work on Windows NT: the README.cygwin32 and -README.os2 files, which give a different set of rules to build a -Perl that will work on Win32 platforms. Those two methods will +README.os2 files, which each give a different set of rules to build +a Perl that will work on Win32 platforms. Those two methods will probably enable you to build a more Unix-compatible perl, but you will also need to download and use various other build-time and run-time support software described in those files. @@ -42,9 +43,10 @@ run-time support software described in those files. This set of instructions is meant to describe a so-called "native" port of Perl to Win32 platforms. The resulting Perl requires no additional software to run (other than what came with your operating -system). Currently, this port is only capable of using Microsoft's -Visual C++ compiler. The ultimate goal is to support the other major -compilers that can generally be used to build Win32 applications. +system). Currently, this port is capable of using either the +Microsoft Visual C++ compiler, or the Borland C++ compiler. The +ultimate goal is to support the other major compilers that can +generally be used to build Win32 applications. This port currently supports MakeMaker (the set of modules that is used to build extensions to perl). Therefore, you should be @@ -55,7 +57,7 @@ See L<Usage Hints> below for general hints about this. =over 4 -=item * +=item Command Shell Use the default "cmd" shell that comes with NT. In particular, do *not* use the 4DOS/NT shell. The Makefile has commands that are not @@ -63,14 +65,38 @@ compatible with that shell. The Makefile also has known incompatibilites with the default shell that comes with Windows95, so building under Windows95 should be considered "unsupported". -=item * +=item Borland C++ + +If you are using the Borland compiler, you will need dmake, a freely +available make that has very nice macro features and parallelability. +(The make that Borland supplies is seriously crippled, and will not +work for MakeMaker builds--if you *have* to bug someone about this, +I suggest you bug Borland to fix their make :) + +A port of dmake for win32 platforms is available from +"http://www-personal.umich.edu/~gsar/dmake-4.0-win32.tar.gz". +Fetch and install dmake somewhere on your path. Also make sure you +copy the Borland dmake.ini file to some location where you keep +*.ini files. If you use the binary that comes with the above port, you +will need to set INIT in your environment to the directory where you +put the dmake.ini file. + +=item Microsoft Visual C++ +The NMAKE that comes with Visual C++ will suffice for building. If you did not choose to always initialize the Visual C++ compilation environment variables when you installed Visual C++ on your system, you will need to run the VCVARS32.BAT file usually found somewhere like C:\MSDEV4.2\BIN. This will set your build environment. -=item * +You can also use dmake to build using Visual C++, provided: you +copied the dmake.ini for Visual C++; set INIT to point to the +directory where you put it, as above; and edit win32/config.vc +and change "make=nmake" to "make=dmake". The last step is only +essential if you want to use dmake to be your default make for +building extensions using MakeMaker. + +=item Permissions Depending on how you extracted the distribution, you have to make sure some of the files are writable by you. The easiest way to make sure of @@ -92,56 +118,72 @@ but it doesn't hurt to do so. 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. +versions of NMAKE that come with Visual C++ ver. 2.0 and above, and +a dmake "makefile.mk" that will work for both Borland and Visual C++ +builds. The defaults in the dmake makefile are setup to build using the +Borland compiler. =item * -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". - -If you want to build a perl capable of running on the Windows95 -platform, you will have to uncomment the line that sets "RUNTIME=-MT". -(The default settings use the Microsoft-recommended -MD option for -compiling, which uses the DLL version of the C RunTime Library. There -currently exists a bug in the Microsoft CRTL that causes failure of -the socket calls only on the Windows95 platform. This bug cannot be -worked around if the DLL version of the CRTL is used, which is why you -need to enable the -MT flag.) Perl compiled with -MT can be used on -both Windows NT and Windows95. +Edit the Makefile (or makefile.mk, if using dmake) and change the values +of INST_DRV and INST_TOP if you want perl to be installed in a location +other than "C:\PERL". If you are using Visual C++ ver. 2.0, uncomment +the line that sets "CCTYPE=MSVC20". -If you are using Visual C++ ver. 2.0, uncomment the line that -sets "CCTYPE=MSVC20". +You will also have to make sure CCHOME points to wherever you installed +your compiler. =item * -Type "nmake". +Type "nmake" (or "dmake" if you are using that make). 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 build fails for any reason, make sure you have done the previous steps correctly. +When building using Visual C++, a perl95.exe will also get built. This +executable is only needed on Windows95, and should be used instead of +perl.exe, and then only if you want sockets to work properly on Windows95. +This is necessitated by a bug in the Microsoft C Runtime that cannot be +worked around in the "normal" perl.exe. Again, if this bugs you, please +bug Microsoft :). perl95.exe gets built with its own private copy of the +C Runtime that is not accessible to extensions (which see the DLL version +of the CRT). Be aware, therefore, that this perl95.exe will have +esoteric problems with extensions like perl/Tk that themselves use the C +Runtime heavily, or want to free() pointers malloc()-ed by perl. + +You can avoid the perl95.exe problems completely if you use Borland +C++ for building perl (perl95.exe is not needed and will not be built +in that case). + =back =head2 Testing -Type "nmake test". This will run most of the tests from the -testsuite (many tests will be skipped, and but no test should fail). +Type "nmake test" (or "dmake 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". -Please report any failures as described under L<BUGS AND CAVEATS>. +If you used the Borland compiler, you may see a failure in op/taint.t +arising from the inability to find the Borland Runtime DLLs on the system +default path. You will need to copy the DLLs reported by the messages +from where Borland chose to install it, into the Windows system directory +(usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. + +Please report any other 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 C<INST_TOP> to -in the Makefile). It will also install the pod documentation under -C<$INST_TOP\lib\pod> and HTML versions of the same under -C<$INST_TOP\lib\pod\html>. To use the Perl you just installed, set your -PATH environment variable to "C:\perl\bin" (or C<$INST_TOP\bin>, if you -changed the default as above). +Type "nmake install" (or "dmake install"). This will put the newly +built perl and the libraries under "C:\perl" (actually whatever you set +C<INST_TOP> to in the Makefile). It will also install the pod +documentation under C<$INST_TOP\lib\pod> and HTML versions of the same +under C<$INST_TOP\lib\pod\html>. To use the Perl you just installed, +set your PATH environment variable to "C:\perl\bin" (or C<$INST_TOP\bin>, +if you changed the default as above). =head2 Usage Hints @@ -161,6 +203,28 @@ variables you can set in the perlrun podpage. Sometime in the future, some of the configuration information for perl will be moved into the Windows registry. +=item File Globbing + +By default, perl spawns an external program to do file globbing. +The install process installs both a perlglob.exe and a perlglob.bat +that perl can use for this purpose. Note that with the default +installation, perlglob.exe will be found by the system before +perlglob.bat. + +perlglob.exe relies on the argv expansion done by the C Runtime of +the particular compiler you used, and therefore behaves very +differently depending on the Runtime used to build it. To preserve +compatiblity, perlglob.bat (a perl script/module that can be +used portably) is installed. Besides being portable, perlglob.bat +also offers enhanced globbing functionality. + +If you want perl to use perlglob.bat instead of perlglob.exe, just +delete perlglob.exe from the install location (or move it somewhere +perl cannot find). Using File::DosGlob.pm (which is the same +as perlglob.bat) to override the internal CORE::glob() works about 10 +times faster than spawing perlglob.exe, and you should take this +approach when writing new modules. See File::DosGlob for details. + =item Using perl from the command line If you are accustomed to using perl from various command-line @@ -213,20 +277,12 @@ This prints "bar" and writes "foo" into the file "blurch": perl -e "print 'foo'; print STDERR 'bar'" 1> blurch -This prints "foo" and writes "bar" to the file "blurch": - - perl -e "print 'foo'; print STDERR 'bar'" 2> blurch - This pipes "foo" to the "less" pager and prints "bar" on the console: perl -e "print 'foo'; print STDERR 'bar'" | less This pipes "foo\nbar\n" to the less pager: - perl -le "print 'foo'; print STDERR 'bar'" |& less - -This does the same thing as the above: - perl -le "print 'foo'; print STDERR 'bar'" 2>&1 | less This pipes "foo" to the pager and writes "bar" in the file "blurch": @@ -247,20 +303,19 @@ Most extensions (whether they require a C compiler or not) can be built, tested and installed with the standard mantra: perl Makefile.PL - nmake - nmake test - nmake install + $MAKE + $MAKE test + $MAKE install -Note the NMAKE that comes with Visual C++ is required. Some -extensions may not provide a testsuite (so "nmake test" -may not do anything, or fail), but most serious ones do. +where $MAKE stands for NMAKE or DMAKE. Some extensions may not +provide a testsuite (so "$MAKE test" may not do anything, or fail), +but most serious ones do. -If a module implements XSUBs, you will need a C compiler (Visual C++ -versions 2.0 and above are currently supported). You must make sure -you have set up the environment for the compiler for command-line -compilation. +If a module implements XSUBs, you will need one of the supported +C compilers. You must make sure you have set up the environment for +the compiler for command-line compilation. -If a module does not build for some reason, carefully look at +If a module does not build for some reason, look carefully for why it failed, and report problems to the module author. If it looks like the extension building support is at fault, report that with full details of how the build failed using the perlbug @@ -314,15 +369,23 @@ find a mailer on your system). =head1 BUGS AND CAVEATS -This port has not been tested as extensively as we'd like, and -therefore should be considered beta quality software. You should -expect changes in virtually all of these areas: build process, -installation structure, supported utilities/modules, and supported -perl functionality. In particular, functionality specific to the -Win32 environment may ultimately be supported as either core modules -or extensions. This means that you should be prepared to recompile -extensions when binary incompatibilites arise due to changes in the -internal structure of the code. +This port should be considered beta quality software at the present +time because some details are still in flux and there may be +changes in any of these areas: build process, installation structure, +supported utilities/modules, and supported perl functionality. +In particular, functionality specific to the Win32 environment may +ultimately be supported as either core modules or extensions. This +means that you should be prepared to recompile extensions when binary +incompatibilites arise due to changes in the internal structure of +the code. + +The DLLs produced by the two supported compilers are incompatible +with each other due to the conventions they use to export symbols, +and due to differences in the Runtime libraries that they provide. +This means that extension binaries built under either compiler will +only work with the perl binaries built under the same compiler. +If you know of a robust, freely available C Runtime that can +be used under win32, let us know. If you have had prior exposure to Perl on Unix platforms, you will notice this port exhibits behavior different from what is documented. Most of the @@ -344,8 +407,7 @@ bogus. The following functions are currently unavailable: C<fork()>, C<exec()>, C<dump()>, C<chown()>, C<link()>, C<symlink()>, C<chroot()>, C<setpgrp()>, C<getpgrp()>, C<setpriority()>, C<getpriority()>, -C<syscall()>, C<fcntl()>, C<flock()>. This list is possibly very -incomplete. +C<syscall()>, C<fcntl()>. This list is possibly very incomplete. =item * @@ -377,16 +439,21 @@ returned values or effects may be bogus. =item * -Signal handling may not behave as on Unix platforms. +Signal handling may not behave as on Unix platforms (where it +doesn't exactly "behave", either :). =item * File globbing may not behave as on Unix platforms. In particular, -globbing does not understand wildcards in the pathname component, -but only in the filename component. In other words, something like -"print <*/*.pl>" will not print all the perl scripts in all the -subdirectories one level under the current one (like it does on -UNIX platforms). +if you don't use perlglob.bat for globbing, it will understand +wildcards only in the filename component (and not in the pathname). +In other words, something like "print <*/*.pl>" will not print all the +perl scripts in all the subdirectories one level under the current one +(like it does on UNIX platforms). perlglob.exe is also dependent on +the particular implementation of wildcard expansion in the vendor +libraries used to build it (which varies wildly at the present time). +Using perlglob.bat (or File::DosGlob) avoids these limitations, but +still only provides DOS semantics (read "warts") for globbing. =back @@ -398,11 +465,11 @@ by C<perl -V>. =over 4 -=item Gary Ng <F<71564.1743@CompuServe.COM>> +Gary Ng E<lt>71564.1743@CompuServe.COME<gt> -=item Gurusamy Sarathy <F<gsar@umich.edu>> +Gurusamy Sarathy E<lt>gsar@umich.eduE<gt> -=item Nick Ing-Simmons <F<nick@ni-s.u-net.com>> +Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt> =back @@ -419,6 +486,9 @@ at the time. Nick Ing-Simmons and Gurusamy Sarathy have made numerous and sundry hacks since then. -Last updated: 15 May 1997 +Borland support was added in 5.004_01 (Gurusamy Sarathy). + +Last updated: 11 June 1997 =cut + diff --git a/config_h.SH b/config_h.SH index cfae03ad99..cfae03ad99 100644..100755 --- a/config_h.SH +++ b/config_h.SH @@ -34,7 +34,7 @@ #endif #ifdef I_UTIME -# ifdef WIN32 +# ifdef _MSC_VER # include <sys/utime.h> # else # include <utime.h> @@ -481,7 +481,10 @@ register GV *gv; #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else +# if !(defined(WIN32) && defined(__BORLANDC__)) + /* Borland runtime creates a readonly file! */ (void)chmod(oldname,filemode); +# endif #endif if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) { #ifdef HAS_FCHOWN @@ -722,7 +725,6 @@ I32 my_chsize(fd, length) I32 fd; /* file descriptor */ Off_t length; /* length to set file to */ { - extern long lseek(); struct flock fl; struct stat filebuf; @@ -1331,6 +1333,9 @@ SV **sp; char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; +#ifdef __linux__ /* XXX Need metaconfig test */ + union semun unsemds; +#endif id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; @@ -1359,11 +1364,29 @@ SV **sp; infosize = sizeof(struct semid_ds); else if (cmd == GETALL || cmd == SETALL) { +#ifdef __linux__ /* XXX Need metaconfig test */ +/* linux uses : + int semctl (int semid, int semnun, int cmd, union semun arg) + + union semun { + int val; + struct semid_ds *buf; + ushort *array; + }; +*/ + union semun semds; + if (semctl(id, 0, IPC_STAT, semds) == -1) +#else struct semid_ds semds; if (semctl(id, 0, IPC_STAT, &semds) == -1) +#endif return -1; getinfo = (cmd == GETALL); +#ifdef __linux__ /* XXX Need metaconfig test */ + infosize = semds.buf->sem_nsems * sizeof(short); +#else infosize = semds.sem_nsems * sizeof(short); +#endif /* "short" is technically wrong but much more portable than guessing about u_?short(_t)? */ } @@ -1406,7 +1429,12 @@ SV **sp; #endif #ifdef HAS_SEM case OP_SEMCTL: +#ifdef __linux__ /* XXX Need metaconfig test */ + unsemds.buf = (struct semid_ds *)a; + ret = semctl(id, n, cmd, unsemds); +#else ret = semctl(id, n, cmd, (struct semid_ds *)a); +#endif break; #endif #ifdef HAS_SHM @@ -308,6 +308,7 @@ #define lshift_ass_amg Perl_lshift_ass_amg #define lt_amg Perl_lt_amg #define magic_clearenv Perl_magic_clearenv +#define magic_clear_all_env Perl_magic_clear_all_env #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index bdf33b2410..746666636a 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -29,6 +29,12 @@ #include <a.out.h> #include <ldfcn.h> +/* If using PerlIO, redefine these macros from <ldfcn.h> */ +#ifdef USE_PERLIO +#define FSEEK(ldptr,o,p) PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p) +#define FREAD(p,s,n,ldptr) PerlIO_read(IOPTR(ldptr),p,s*n) +#endif + /* * We simulate dlopen() et al. through a call to load. Because AIX has * no call to find an exported symbol we read the loader section of the @@ -389,7 +395,13 @@ static int readExports(ModulePtr mp) ; return -1; } +/* This first case is a hack, since it assumes that the 3rd parameter to + FREAD is 1. See the redefinition of FREAD above to see how this works. */ +#ifdef USE_PERLIO + if (FREAD(ldbuf, sh.s_size, 1, ldp) != sh.s_size) { +#else if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { +#endif errvalid++; strcpy(errbuf, "readExports: cannot read loader section"); safefree(ldbuf); diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 678b7fd897..6214323c31 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -24,10 +24,18 @@ pack up your own arguments to pass as args for locking functions, etc. =head1 EXPORTED SYMBOLS -By default your system's F_* and O_* constants (eg, F_DUPFD and O_CREAT) -are exported into your namespace. You can request that the flock() -constants (LOCK_SH, LOCK_EX, LOCK_NB and LOCK_UN) be provided by using -the tag C<:flock>. See L<Exporter>. +By default your system's F_* and O_* constants (eg, F_DUPFD and +O_CREAT) and the FD_CLOEXEC constant are exported into your namespace. + +You can request that the flock() constants (LOCK_SH, LOCK_EX, LOCK_NB +and LOCK_UN) be provided by using the tag C<:flock>. See L<Exporter>. + +You can request that the old constants (FAPPEND, FASYNC, FCREAT, +FDEFER, FEXCL, FNDELAY, FNONBLOCK, FSYNC, FTRUNC) be provided for +compatibility reasons by using the tag C<:Fcompat>. For new +applications the newer versions of these constants are suggested +(O_APPEND, O_ASYNC, O_CREAT, O_DEFER, O_EXCL, O_NDELAY, O_NONBLOCK, +O_SYNC, O_TRUNC). Please refer to your native fcntl() and open() documentation to see what constants are implemented in your system. @@ -45,11 +53,12 @@ $VERSION = "1.03"; @EXPORT = qw( F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW - FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK + FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK F_POSIX O_CREAT O_EXCL O_NOCTTY O_TRUNC O_APPEND O_NONBLOCK O_NDELAY O_DEFER O_RDONLY O_RDWR O_WRONLY + O_BINARY O_TEXT O_EXLOCK O_SHLOCK O_ASYNC O_DSYNC O_RSYNC O_SYNC F_SETOWN F_GETOWN ); @@ -57,10 +66,13 @@ $VERSION = "1.03"; # Other items we are prepared to export if requested @EXPORT_OK = qw( LOCK_SH LOCK_EX LOCK_NB LOCK_UN + FAPPEND FASYNC FCREAT FDEFER FEXCL FNDELAY FNONBLOCK FSYNC FTRUNC ); # Named groups of exports %EXPORT_TAGS = ( - 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], + 'flock' => [qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN)], + 'Fcompat' => [qw(FAPPEND FASYNC FCREAT FDEFER FEXCL + FNDELAY FNONBLOCK FSYNC FTRUNC)], ); sub AUTOLOAD { diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index a94864332e..9034031c9c 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -75,6 +75,12 @@ int arg; #else goto not_there; #endif + if (strEQ(name, "F_POSIX")) +#ifdef F_POSIX + return F_POSIX; +#else + goto not_there; +#endif if (strEQ(name, "F_SETFL")) #ifdef F_SETFL return F_SETFL; @@ -119,13 +125,61 @@ int arg; #endif errno = EINVAL; return 0; - } else - if (strEQ(name, "FD_CLOEXEC")) + } + if (strEQ(name, "FAPPEND")) +#ifdef FAPPEND + return FAPPEND; +#else + goto not_there; +#endif + if (strEQ(name, "FASYNC")) +#ifdef FASYNC + return FASYNC; +#else + goto not_there; +#endif + if (strEQ(name, "FCREAT")) +#ifdef FCREAT + return FCREAT; +#else + goto not_there; +#endif + if (strEQ(name, "FD_CLOEXEC")) #ifdef FD_CLOEXEC return FD_CLOEXEC; #else goto not_there; #endif + if (strEQ(name, "FEXCL")) +#ifdef FEXCL + return FEXCL; +#else + goto not_there; +#endif + if (strEQ(name, "FNDELAY")) +#ifdef FNDELAY + return FNDELAY; +#else + goto not_there; +#endif + if (strEQ(name, "FNONBLOCK")) +#ifdef FNONBLOCK + return FNONBLOCK; +#else + goto not_there; +#endif + if (strEQ(name, "FSYNC")) +#ifdef FSYNC + return FSYNC; +#else + goto not_there; +#endif + if (strEQ(name, "FTRUNC")) +#ifdef FTRUNC + return FTRUNC; +#else + goto not_there; +#endif break; case 'L': if (strnEQ(name, "LOCK_", 5)) { diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL index 210879f90b..02dfd7d84f 100644 --- a/ext/SDBM_File/Makefile.PL +++ b/ext/SDBM_File/Makefile.PL @@ -5,11 +5,11 @@ use ExtUtils::MakeMaker; # config, all, clean, realclean and sdbm/Makefile # which perform the corresponding actions in the subdirectory. -$define = ($^O eq 'MSWin32') ? '/D "MSDOS"' : ''; +$define = ($^O eq 'MSWin32') ? '-DMSDOS' : ''; WriteMakefile( NAME => 'SDBM_File', - MYEXTLIB => 'sdbm/libsdbm$(LIB_EXT)', + MYEXTLIB => 'sdbm'.($^O eq 'MSWin32' ? '\\' : '/').'libsdbm$(LIB_EXT)', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'SDBM_File.pm', diff --git a/ext/SDBM_File/sdbm/Makefile.PL b/ext/SDBM_File/sdbm/Makefile.PL index 21ad7576c3..50fd83eb25 100644 --- a/ext/SDBM_File/sdbm/Makefile.PL +++ b/ext/SDBM_File/sdbm/Makefile.PL @@ -7,6 +7,7 @@ WriteMakefile( NAME => 'sdbm', # (doesn't matter what the name is here) oh yes it does LINKTYPE => 'static', DEFINE => $define, + INC => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's SKIP => [qw(dynamic dynamic_lib)], OBJECT => '$(O_FILES)', clean => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'}, diff --git a/global.sym b/global.sym index 50f8c5302b..4532d33bca 100644 --- a/global.sym +++ b/global.sym @@ -494,6 +494,7 @@ listkids localize looks_like_number magic_clearenv +magic_clear_all_env magic_clearpack magic_clearsig magic_existspack diff --git a/hints/newsos4.sh b/hints/newsos4.sh new file mode 100644 index 0000000000..a33cb3154a --- /dev/null +++ b/hints/newsos4.sh @@ -0,0 +1,34 @@ +# +# hints file for NEWS-OS 4.x +# + +echo +echo 'Compiling Tips:' +echo 'When you have found that ld complains "multiple defined" error' +echo 'on linking /lib/libdbm.a, do following instructions.' +echo ' cd /tmp (working on /tmp)' +echo ' cp /lib/libdbm.a dbm.o (copy current libdbm.a)' +echo ' ar cr libdbm.a dbm.o (make archive)' +echo ' mv /lib/libdbm.a /lib/libdbm.a.backup (backup original library)' +echo ' cp /tmp/libdbm.a /lib (copy newer one)' +echo ' ranlib /lib/libdbm.a (ranlib for later use)' +echo + +# No shared library. +so='none' +# Umm.. I like gcc. +cc='gcc' +# Configure does not find out where is libm. +plibpth='/usr/lib/cmplrs/cc' +# times() returns 'struct tms' +clocktype='struct tms' +# getgroups(2) returns integer (not gid_t) +groupstype='int' +# time(3) returns long (not time_t) +timetype='long' +# filemode type is int (not mode_t) +modetype='int' +# using sprintf(3) instead of gcvt(3) +d_Gconvert='sprintf((b),"%.*g",(n),(x))' +# No POSIX. +useposix='false' diff --git a/hints/next_3.sh b/hints/next_3.sh index 829d273a27..55e89591d8 100644 --- a/hints/next_3.sh +++ b/hints/next_3.sh @@ -74,7 +74,7 @@ cccdlflags=' ' # # archs=(m68k i386) # -archs=`/bin/lipo -info /usr/lib/libm.a | sed 's/^[^:]*:[^:]*: //'` +archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` # # leave the following part alone diff --git a/hints/next_4.sh b/hints/next_4.sh index 1108794868..316b339212 100644 --- a/hints/next_4.sh +++ b/hints/next_4.sh @@ -35,7 +35,7 @@ ld='cc' # # archs=(m68k i386) # -archs=`/bin/lipo -info /usr/lib/libm.a | sed 's/^[^:]*:[^:]*: //'` +archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` # # leave the following part alone diff --git a/hints/svr4.sh b/hints/svr4.sh index c91e13e052..dbae40d641 100644 --- a/hints/svr4.sh +++ b/hints/svr4.sh @@ -41,6 +41,21 @@ if [ "$uw_isuw" = "Release = 4.2MP" -a \ d_csh='undef' fi +# DDE SMES Supermax Enterprise Server +case "`uname -sm`" in +"UNIX_SV SMES") + if test "$cc" = '/bin/cc' -o "$gccversion" = "" + then + # for cc we need -K PIC (not -K pic) + cccdlflags="$cccdlflags -K PIC" + fi + # the *grent functions are in libgen. + libswanted="$libswanted gen" + # csh is broken (also) in SMES + d_csh='undef' + ;; +esac + cat <<'EOM' >&4 If you wish to use dynamic linking, you must use diff --git a/installhtml b/installhtml index d42faa17d6..72564d1aa8 100755 --- a/installhtml +++ b/installhtml @@ -1,5 +1,7 @@ #!/usr/bin/perl -w +use lib 'lib'; # use source library if present + use Config; # for config options in the makefile use Getopt::Long; # for command-line parsing use Cwd; @@ -32,15 +34,20 @@ pages found in the perl distribution. Displays the usage. +=item B<--podroot> POD search path base directory + +The base directory to search for all .pod and .pm files to be converted. +Default is current directory. + =item B<--podpath> POD search path The list of directories to search for .pod and .pm files to be converted. Default is `podroot/.'. -=item B<--podroot> POD search path base directory +=item B<--recurse> recurse on subdirectories -The base directory to search for all .pod and .pm files to be converted. -Default is current directory. +Whether or not to convert all .pm and .pod files found in subdirectories +too. Default is to not recurse. =item B<--htmldir> HTML destination directory @@ -52,22 +59,22 @@ be a path relative to the filesystem, not the resulting URL. The base directory which all resulting HTML files will be visible at in a URL. The default is `/'. -=item B<--recurse> recurse on subdirectories - -Whether or not to convert all .pm and .pod files found in subdirectories -too. Default is to not recurse. - =item B<--splithead> POD files to split on =head directive -Colon-separated list of pod files to split by the =head directive. These -files should have names specified relative to podroot. +Colon-separated list of pod files to split by the =head directive. The +.pod suffix is optional. These files should have names specified +relative to podroot. =item B<--splititem> POD files to split on =item directive Colon-separated list of all pod files to split by the =item directive. -I<installhtml> does not do the actual split, rather it invokes I<splitpod> -to do the dirty work. As with --splithead, these files should have names -specified relative to podroot. +The .pod suffix is optional. I<installhtml> does not do the actual +split, rather it invokes I<splitpod> to do the dirty work. As with +--splithead, these files should have names specified relative to podroot. + +=item B<--splitpod> Directory containing the splitpod program + +The directory containing the splitpod program. The default is `podroot/pod'. =item B<--libpods> library PODs for LE<lt>E<gt> links @@ -89,7 +96,7 @@ perl documentation: --podroot=/usr/src/perl \ --htmldir=/perl/nmanual \ --htmlroot=/perl/nmanual \ - --splithead=pod/perlipc.pod \ + --splithead=pod/perlipc \ --splititem=pod/perlfunc \ --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ --recurse \ @@ -129,8 +136,8 @@ Usage: $0 --help --podpath=<name>:...:<name> --podroot=<name> of a pod =head[1-6] directive. --splititem - comma-separated list of .pod or .pm files to split using splitpod. - --splitpod - where the program splitpod can be found (\$podroot/pod by - default). + --splitpod - directory where the program splitpod can be found + (\$podroot/pod by default). --verbose - self-explanatory. END_OF_USAGE @@ -150,6 +157,7 @@ $verbose = 0; # whether or not to print debugging info $pod2html = "pod/pod2html"; +usage("") unless @ARGV; # parse the command-line $result = GetOptions( qw( @@ -191,7 +199,7 @@ $splitpod = "$podroot/pod" unless $splitpod; # it may effect some of the links @splitdirs = (); # files in these directories won't get an index split_on_head($podroot, $htmldir, \@splitdirs, \@ignore, @splithead); -split_on_item($podroot, \@splitdirs, \@ignore, @splititem); +split_on_item($podroot, \@splitdirs, \@ignore, @splititem); # convert the pod pages found in @poddirs @@ -269,6 +277,15 @@ sub parse_command_line { } +sub absolute_path { + my($cwd, $path) = @_; + return "$cwd/$path" unless $path =~ m:/:; + # add cwd if path is not already an absolute path + $path = "$cwd/$path" if (substr($path,0,1) ne '/'); + return $path; +} + + sub create_index { my($html, $dir) = @_; my(@files, @filedata, @index, $file); @@ -346,6 +363,7 @@ sub split_on_item { print "splitting files by item.\n" if $verbose && $#splititem >= 0; $pwd = getcwd(); + my $splitter = absolute_path($pwd, "$splitpod/splitpod"); foreach $pod (@splititem) { # figure out the directory to split into $pod =~ s,^([^/]*)$,/$1,; @@ -364,8 +382,10 @@ sub split_on_item { } chdir("$podroot/$dirname") || die "$0: error changing to directory $podroot/$dirname: $!\n"; - system("../splitpod", "../$filename") && - warn "$0: error running '../splitpod ../$filename'" + die "$splitter not found. Use '-splitpod dir' option.\n" + unless -f $splitter; + system("perl", $splitter, "../$filename") && + warn "$0: error running '$splitter ../$filename'" ." from $podroot/$dirname"; } chdir($pwd); diff --git a/installman b/installman index c97febac2a..4d74bcfea2 100755 --- a/installman +++ b/installman @@ -63,9 +63,11 @@ runpod2man('utils', $man1dir, $man1ext, 'h2xs'); runpod2man('utils', $man1dir, $man1ext, 'perldoc'); runpod2man('utils', $man1dir, $man1ext, 'perlbug'); runpod2man('utils', $man1dir, $man1ext, 'pl2pm'); +runpod2man('utils', $man1dir, $man1ext, 'splain'); runpod2man('x2p', $man1dir, $man1ext, 's2p'); runpod2man('x2p', $man1dir, $man1ext, 'a2p.pod'); runpod2man('pod', $man1dir, $man1ext, 'pod2man'); +runpod2man('pod', $man1dir, $man1ext, 'pod2html'); # It would probably be better to have this page linked # to the c2ph man page. Or, this one could say ".so man1/c2ph.1", diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index e2d71700d4..c45483b02d 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -27,7 +27,7 @@ AUTOLOAD { } } my $save = $@; - eval {require $name}; + eval {local $SIG{__DIE__};require $name}; if ($@) { if (substr($AUTOLOAD,-9) eq '::DESTROY') { *$AUTOLOAD = sub {}; @@ -38,7 +38,7 @@ AUTOLOAD { # There is a slight risk that we could pick up the wrong file here # but autosplit should have warned about that when splitting. if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ - eval {require $name}; + eval {local $SIG{__DIE__};require $name}; } if ($@){ $@ =~ s/ at .*\n//; diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm index 2fd0cac32d..8019df7187 100644 --- a/lib/AutoSplit.pm +++ b/lib/AutoSplit.pm @@ -126,7 +126,7 @@ sub autosplit{ sub autosplit_lib_modules{ my(@modules) = @_; # list of Module names - foreach(@modules){ + while(defined($_ = shift @modules)){ s#::#/#g; # incase specified as ABC::XYZ s|\\|/|g; # bug in ksh OS/2 s#^lib/##; # incase specified as lib/*.pm @@ -147,6 +147,7 @@ sub autosplit_lib_modules{ sub autosplit_file{ my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_; my(@names); + local($_); # where to write output files $autodir = "lib/auto" unless $autodir; diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm index 11421a7f23..4390d0383e 100644 --- a/lib/CGI/Push.pm +++ b/lib/CGI/Push.pm @@ -148,14 +148,14 @@ prefer: $q->do_push(-next_page=>\&draw_a_page); -or- - + use CGI::Push qw(:standard); do_push(-next_page=>\&draw_a_page); Parameters are as follows: =over 4 - + =item -next_page do_push(-next_page=>\&my_draw_routine); @@ -234,6 +234,6 @@ This section intentionally left blank. =head1 SEE ALSO L<CGI::Carp>, L<CGI> - + =cut diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 32934a7054..c8b7b28301 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1440,6 +1440,7 @@ Trying with $funkyftp to get $want_compressed = $aslocal =~ s/\.gz//; my($source_switch) = ""; $source_switch = "-source" if $funkyftp =~ /\blynx$/; + $source_switch = "-c" if $funkyftp =~ /\bncftp$/; my($system) = "$funkyftp $source_switch '$url' > $aslocal"; my($wstatus); if (($wstatus = system($system)) == 0) { diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 71f553bcbf..bdf154375f 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -37,6 +37,8 @@ sub install { my(%hash) = %$hash; my(%pack, %write, $dir, $warn_permissions); + # -w doesn't work reliably on FAT dirs + $warn_permissions++ if $^O eq 'MSWin32'; local(*DIR, *P); for (qw/read write/) { $pack{$_}=$hash{$_}; diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index 2a43022638..9d15fe9edf 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -9,8 +9,9 @@ use Cwd 'cwd'; use File::Basename; sub ext { - if ($^O eq 'VMS') { return &_vms_ext; } - else { return &_unix_os2_ext; } + if ($^O eq 'VMS') { return &_vms_ext; } + elsif($^O eq 'MSWin32') { return &_win32_ext; } + else { return &_unix_os2_ext; } } sub _unix_os2_ext { @@ -181,6 +182,81 @@ sub _unix_os2_ext { ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path)); } +sub _win32_ext { + my($self, $potential_libs, $Verbose) = @_; + + # If user did not supply a list, we punt. + # (caller should probably use the list in $Config{libs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; + my($libs) = $Config{'libs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + + if ($libs and $potential_libs !~ /:nodefault/i) { + # If Config.pm defines a set of default libs, we always + # tack them on to the user-supplied list, unless the user + # specified :nodefault + + $potential_libs .= " " if $potential_libs; + $potential_libs .= $libs; + } + print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; + + # compute $extralibs from $potential_libs + + my(@searchpath); # from "-L/path" entries in $potential_libs + my(@libpath) = split " ", $libpth; + my(@extralibs); + my($fullname, $thislib, $thispth); + my($pwd) = cwd(); # from Cwd.pm + my($lib) = ''; + my($found) = 0; + + foreach $thislib (split ' ', $potential_libs){ + + # Handle possible linker path arguments. + if ($thislib =~ s/^-L// and not -d $thislib) { + print STDOUT "-L$thislib ignored, directory does not exist\n" + if $Verbose; + next; + } + elsif (-d $thislib) { + unless ($self->file_name_is_absolute($thislib)) { + print STDOUT "Warning: -L$thislib changed to -L$pwd/$thislib\n"; + $thislib = $self->catdir($pwd,$thislib); + } + push(@searchpath, $thislib); + next; + } + + # Handle possible library arguments. + $thislib =~ s/^-l//; + $thislib .= $libext if $thislib !~ /\Q$libext\E$/i; + + my($found_lib)=0; + foreach $thispth (@searchpath, @libpath){ + unless (-f ($fullname="$thispth\\$thislib")) { + print STDOUT "$thislib not found in $thispth\n" if $Verbose; + next; + } + print STDOUT "'$thislib' found at $fullname\n" if $Verbose; + $found++; + $found_lib++; + push(@extralibs, $fullname); + last; + } + print STDOUT "Note (probably harmless): " + ."No library found for '$thislib'\n" + unless $found_lib>0; + } + return ('','','','') unless $found; + $lib = join(' ',@extralibs); + print "Result: $lib\n" if $verbose; + wantarray ? ($lib, '', $lib, '') : $lib; +} + sub _vms_ext { my($self, $potential_libs,$verbose) = @_; @@ -327,7 +403,7 @@ ExtUtils::Liblist - determine libraries to use and how to use them C<require ExtUtils::Liblist;> -C<ExtUtils::Liblist::ext($potential_libs, $Verbose);> +C<ExtUtils::Liblist::ext($self, $potential_libs, $Verbose);> =head1 DESCRIPTION @@ -338,7 +414,9 @@ C<-L/another/path> this will affect the searches for all subsequent libraries. It returns an array of four scalar values: EXTRALIBS, BSLOADLIBS, -LDLOADLIBS, and LD_RUN_PATH. +LDLOADLIBS, and LD_RUN_PATH. Some of these don't mean anything +on VMS and Win32. See the details about those platform specifics +below. Dependent libraries can be linked in one of three ways: @@ -434,6 +512,58 @@ extensions originally designed for a Unix or VMS environment. If you encounter problems, or discover cases where the search could be improved, please let us know. +=head2 Win32 implementation + +The version of ext() which is executed under Win32 differs from the +Unix-OS/2 version in several respects: + +=over 2 + +=item * + +Input library and path specifications are accepted with or without the +C<-l> and C<-L> prefices used by Unix linkers. C<-lfoo> specifies the +library C<foo.lib> and C<-Ls:ome\dir> specifies a directory to look for +the libraries that follow. If neither prefix is present, a token is +considered a directory to search if it is in fact a directory, and a +library to search for otherwise. The C<$Config{lib_ext}> suffix will +be appended to any entries that are not directories and don't already +have the suffix. Authors who wish their extensions to be portable to +Unix or OS/2 should use the Unix prefixes, since the Unix-OS/2 version +of ext() requires them. + +=item * + +Entries cannot be plain object files, as many Win32 compilers will +not handle object files in the place of libraries. + +=item * + +If C<$potential_libs> is empty, the return value will be empty. +Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) +will be appended to the list of C<$potential_libs>. The libraries +will be searched for in the directories specified in C<$potential_libs> +as well as in C<$Config{libpth}>. For each library that is found, a +space-separated list of fully qualified library pathnames is generated. +You may specify an entry that matches C</:nodefault/i> in +C<$potential_libs> to disable the appending of default libraries +found in C<$Config{libs}> (this should be only needed very rarely). + +=item * + +The libraries specified may be a mixture of static libraries and +import libraries (to link with DLLs). Since both kinds are used +pretty transparently on the win32 platform, we do not attempt to +distinguish between them. + +=item * + +LDLOADLIBS and EXTRALIBS are always identical under Win32, and BSLOADLIBS +and LD_RUN_PATH are always empty (this may change in future). + +=back + + =head1 SEE ALSO L<ExtUtils::MakeMaker> diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index b051617c38..f24c5d0eb2 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -265,7 +265,7 @@ sub c_o { push @m, ' .C$(OBJ_EXT): $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C -' if $^O ne 'os2'; # Case-specific +' if $^O ne 'os2' and $^O ne 'MSWin32'; # Case-specific push @m, ' .cpp$(OBJ_EXT): $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp @@ -1113,6 +1113,7 @@ sub force { my($self) = shift; '# Phony target to force checking subdirectories. FORCE: + '.$self->{NOECHO}.'$(NOOP) '; } @@ -1913,7 +1914,7 @@ realclean :: last unless defined $from; my $todir = dirname($to); push @m, " -$to: $from $self->{MAKEFILE} $todir/.exists +$to: $from $self->{MAKEFILE} ".$self->catfile($todir,'.exists')." $self->{NOECHO}$self->{RM_F} $to $self->{CP} $from $to "; diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 23e8fdbe7d..da2a7638ca 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -1902,11 +1902,10 @@ pure_site_install :: # Ditto doc_perl_install :: $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp - $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp - $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp + $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp ],@docfiles, q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp - $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[ @@ -1915,11 +1914,10 @@ q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp # And again doc_site_install :: $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp - $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp - $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp + $(NOECHO) $(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES)|'" >>.MM_tmp ],@docfiles, q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,<STDIN>);]" >.MM2_tmp - $(NOECHO) $(PERL) -e "print q[print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp + $(NOECHO) $(PERL) -e "print q[print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];]" >>.MM2_tmp $(NOECHO) $(PERL) -e "print q[while(($key=shift) && ($val=shift)) ]" >>.MM2_tmp $(NOECHO) $(PERL) -e "print q[{print qq[=item *\\n\\nC<$key: $val>\\n\\n];}print qq[=back\\n\\n];]" >>.MM2_tmp $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[ diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index e3161b5412..3545f2c5a4 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -18,7 +18,7 @@ the semantics. =cut -#use Config; +use Config; #use Cwd; use File::Basename; require Exporter; @@ -29,6 +29,10 @@ Exporter::import('ExtUtils::MakeMaker', $ENV{EMXSHELL} = 'sh'; # to run `commands` unshift @MM::ISA, 'ExtUtils::MM_Win32'; +$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i; +$DMAKE = 1 if $Config{'make'} =~ /^dmake/i; +$NMAKE = 1 if $Config{'make'} =~ /^nmake/i; + sub dlsyms { my($self,%attribs) = @_; @@ -147,11 +151,167 @@ sub init_others $self->{'MV'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv'; $self->{'NOOP'} = 'rem'; $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f'; - $self->{'LD'} = 'link'; + $self->{'LD'} = $Config{'ld'} || 'link'; + $self->{'AR'} = $Config{'ar'} || 'lib'; + $self->{'LDLOADLIBS'} + ||= ( $BORLAND + ? 'import32.lib cw32mti.lib ' + : 'msvcrt.lib oldnames.lib kernel32.lib comdlg32.lib winspool.lib gdi32.lib ' + .'advapi32.lib user32.lib shell32.lib netapi32.lib ole32.lib ' + .'oleaut32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib ' + ) . ' odbc32.lib odbccp32.lib'; $self->{'DEV_NULL'} = '> NUL'; # $self->{'NOECHO'} = ''; # till we have it working } + +=item constants (o) + +Initializes lots of constants and .SUFFIXES and .PHONY + +=cut + +sub constants { + my($self) = @_; + my(@m,$tmp); + + for $tmp (qw/ + + AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION + VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB + INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS + INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB + INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB + PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB + FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC + PERL_INC PERL FULLPERL + + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, qq{ +VERSION_MACRO = VERSION +DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\" +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\" +}; + + push @m, qq{ +MAKEMAKER = $INC{'ExtUtils\MakeMaker.pm'} +MM_VERSION = $ExtUtils::MakeMaker::VERSION +}; + + push @m, q{ +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +}; + + for $tmp (qw/ + FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT + LDFROM LINKTYPE + / ) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, " +# Handy lists of source code files: +XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})." +C_FILES = ".join(" \\\n\t", @{$self->{C}})." +O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})." +H_FILES = ".join(" \\\n\t", @{$self->{H}})." +MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})." +MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})." +"; + + for $tmp (qw/ + INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT + /) { + next unless defined $self->{$tmp}; + push @m, "$tmp = $self->{$tmp}\n"; + } + + push @m, qq{ +.USESHELL : +} if $DMAKE; + + push @m, q{ +.NO_CONFIG_REC: Makefile +} if $ENV{CLEARCASE_ROOT}; + + # why not q{} ? -- emacs + push @m, qq{ +# work around a famous dec-osf make(1) feature(?): +makemakerdflt: all + +.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT) + +# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that +# some make implementations will delete the Makefile when we rebuild it. Because +# we call false(1) when we rebuild it. So make(1) is not completely wrong when it +# does so. Our milage may vary. +# .PRECIOUS: Makefile # seems to be not necessary anymore + +.PHONY: all config static dynamic test linkext manifest + +# Where is the Config information that we are using/depend on +CONFIGDEP = \$(PERL_ARCHLIB)\\Config.pm \$(PERL_INC)\\config.h +}; + + my @parentdir = split(/::/, $self->{PARENT_NAME}); + push @m, q{ +# Where to put things: +INST_LIBDIR = }. $self->catdir('$(INST_LIB)',@parentdir) .q{ +INST_ARCHLIBDIR = }. $self->catdir('$(INST_ARCHLIB)',@parentdir) .q{ + +INST_AUTODIR = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)') .q{ +INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)') .q{ +}; + + if ($self->has_link_code()) { + push @m, ' +INST_STATIC = $(INST_ARCHAUTODIR)\$(BASEEXT)$(LIB_EXT) +INST_DYNAMIC = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT) +INST_BOOT = $(INST_ARCHAUTODIR)\$(BASEEXT).bs +'; + } else { + push @m, ' +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = +'; + } + + $tmp = $self->export_list; + push @m, " +EXPORT_LIST = $tmp +"; + $tmp = $self->perl_archive; + push @m, " +PERL_ARCHIVE = $tmp +"; + +# push @m, q{ +#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{ +# +#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +#}; + + push @m, q{ +TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{ + +PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ +}; + + join('',@m); +} + + sub path { local $^W = 1; my($self) = @_; @@ -176,7 +336,7 @@ sub static_lib { my(@m); push(@m, <<'END'); -$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists +$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)\.exists $(RM_RF) $@ END # If this extension has it's own library (eg SDBM_File) @@ -184,21 +344,52 @@ END push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; push @m, -q{ lib -nologo -out:$@ $(OBJECT) - }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld +q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")' : '-out:$@ $(OBJECT)').q{ + }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld $(CHMOD) 755 $@ }; # Old mechanism - still available: - push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n" + push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs}."\n\n" if $self->{PERL_SRC}; push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('', "\n",@m); } +=item dynamic_bs (o) + +Defines targets for bootstrap files. + +=cut +sub dynamic_bs { + my($self, %attribs) = @_; + return ' +BOOTSTRAP = +' unless $self->has_link_code(); + + return ' +BOOTSTRAP = '."$self->{BASEEXT}.bs".' + +# As Mkbootstrap might not write a file (if none is required) +# we use touch to prevent make continually trying to remake it. +# The DynaLoader only reads a non-empty file. +$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)\.exists + '.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" + '.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ + -MExtUtils::Mkbootstrap \ + -e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');" + '.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP) + $(CHMOD) 644 $@ + +$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists + '."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT) + -'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT) + $(CHMOD) 644 $@ +'; +} =item dynamic_lib (o) @@ -212,7 +403,7 @@ sub dynamic_lib { return '' unless $self->has_link_code; - my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; + my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': ''); my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; my($ldfrom) = '$(LDFROM)'; my(@m); @@ -222,11 +413,13 @@ sub dynamic_lib { OTHERLDFLAGS = '.$otherldflags.' INST_DYNAMIC_DEP = '.$inst_dynamic_dep.' -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) +$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) '); - push(@m,' $(LD) -out:$@ $(LDDLFLAGS) '.$ldfrom. - ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)'); + push(@m, $BORLAND ? +q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} : +q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)} + ); push @m, ' $(CHMOD) 755 $@ '; @@ -257,7 +450,7 @@ sub canonpath { my($self,$path) = @_; $path =~ s/^([a-z]:)/\u$1/; $path =~ s|/|\\|g; - $path =~ s|\\+|\\|g ; # xx////xx -> xx/xx + $path =~ s|(.)\\+|$1\\|g ; # xx////xx -> xx/xx $path =~ s|(\\\.)+\\|\\|g ; # xx/././xx -> xx/xx $path =~ s|^(\.\\)+|| unless $path eq ".\\"; # ./xx -> xx $path =~ s|\\$|| @@ -294,11 +487,14 @@ sub pm_to_blib { pm_to_blib: $(TO_INST_PM) }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ - -e "pm_to_blib(qw{ <<pmfiles.dat },'}.$autodir.q{')" - }.q{ + -e "pm_to_blib(qw[ }. + ($NMAKE ? '<<pmfiles.dat' + : '$(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n)'). + q{ ],'}.$autodir.q{')" + }. ($NMAKE ? q{ $(PM_TO_BLIB) << - }.$self->{NOECHO}.q{$(TOUCH) $@ + } : '') . $self->{NOECHO}.q{$(TOUCH) $@ }; } @@ -313,6 +509,7 @@ sub test_via_harness { "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n"; } + =item tool_autosplit (override) Use Win32 quoting on command line. @@ -345,7 +542,7 @@ sub tools_other { my $bin_sh = $Config{sh} || 'cmd /c'; push @m, qq{ SHELL = $bin_sh -}; +} unless $DMAKE; # dmake determines its own shell for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) { push @m, "$_ = $self->{$_}\n"; @@ -378,12 +575,12 @@ UNINST=0 VERBINST=1 MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ --e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" +-e "install({ @ARGV },'$(VERBINST)',0,'$(UNINST)');" DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \ -e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', shift, '>';" \ -e "print '=over 4';" \ --e "while (defined($$key = shift) and defined($$val = shift)){print '=item *';print 'C<', \"$$key: $$val\", '>';}" \ +-e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \ -e "print '=back';" UNINSTALL = $(PERL) -MExtUtils::Install \ @@ -395,6 +592,100 @@ UNINSTALL = $(PERL) -MExtUtils::Install \ return join "", @m; } +=item xs_o (o) + +Defines suffix rules to go from XS to object files directly. This is +only intended for broken make implementations. + +=cut + +sub xs_o { # many makes are too dumb to use xs_c then c_o + my($self) = shift; + return '' +} + +=item top_targets (o) + +Defines the targets all, subdirs, config, and O_FILES + +=cut + +sub top_targets { +# --- Target Sections --- + + my($self) = shift; + my(@m); + push @m, ' +#all :: config $(INST_PM) subdirs linkext manifypods +'; + + push @m, ' +all :: pure_all manifypods + '.$self->{NOECHO}.'$(NOOP) +' + unless $self->{SKIPHASH}{'all'}; + + push @m, ' +pure_all :: config pm_to_blib subdirs linkext + '.$self->{NOECHO}.'$(NOOP) + +subdirs :: $(MYEXTLIB) + '.$self->{NOECHO}.'$(NOOP) + +config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)\.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_ARCHAUTODIR)\.exists + '.$self->{NOECHO}.'$(NOOP) + +config :: $(INST_AUTODIR)\.exists + '.$self->{NOECHO}.'$(NOOP) +'; + + push @m, qq{ +config :: Version_check + $self->{NOECHO}\$(NOOP) + +} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; + + push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); + + if (%{$self->{MAN1PODS}}) { + push @m, qq[ +config :: \$(INST_MAN1DIR)\\.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN1DIR)]); + } + if (%{$self->{MAN3PODS}}) { + push @m, qq[ +config :: \$(INST_MAN3DIR)\\.exists + $self->{NOECHO}\$(NOOP) + +]; + push @m, $self->dir_target(qw[$(INST_MAN3DIR)]); + } + + push @m, ' +$(O_FILES): $(H_FILES) +' if @{$self->{O_FILES} || []} && @{$self->{H} || []}; + + push @m, q{ +help: + perldoc ExtUtils::MakeMaker +}; + + push @m, q{ +Version_check: + }.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ + -MExtUtils::MakeMaker=Version_check \ + -e "Version_check('$(MM_VERSION)')" +}; + + join('',@m); +} + =item manifypods (o) We don't want manpage process. XXX add pod2html support later. @@ -479,7 +770,7 @@ subdirectories. sub pasthru { my($self) = shift; - return "PASTHRU = /nologo" + return "PASTHRU = " . ($NMAKE ? "-nologo" : ""); } diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index b03ccee7be..6d1746c31f 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -454,11 +454,17 @@ sub ExtUtils::MakeMaker::new { if (! $self->{PERL_SRC} ) { my($pthinks) = $self->canonpath($INC{'Config.pm'}); + my($cthinks) = $self->catfile($Config{'archlibexp'},'Config.pm'); $pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS; - if ($pthinks ne $self->catfile($Config{archlibexp},'Config.pm')){ - print "Have $pthinks expected ",$self->catfile($Config{archlibexp},'Config.pm'),"\n"; - $pthinks =~ s!/Config\.pm$!!; - $pthinks =~ s!.*/!!; + if ($pthinks ne $cthinks && + !($Is_Win32 and lc($pthinks) eq lc($cthinks))) { + print "Have $pthinks expected $cthinks\n"; + if ($Is_Win32) { + $pthinks =~ s![/\\]Config\.pm$!!i; $pthinks =~ s!.*[/\\]!!; + } + else { + $pthinks =~ s!/Config\.pm$!!; $pthinks =~ s!.*/!!; + } print STDOUT <<END; Your perl and your Config.pm seem to have different ideas about the architecture they are running on. diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index fd609152c3..73dc81d069 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -97,6 +97,7 @@ while (($name, $exp)= each %{$data->{IMPORTS}}) { sub _write_win32 { my($data) = @_; + require Config; if (not $data->{DLBASE}) { ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; @@ -109,6 +110,10 @@ sub _write_win32 { print DEF "CODE LOADONCALL\n"; print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; print DEF "EXPORTS\n "; + if ($Config::Config{'cc'} =~ /^bcc/i) { + for (@{$data->{DL_VARS}}) { $_ = "$_ = _$_" } + for (@{$data->{FUNCLIST}}) { $_ = "$_ = _$_" } + } print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}}; print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}}; if (%{$data->{IMPORTS}}) { diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index d7448a166e..6c83e1b2b0 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -127,6 +127,7 @@ else @ARGV == 1 or die $usage; ($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)# + or ($dir, $filename) = $ARGV[0] =~ m#(.*)\\(.*)# or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)# or ($dir, $filename) = ('.', $ARGV[0]); chdir($dir); diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm new file mode 100644 index 0000000000..e0887d122c --- /dev/null +++ b/lib/File/DosGlob.pm @@ -0,0 +1,201 @@ +#!perl -w + +# +# Documentation at the __END__ +# + +package File::DosGlob; + +unless (caller) { + $| = 1; + while (@ARGV) { + # + # We have to do this one by one for compatibility reasons. + # If an arg doesn't match anything, we are supposed to return + # the original arg. I know, it stinks, eh? + # + my $arg = shift; + my @m = doglob(1,$arg); + print (@m ? join("\0", sort @m) : $arg); + print "\0" if @ARGV; + } +} + +sub doglob { + my $cond = shift; + my @retval = (); + #print "doglob: ", join('|', @_), "\n"; + OUTER: + for my $arg (@_) { + local $_ = $arg; + my @matched = (); + my @globdirs = (); + my $head = '.'; + my $sepchr = '/'; + next OUTER unless defined $_ and $_ ne ''; + # if arg is within quotes strip em and do no globbing + if (/^"(.*)"$/) { + $_ = $1; + if ($cond eq 'd') { push(@retval, $_) if -d $_ } + else { push(@retval, $_) if -e $_ } + next OUTER; + } + if (m|^(.*)([\\/])([^\\/]*)$|) { + my $tail; + ($head, $sepchr, $tail) = ($1,$2,$3); + #print "div: |$head|$sepchr|$tail|\n"; + push (@retval, $_), next OUTER if $tail eq ''; + if ($head =~ /[*?]/) { + @globdirs = doglob('d', $head); + push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)), + next OUTER if @globdirs; + } + $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:$/; + $_ = $tail; + } + # + # If file component has no wildcards, we can avoid opendir + unless (/[*?]/) { + $head = '' if $head eq '.'; + $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr; + $head .= $_; + if ($cond eq 'd') { push(@retval,$head) if -d $head } + else { push(@retval,$head) if -e $head } + next OUTER; + } + opendir(D, $head) or next OUTER; + my @leaves = readdir D; + closedir D; + $head = '' if $head eq '.'; + $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr; + + # escape regex metachars but not glob chars + s:([].+^\-\${}[|]):\\$1:g; + # and convert DOS-style wildcards to regex + s/\*/.*/g; + s/\?/.?/g; + + #print "regex: '$_', head: '$head'\n"; + my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '$|io }'; + warn($@), next OUTER if $@; + INNER: + for my $e (@leaves) { + next INNER if $e eq '.' or $e eq '..'; + next INNER if $cond eq 'd' and ! -d "$head$e"; + push(@matched, "$head$e"), next INNER if &$matchsub($e); + # + # [DOS compatibility special case] + # Failed, add a trailing dot and try again, but only + # if name does not have a dot in it *and* pattern + # has a dot *and* name is shorter than 9 chars. + # + if (index($e,'.') == -1 and length($e) < 9 + and index($_,'\\.') != -1) { + push(@matched, "$head$e"), next INNER if &$matchsub("$e."); + } + } + push @retval, @matched if @matched; + } + return @retval; +} + +# +# this can be used to override CORE::glob +# by saying C<use File::DosGlob 'glob';>. +# +sub glob { doglob(1,@_) } + +sub import { + my $pkg = shift; + my $callpkg = caller(0); + my $sym = shift; + *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob'; +} + +1; + +__END__ + +=head1 NAME + +File::DosGlob - DOS like globbing and then some + +perlglob.bat - a more capable perlglob.exe replacement + +=head1 SYNOPSIS + + require 5.004; + use File::DosGlob 'glob'; # override CORE::glob + @perlfiles = glob "..\\pe?l/*.p?"; + print <..\\pe?l/*.p?>; + + # from the command line + > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>" + + > perlglob ../pe*/*p? + +=head1 DESCRIPTION + +A module that implements DOS-like globbing with a few enhancements. +This file is also a portable replacement for perlglob.exe. It +is largely compatible with perlglob.exe (the M$ setargv.obj +version) in all but one respect--it understands wildcards in +directory components. + +For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in +that it will find something like '..\lib\File/DosGlob.pm' alright). +Note that all path components are case-insensitive, and that +backslashes and forward slashes are both accepted, and preserved. +You may have to double the backslashes if you are putting them in +literally, due to double-quotish parsing of the pattern by perl. + +When invoked as a program, it will print null-separated filenames +to standard output. + +While one may replace perlglob.exe with this, usage by overriding +CORE::glob via importation should be much more efficient, because +it avoids launching a separate process, and is therefore strongly +recommended. + +Extending it to csh patterns is left as an exercise to the reader. + +=head1 EXPORTS (by request only) + +glob() + +=head1 BUGS + +Should probably be built into the core, and needs to stop +pandering to DOS habits. Needs a dose of optimizium too. + +=head1 AUTHOR + +Gurusamy Sarathy <gsar@umich.edu> + +=head1 HISTORY + +=over 4 + +=item * + +A few dir-vs-file optimizations result in glob importation being +10 times faster than using perlglob.exe, and using perlglob.bat is +only twice as slow as perlglob.exe (GSAR 28-MAY-97) + +=item * + +Several cleanups prompted by lack of compatible perlglob.exe +under Borland (GSAR 27-MAY-97) + +=item * + +Initial version (GSAR 20-FEB-97) + +=back + +=head1 SEE ALSO + +perl + +=cut + diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index aaefc3cdac..82453344d8 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -236,10 +236,13 @@ $top = 1; # true if we are at the top of the doc. used # to prevent the first <HR> directive. $paragraph = ''; # which paragraph we're processing (used # for error messages) -%pages = (); # associative array used to find the location - # of pages referenced by L<> links. %sections = (); # sections within this page -%items = (); # associative array used to find the location + +# These are not reinitialised here but are kept as a cache. +# See get_cache and related cache management code. +#%pages = (); # associative array used to find the location + # of pages referenced by L<> links. +#%items = (); # associative array used to find the location # of =item directives referenced by C<> links } @@ -252,7 +255,6 @@ sub pod2html { init_globals(); # cache of %pages and %items from last time we ran pod2html - my $podpath = ''; #undef $opt_help if defined $opt_help; @@ -281,6 +283,11 @@ sub pod2html { # scan the pod for =head[1-6] directives and build an index my $index = scan_headings(\%sections, @poddata); + unless($index) { + warn "No pod in $podfile\n" if $verbose; + return; + } + # open the output file open(HTML, ">$htmlfile") || die "$0: cannot open $htmlfile file for output: $!\n"; @@ -297,14 +304,19 @@ sub pod2html { } } + if (!$title and $podfile =~ /\.pod$/) { + # probably a split pod so take first =head[12] as title + for (my $i = 0; $i < @poddata; $i++) { + last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/; + } + warn "adopted '$title' as title for $podfile\n" + if $verbose and $title; + } unless ($title) { + warn "$0: no title for $podfile"; $podfile =~ /^(.*)(\.[^.\/]+)?$/; $title = ($podfile eq "-" ? 'No Title' : $1); - warn "found $title" if $verbose; - } - if ($title =~ /\.pm/) { - warn "$0: no title for $podfile"; - $title = $podfile; + warn "using $title" if $verbose; } print HTML <<END_OF_HEAD; <HTML> @@ -316,20 +328,8 @@ sub pod2html { END_OF_HEAD - # load a cache of %pages and %items if possible. $tests will be - # non-zero if successful. - my $tests = 0; - if (-f $dircache && -f $itemcache) { - warn "scanning for item cache\n" if $verbose; - $tests = find_cache($dircache, $itemcache, $podpath, $podroot); - } - - # if we didn't succeed in loading the cache then we must (re)build - # %pages and %items. - if (!$tests) { - warn "scanning directories in pod-path\n" if $verbose; - scan_podpath($podroot, $recurse); - } + # load/reload/validate/cache %pages and %items + get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse); # scan the pod for =item directives scan_items("", \%items, @poddata); @@ -492,12 +492,51 @@ sub parse_command_line { $netscape = $opt_netscape if defined $opt_netscape; } + +my $saved_cache_key; + +sub get_cache { + my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; + my @cache_key_args = @_; + + # A first-level cache: + # Don't bother reading the cache files if they still apply + # and haven't changed since we last read them. + + my $this_cache_key = cache_key(@cache_key_args); + + return if $saved_cache_key and $this_cache_key eq $saved_cache_key; + + # load the cache of %pages and %items if possible. $tests will be + # non-zero if successful. + my $tests = 0; + if (-f $dircache && -f $itemcache) { + warn "scanning for item cache\n" if $verbose; + $tests = load_cache($dircache, $itemcache, $podpath, $podroot); + } + + # if we didn't succeed in loading the cache then we must (re)build + # %pages and %items. + if (!$tests) { + warn "scanning directories in pod-path\n" if $verbose; + scan_podpath($podroot, $recurse, 0); + } + $saved_cache_key = cache_key(@cache_key_args); +} + +sub cache_key { + my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; + return join('!', $dircache, $itemcache, $recurse, + @$podpath, $podroot, stat($dircache), stat($itemcache)); +} + # -# find_cache - tries to find if the caches stored in $dircache and $itemcache +# load_cache - tries to find if the caches stored in $dircache and $itemcache # are valid caches of %pages and %items. if they are valid then it loads # them and returns a non-zero value. # -sub find_cache { + +sub load_cache { my($dircache, $itemcache, $podpath, $podroot) = @_; my($tests); local $_; @@ -511,7 +550,7 @@ sub find_cache { # is it the same podpath? $_ = <CACHE>; chomp($_); - $tests++ if (join(":", @podpath) eq $_); + $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; @@ -521,8 +560,6 @@ sub find_cache { # load the cache if its good if ($tests != 2) { close(CACHE); - - %items = (); return 0; } @@ -542,7 +579,7 @@ sub find_cache { # is it the same podpath? $_ = <CACHE>; chomp($_); - $tests++ if (join(":", @podpath) eq $_); + $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; @@ -552,9 +589,6 @@ sub find_cache { # load the cache if its good if ($tests != 2) { close(CACHE); - - %pages = (); - %items = (); return 0; } @@ -575,10 +609,15 @@ sub find_cache { # @libpods for =item directives. # sub scan_podpath { - my($podroot, $recurse) = @_; + my($podroot, $recurse, $append) = @_; my($pwd, $dir); my($libpod, $dirname, $pod, @files, @poddata); + unless($append) { + %items = (); + %pages = (); + } + # scan each directory listed in @podpath $pwd = getcwd(); chdir($podroot) @@ -916,7 +955,7 @@ sub process_over { # process_back - process a pod back tag and convert it to HTML format. # sub process_back { - warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignorning.\n" + warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignoring.\n" unless $listlevel; return unless $listlevel; diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index f723bb3500..2b6c6b6297 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -79,7 +79,7 @@ if($termcap and !$setuptermcap) { $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1)) || $ENV{COLUMNS} || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] - || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0] + || ($^O ne 'MSWin32' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]) || 72; @_ = ("<&STDIN") unless @_; diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm index 471be11fcd..9efcfbf3c4 100644 --- a/lib/Sys/Syslog.pm +++ b/lib/Sys/Syslog.pm @@ -201,7 +201,7 @@ sub connect { unless ($host) { require Sys::Hostname; my($host_uniq) = Sys::Hostname::hostname(); - ($host) = $host_uniq =~ /([\w\-]+)/; + ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) } my $udp = getprotobyname('udp'); my $syslog = getservbyname('syslog','udp'); diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index a52b558b22..105e6dd536 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -157,7 +157,7 @@ sub findConsole { if (-e "/dev/tty") { $console = "/dev/tty"; - } elsif (-e "con") { + } elsif (-e "con" or $^O eq 'MSWin32') { $console = "con"; } else { $console = "sys\$command"; diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 6979a11549..24e9148ff2 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -104,7 +104,8 @@ sub runtests { } $fh->close; # must close to reap child resource values my $wstatus = $?; - my $estatus = ($^O eq 'VMS' + my $estatus; + $estatus = ($^O eq 'VMS' ? eval 'use vmsish "status"; $estatus = $?' : $wstatus >> 8); if ($wstatus) { diff --git a/lib/chat2.pl b/lib/chat2.pl new file mode 100644 index 0000000000..0d9a7d3d50 --- /dev/null +++ b/lib/chat2.pl @@ -0,0 +1,368 @@ +# chat.pl: chat with a server +# Based on: V2.01.alpha.7 91/06/16 +# Randal L. Schwartz (was <merlyn@stonehenge.com>) +# multihome additions by A.Macpherson@bnr.co.uk +# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU> + +package chat; + +require 'sys/socket.ph'; + +if( defined( &main'PF_INET ) ){ + $pf_inet = &main'PF_INET; + $sock_stream = &main'SOCK_STREAM; + local($name, $aliases, $proto) = getprotobyname( 'tcp' ); + $tcp_proto = $proto; +} +else { + # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp' + # but who the heck would change these anyway? (:-) + $pf_inet = 2; + $sock_stream = 1; + $tcp_proto = 6; +} + + +$sockaddr = 'S n a4 x8'; +chop($thishost = `hostname`); + +# *S = symbol for current I/O, gets assigned *chatsymbol.... +$next = "chatsymbol000000"; # next one +$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ + + +## $handle = &chat'open_port("server.address",$port_number); +## opens a named or numbered TCP server + +sub open_port { ## public + local($server, $port) = @_; + + local($serveraddr,$serverproc); + + # We may be multi-homed, start with 0, fixup once connexion is made + $thisaddr = "\0\0\0\0" ; + $thisproc = pack($sockaddr, 2, 0, $thisaddr); + + *S = ++$next; + if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) { + $serveraddr = pack('C4', $1, $2, $3, $4); + } else { + local(@x) = gethostbyname($server); + return undef unless @x; + $serveraddr = $x[4]; + } + $serverproc = pack($sockaddr, 2, $port, $serveraddr); + unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) { + ($!) = ($!, close(S)); # close S while saving $! + return undef; + } + unless (bind(S, $thisproc)) { + ($!) = ($!, close(S)); # close S while saving $! + return undef; + } + unless (connect(S, $serverproc)) { + ($!) = ($!, close(S)); # close S while saving $! + return undef; + } +# We opened with the local address set to ANY, at this stage we know +# which interface we are using. This is critical if our machine is +# multi-homed, with IP forwarding off, so fix-up. + local($fam,$lport); + ($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S)); + $thisproc = pack($sockaddr, 2, 0, $thisaddr); +# end of post-connect fixup + select((select(S), $| = 1)[0]); + $next; # return symbol for switcharound +} + +## ($host, $port, $handle) = &chat'open_listen([$port_number]); +## opens a TCP port on the current machine, ready to be listened to +## if $port_number is absent or zero, pick a default port number +## process must be uid 0 to listen to a low port number + +sub open_listen { ## public + + *S = ++$next; + local($thisport) = shift || 0; + local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr); + local(*NS) = "__" . time; + unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) { + ($!) = ($!, close(NS)); + return undef; + } + unless (bind(NS, $thisproc_local)) { + ($!) = ($!, close(NS)); + return undef; + } + unless (listen(NS, 1)) { + ($!) = ($!, close(NS)); + return undef; + } + select((select(NS), $| = 1)[0]); + local($family, $port, @myaddr) = + unpack("S n C C C C x8", getsockname(NS)); + $S{"needs_accept"} = *NS; # so expect will open it + (@myaddr, $port, $next); # returning this +} + +## $handle = &chat'open_proc("command","arg1","arg2",...); +## opens a /bin/sh on a pseudo-tty + +sub open_proc { ## public + local(@cmd) = @_; + + *S = ++$next; + local(*TTY) = "__TTY" . time; + local($pty,$tty) = &_getpty(S,TTY); + die "Cannot find a new pty" unless defined $pty; + $pid = fork; + die "Cannot fork: $!" unless defined $pid; + unless ($pid) { + close STDIN; close STDOUT; close STDERR; + setpgrp(0,$$); + if (open(DEVTTY, "/dev/tty")) { + ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY + close DEVTTY; + } + open(STDIN,"<&TTY"); + open(STDOUT,">&TTY"); + open(STDERR,">&STDOUT"); + die "Oops" unless fileno(STDERR) == 2; # sanity + close(S); + exec @cmd; + die "Cannot exec @cmd: $!"; + } + close(TTY); + $next; # return symbol for switcharound +} + +# $S is the read-ahead buffer + +## $return = &chat'expect([$handle,] $timeout_time, +## $pat1, $body1, $pat2, $body2, ... ) +## $handle is from previous &chat'open_*(). +## $timeout_time is the time (either relative to the current time, or +## absolute, ala time(2)) at which a timeout event occurs. +## $pat1, $pat2, and so on are regexs which are matched against the input +## stream. If a match is found, the entire matched string is consumed, +## and the corresponding body eval string is evaled. +## +## Each pat is a regular-expression (probably enclosed in single-quotes +## in the invocation). ^ and $ will work, respecting the current value of $*. +## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. +## If pat is 'EOF', the body is executed if the process exits before +## the other patterns are seen. +## +## Pats are scanned in the order given, so later pats can contain +## general defaults that won't be examined unless the earlier pats +## have failed. +## +## The result of eval'ing body is returned as the result of +## the invocation. Recursive invocations are not thought +## through, and may work only accidentally. :-) +## +## undef is returned if either a timeout or an eof occurs and no +## corresponding body has been defined. +## I/O errors of any sort are treated as eof. + +$nextsubname = "expectloop000000"; # used for subroutines + +sub expect { ## public + if ($_[0] =~ /$nextpat/) { + *S = shift; + } + local($endtime) = shift; + + local($timeout,$eof) = (1,1); + local($caller) = caller; + local($rmask, $nfound, $timeleft, $thisbuf); + local($cases, $pattern, $action, $subname); + $endtime += time if $endtime < 600_000_000; + + if (defined $S{"needs_accept"}) { # is it a listen socket? + local(*NS) = $S{"needs_accept"}; + delete $S{"needs_accept"}; + $S{"needs_close"} = *NS; + unless(accept(S,NS)) { + ($!) = ($!, close(S), close(NS)); + return undef; + } + select((select(S), $| = 1)[0]); + } + + # now see whether we need to create a new sub: + + unless ($subname = $expect_subname{$caller,@_}) { + # nope. make a new one: + $expect_subname{$caller,@_} = $subname = $nextsubname++; + + $cases .= <<"EDQ"; # header is funny to make everything elsif's +sub $subname { + LOOP: { + if (0) { ; } +EDQ + while (@_) { + ($pattern,$action) = splice(@_,0,2); + if ($pattern =~ /^eof$/i) { + $cases .= <<"EDQ"; + elsif (\$eof) { + package $caller; + $action; + } +EDQ + $eof = 0; + } elsif ($pattern =~ /^timeout$/i) { + $cases .= <<"EDQ"; + elsif (\$timeout) { + package $caller; + $action; + } +EDQ + $timeout = 0; + } else { + $pattern =~ s#/#\\/#g; + $cases .= <<"EDQ"; + elsif (\$S =~ /$pattern/) { + \$S = \$'; + package $caller; + $action; + } +EDQ + } + } + $cases .= <<"EDQ" if $eof; + elsif (\$eof) { + undef; + } +EDQ + $cases .= <<"EDQ" if $timeout; + elsif (\$timeout) { + undef; + } +EDQ + $cases .= <<'ESQ'; + else { + $rmask = ""; + vec($rmask,fileno(S),1) = 1; + ($nfound, $rmask) = + select($rmask, undef, undef, $endtime - time); + if ($nfound) { + $nread = sysread(S, $thisbuf, 1024); + if ($nread > 0) { + $S .= $thisbuf; + } else { + $eof++, redo LOOP; # any error is also eof + } + } else { + $timeout++, redo LOOP; # timeout + } + redo LOOP; + } + } +} +ESQ + eval $cases; die "$cases:\n$@" if $@; + } + $eof = $timeout = 0; + do $subname(); +} + +## &chat'print([$handle,] @data) +## $handle is from previous &chat'open(). +## like print $handle @data + +sub print { ## public + if ($_[0] =~ /$nextpat/) { + *S = shift; + } + print S @_; + if( $chat'debug ){ + print STDERR "printed:"; + print STDERR @_; + } +} + +## &chat'close([$handle,]) +## $handle is from previous &chat'open(). +## like close $handle + +sub close { ## public + if ($_[0] =~ /$nextpat/) { + *S = shift; + } + close(S); + if (defined $S{"needs_close"}) { # is it a listen socket? + local(*NS) = $S{"needs_close"}; + delete $S{"needs_close"}; + close(NS); + } +} + +## @ready_handles = &chat'select($timeout, @handles) +## select()'s the handles with a timeout value of $timeout seconds. +## Returns an array of handles that are ready for I/O. +## Both user handles and chat handles are supported (but beware of +## stdio's buffering for user handles). + +sub select { ## public + local($timeout) = shift; + local(@handles) = @_; + local(%handlename) = (); + local(%ready) = (); + local($caller) = caller; + local($rmask) = ""; + for (@handles) { + if (/$nextpat/o) { # one of ours... see if ready + local(*SYM) = $_; + if (length($SYM)) { + $timeout = 0; # we have a winner + $ready{$_}++; + } + $handlename{fileno($_)} = $_; + } else { + $handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_; + } + } + for (sort keys %handlename) { + vec($rmask, $_, 1) = 1; + } + select($rmask, undef, undef, $timeout); + for (sort keys %handlename) { + $ready{$handlename{$_}}++ if vec($rmask,$_,1); + } + sort keys %ready; +} + +# ($pty,$tty) = $chat'_getpty(PTY,TTY): +# internal procedure to get the next available pty. +# opens pty on handle PTY, and matching tty on handle TTY. +# returns undef if can't find a pty. +# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik. + +sub _getpty { ## private + local($_PTY,$_TTY) = @_; + $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; + $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e; + local($pty, $tty, $kind); + if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992 + $kind = "pts"; ## SVR4 Streams + } else { + $kind = "pty"; ## BSD Clist stuff + } + for $bank (112..127) { + next unless -e sprintf("/dev/$kind%c0", $bank); + for $unit (48..57) { + $pty = sprintf("/dev/$kind%c%c", $bank, $unit); + open($_PTY,"+>$pty") || next; + select((select($_PTY), $| = 1)[0]); + ($tty = $pty) =~ s/pty/tty/; + open($_TTY,"+>$tty") || next; + select((select($_TTY), $| = 1)[0]); + system "stty nl>$tty"; + return ($pty,$tty); + } + } + undef; +} + +1; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 10016f3bb7..10016f3bb7 100755..100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm diff --git a/lib/ftp.pl b/lib/ftp.pl index 9528360da2..e671348105 100644 --- a/lib/ftp.pl +++ b/lib/ftp.pl @@ -88,7 +88,14 @@ # Initial revision # -require 'chat2.pl'; +eval { require 'chat2.pl' }; +die qq{$@ +The obsolete and problematic chat2.pl library has been removed from the +Perl distribution at the request of it's author. You can either get a +copy yourself or, preferably, fetch the new and much better Net::FTP +package from a CPAN ftp site. +} if $@ && $@ =~ /locate chat2.pl/; +die $@ if $@; eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n"; diff --git a/makeaperl.SH b/makeaperl.SH index 16b74350e0..16b74350e0 100644..100755 --- a/makeaperl.SH +++ b/makeaperl.SH @@ -591,7 +591,7 @@ MAGIC* mg; } #endif -#if !defined(OS2) && !defined(AMIGAOS) && !defined(_WIN32) +#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) /* And you'll never guess what the dog had */ /* in its mouth... */ if (tainting) { @@ -639,7 +639,7 @@ MAGIC* mg; } } } -#endif /* neither OS2 nor AMIGAOS nor _WIN32 */ +#endif /* neither OS2 nor AMIGAOS nor WIN32 */ return 0; } @@ -654,6 +654,45 @@ MAGIC* mg; } int +magic_clear_all_env(sv,mg) +SV* sv; +MAGIC* mg; +{ +#if defined(VMS) + die("Can't make list assignment to %%ENV on this system"); +#else +#ifdef WIN32 + char *envv = GetEnvironmentStrings(); + char *cur = envv; + STRLEN len; + while (*cur) { + char *end = strchr(cur,'='); + if (end && end != cur) { + *end = '\0'; + my_setenv(cur,Nullch); + *end = '='; + cur += strlen(end+1)+1; + } + else if ((len = strlen(cur))) + cur += len+1; + } + FreeEnvironmentStrings(envv); +#else + I32 i; + + if (environ == origenviron) + New(901, environ, 1, char*); + else + for (i = 0; environ[i]; i++) + Safefree(environ[i]); + environ[0] = Nullch; + +#endif +#endif + return 0; +} + +int magic_getsig(sv,mg) SV* sv; MAGIC* mg; @@ -1197,7 +1236,7 @@ SV* sv; croak(no_aelem, (I32)LvTARGOFF(sv)); } } - SvREFCNT_inc(value); + (void)SvREFCNT_inc(value); SvREFCNT_dec(LvTARG(sv)); LvTARG(sv) = value; LvTARGLEN(sv) = 0; @@ -1574,7 +1613,7 @@ MAGIC* mg; } /* can grab env area too? */ if (origenviron && origenviron[0] == s + 1) { - my_setenv("NoNeSuCh", Nullch); + my_setenv("NoNe SuCh", Nullch); /* force copy of environment */ for (i = 0; origenviron[i]; i++) if (origenviron[i] == s + 1) diff --git a/minimod.pl b/minimod.pl index 82760ee63d..82760ee63d 100644..100755 --- a/minimod.pl +++ b/minimod.pl @@ -985,6 +985,7 @@ I32 type; switch (op->op_type) { case OP_UNDEF: + modcount++; return op; case OP_CONST: if (!(op->op_private & (OPpCONST_ARYBASE))) @@ -2008,6 +2009,7 @@ OP *repl; if (op->op_type == OP_TRANS) return pmtrans(op, expr, repl); + hints |= HINT_BLOCK_SCOPE; pm = (PMOP*)op; if (expr->op_type == OP_CONST) { diff --git a/patchlevel.h b/patchlevel.h index 6d795a0fe7..b152f9c45e 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 4 -#define SUBVERSION 0 +#define SUBVERSION 1 /* local_patches -- list of locally applied less-than-subversion patches. @@ -2356,6 +2356,10 @@ register char **env; sv = newSVpv(s--,0); (void)hv_store(hv, *env, s - *env, sv, 0); *s = '='; +#if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV) + /* Sins of the RTL. See note in my_setenv(). */ + (void)putenv(savepv(*env)); +#endif } #endif #ifdef DYNAMIC_ENV_FETCH @@ -856,7 +856,9 @@ typedef struct loop LOOP; typedef struct Outrec Outrec; typedef struct interpreter PerlInterpreter; -typedef struct ff FF; +#ifndef __BORLANDC__ +typedef struct ff FF; /* XXX not defined anywhere, should go? */ +#endif typedef struct sv SV; typedef struct av AV; typedef struct hv HV; @@ -1381,37 +1383,37 @@ EXTCONST char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); EXTCONST char * vert INIT("|"); -EXTCONST char warn_uninit[] +EXTCONST char warn_uninit[] INIT("Use of uninitialized value"); -EXTCONST char warn_nosemi[] +EXTCONST char warn_nosemi[] INIT("Semicolon seems to be missing"); -EXTCONST char warn_reserved[] +EXTCONST char warn_reserved[] INIT("Unquoted string \"%s\" may clash with future reserved word"); -EXTCONST char warn_nl[] +EXTCONST char warn_nl[] INIT("Unsuccessful %s on filename containing newline"); -EXTCONST char no_wrongref[] +EXTCONST char no_wrongref[] INIT("Can't use %s ref as %s ref"); -EXTCONST char no_symref[] +EXTCONST char no_symref[] INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); -EXTCONST char no_usym[] +EXTCONST char no_usym[] INIT("Can't use an undefined value as %s reference"); -EXTCONST char no_aelem[] +EXTCONST char no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); -EXTCONST char no_helem[] +EXTCONST char no_helem[] INIT("Modification of non-creatable hash value attempted, subscript \"%s\""); -EXTCONST char no_modify[] +EXTCONST char no_modify[] INIT("Modification of a read-only value attempted"); -EXTCONST char no_mem[] +EXTCONST char no_mem[] INIT("Out of memory!\n"); -EXTCONST char no_security[] +EXTCONST char no_security[] INIT("Insecure dependency in %s%s"); -EXTCONST char no_sock_func[] +EXTCONST char no_sock_func[] INIT("Unsupported socket function \"%s\" called"); -EXTCONST char no_dir_func[] +EXTCONST char no_dir_func[] INIT("Unsupported directory function \"%s\" called"); -EXTCONST char no_func[] +EXTCONST char no_func[] INIT("The %s function is unimplemented"); -EXTCONST char no_myglob[] +EXTCONST char no_myglob[] INIT("\"my\" variable %s can't be in a package"); EXT SV sv_undef; @@ -1927,7 +1929,8 @@ EXT MGVTBL vtbl_sv = {magic_get, magic_set, magic_len, 0, 0}; -EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0}; +EXT MGVTBL vtbl_env = {0, 0, 0, magic_clear_all_env, + 0}; EXT MGVTBL vtbl_envelem = {0, magic_setenv, 0, magic_clearenv, 0}; diff --git a/perl_exp.SH b/perl_exp.SH index ef79876fce..06b587f9ef 100644 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -5,9 +5,9 @@ # Create the export list for perl. # Needed by AIX to do dynamic linking. # -# This simple program relys on 'global.sym' being up to date -# with all of the global symbols that a dynamicly link library -# might want to access. +# This simple program relys on 'global.sym' and other *.sym files +# being up to date with all of the global symbols that a dynamic +# link library might want to access. # # Most symbols have a Perl_ prefix because that's what embed.h sticks # in front of them. Variations depend on binary compatibility with @@ -57,6 +57,15 @@ y*) ;; esac +# +# If we use the PerlIO abstraction layer, add its symbols +# + +if [ $useperlio = "define" ] +then + grep '^[A-Za-z]' perlio.sym >> perl.exp +fi + # # Extra globals not included above (including a few that might # not actually be defined, but there's no harm in that). @@ -360,7 +360,11 @@ PerlIO *f; #ifdef HAS_SETLINEBUF setlinebuf(f); #else +# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */ + setvbuf(f, Nullch, _IOLBF, BUFSIZ); +# else setvbuf(f, Nullch, _IOLBF, 0); +# endif #endif } diff --git a/perlio.sym b/perlio.sym new file mode 100644 index 0000000000..d7a345c4cc --- /dev/null +++ b/perlio.sym @@ -0,0 +1,49 @@ +# Symbols which arise as part of the PerlIO abstraction + +PerlIO_stderr +PerlIO_stderr +PerlIO_stdin +PerlIO_stdout +PerlIO_fast_gets +PerlIO_has_cntptr +PerlIO_canset_cnt +PerlIO_set_cnt +PerlIO_set_ptrcnt +PerlIO_get_cnt +PerlIO_get_bufsiz +PerlIO_get_ptr +PerlIO_get_base +PerlIO_has_base +PerlIO_puts +PerlIO_open +PerlIO_fdopen +PerlIO_reopen +PerlIO_close +PerlIO_eof +PerlIO_getname +PerlIO_getc +PerlIO_error +PerlIO_clearerr +PerlIO_flush +PerlIO_fileno +PerlIO_setlinebuf +PerlIO_putc +PerlIO_ungetc +PerlIO_read +PerlIO_write +PerlIO_vprintf +PerlIO_tell +PerlIO_seek +PerlIO_rewind +PerlIO_printf +PerlIO_stdoutf +PerlIO_tmpfile +PerlIO_importFILE +PerlIO_exportFILE +PerlIO_findFILE +PerlIO_releaseFILE +PerlIO_init +PerlIO_setpos +PerlIO_getpos +PerlIO_vsprintf +PerlIO_sprintf diff --git a/pod/checkpods.PL b/pod/checkpods.PL index 4bec4da609..ccd78ec9cf 100644 --- a/pod/checkpods.PL +++ b/pod/checkpods.PL @@ -62,7 +62,10 @@ while (<>) { $exit = 1; } $last_blank = /^\s+$/; - close(ARGV) if eof; + if (eof) { + close(ARGV); + $last_blank = 0; + } } exit $exit !NO!SUBS! diff --git a/pod/perlbook.pod b/pod/perlbook.pod index d4bc876692..8005e81d29 100644 --- a/pod/perlbook.pod +++ b/pod/perlbook.pod @@ -33,3 +33,5 @@ of regular expressions in various languages including Perl. Mastering Regular Expressions (the Hip Owl Book): ISBN 1-56592-257-3 (English) + +A new edition of Learning Perl is due mid/late 1997. diff --git a/pod/perldata.pod b/pod/perldata.pod index 38d5e9380d..dc2975a7d4 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -196,7 +196,7 @@ You can truncate an array down to nothing by assigning the null list () to it. The following are equivalent: @whatever = (); - $#whatever = $[ - 1; + $#whatever = -1; If you evaluate a named array in a scalar context, it returns the length of the array. (Note that this is not true of lists, which return the diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 94ece44a6f..1b206fb96d 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -334,7 +334,7 @@ affects printing of return value after C<r> command. =item C<ornaments> -affects screen appearance of the command line (see L<Term::Readline>). +affects screen appearance of the command line (see L<Term::ReadLine>). =item C<frame> diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 9c85450dd0..4c944825bb 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -19,6 +19,13 @@ cannot be built there, for lack of a reasonable command interpreter. Most importantly, many bugs were fixed, including several security problems. See the F<Changes> file in the distribution for details. +=head2 List assignment to %ENV works + +C<%ENV = ()> and C<%ENV = @list> now work as expected (except on VMS +where it generates a fatal error). + +=head2 "Can't locate Foo.pm in @INC" error now lists @INC + =head2 Compilation option: Binary compatibility with 5.003 There is a new Configure question that asks if you want to maintain @@ -84,6 +91,13 @@ non-methods. The simple fix for old code is: In any module that used to depend on inheriting C<AUTOLOAD> for non-methods from a base class named C<BaseClass>, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during startup. +=head2 Previously deprecated %OVERLOAD is no longer usable + +Using %OVERLOAD to define overloading was deprecated in 5.003. +Overloading is now defined using the overload pragma. %OVERLOAD is +still used internally but should not be used by Perl scripts. See +L<overload> for more details. + =head2 Subroutine arguments created only when they're modified In Perl 5.004, nonexistent array and hash elements used as subroutine diff --git a/pod/perldiag.pod b/pod/perldiag.pod index ea33f50f9f..1b0f92e31f 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -630,6 +630,10 @@ method, nor does any of its base classes. See L<perlobj>. (W) The @ISA array contained the name of another package that doesn't seem to exist. +=item Can't make list assignment to \%ENV on this system + +(F) List assignment to %ENV is not supported on some systems, notably VMS. + =item Can't mktemp() (F) The mktemp() routine failed for some reason while trying to process @@ -893,7 +897,7 @@ a valid magic number. =item Deep recursion on subroutine "%s" (W) This subroutine has called itself (directly or indirectly) 100 -times than it has returned. This probably indicates an infinite +times more than it has returned. This probably indicates an infinite recursion, unless you're writing strange benchmark programs, in which case it indicates something else. @@ -2120,7 +2124,7 @@ think so. =item setruid() not implemented -(F) You tried to assign to C<$<lt>>, and your operating system doesn't support +(F) You tried to assign to C<$E<lt>>, and your operating system doesn't support the setruid() system call (or equivalent), or at least Configure didn't think so. @@ -2211,9 +2215,11 @@ construct. Remember that bracketing delimiters count nesting level. =item substr outside of string -(W) You tried to reference a substr() that pointed outside of a string. -That is, the absolute value of the offset was larger than the length of -the string. See L<perlfunc/substr>. +(S),(W) You tried to reference a substr() that pointed outside of a +string. That is, the absolute value of the offset was larger than the +length of the string. See L<perlfunc/substr>. This warning is +mandatory if substr is used in an lvalue context (as the left hand side +of an assignment or as a subroutine argument for example). =item suidperl is no longer needed since %s diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 79783a7d30..de10860987 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -37,7 +37,7 @@ Read on... L<Compiling your C program> -There's one example in each of the eight sections: +There's one example in each of the nine sections: L<Adding a Perl interpreter to your C program> @@ -55,8 +55,7 @@ L<Maintaining multiple interpreter instances> L<Using Perl modules, which themselves use C libraries, from your C program> -This documentation is Unix specific; if you have information about how -to embed Perl on other platforms, please send e-mail to <F<orwant@tpj.com>>. +L<Embedding Perl under Win32> =head2 Compiling your C program @@ -944,6 +943,41 @@ B<ExtUtils::Embed> can also automate writing the I<xs_init> glue code. Consult L<perlxs> and L<perlguts> for more details. +=head1 Embedding Perl under Win32 + +At the time of this writing, there are two versions of Perl which run +under Win32. Interfacing to Activeware's Perl library is quite +different from the examples in this documentation, as significant +changes were made to the internal Perl API. However, it is possible +to embed Activeware's Perl runtime, see the Perl for Win32 FAQ: +http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html + +With the "official" Perl version 5.004 or higher, all the examples +within this documentation will compile and run untouched, although, +the build process is slightly different between Unix and Win32. + +For starters, backticks don't work under the Win32 native command shell! +The ExtUtils::Embed kit on CPAN ships with a script called +B<genmake>, which generates a simple makefile to build a program from +a single C source file. It can be used like so: + + C:\ExtUtils-Embed\eg> perl genmake interp.c + C:\ExtUtils-Embed\eg> nmake + C:\ExtUtils-Embed\eg> interp -e "print qq{I'm embedded in Win32!\n}" + +You may wish to use a more robust environment such as the MS Developer +stdio. In this case, to generate perlxsi.c run: + + perl -MExtUtils::Embed -e xsinit + +Create a new project, Insert -> Files into Project: perlxsi.c, perl.lib, +and your own source files, e.g. interp.c. Typically you'll find +perl.lib in B<C:\perl\lib\CORE>, if not, you should see the B<CORE> +directory relative to C<perl -V:archlib>. +The studio will also need this path so it knows where to find Perl +include files. This path can be added via the Tools -> Options -> +Directories menu. Finnally, select Build -> Build interp.exe and +you're ready to go! =head1 MORAL diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index bcf03990bc..a5b505c4a7 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -371,7 +371,7 @@ suggests (assuming your string is contained in $text): If you want to represent quotation marks inside a quotation-mark-delimited field, escape them with backslashes (eg, -C<"like \"this\""). Unescaping them is a task addressed earlier in +C<"like \"this\"">. Unescaping them is a task addressed earlier in this section. Alternatively, the Text::ParseWords module (part of the standard perl diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod index 4fabce6f36..f4d3c12f6f 100644 --- a/pod/perlfaq8.pod +++ b/pod/perlfaq8.pod @@ -849,337 +849,3 @@ included with the 5.002 release of Perl. Copyright (c) 1997 Tom Christiansen and Nathan Torkington. All rights reserved. See L<perlfaq> for distribution information. - END-of-perlfaq8.pod -echo x - perlfaq9.pod -sed 's/^X//' >perlfaq9.pod << 'END-of-perlfaq9.pod' -=head1 NAME - -perlfaq9 - Networking ($Revision: 1.17 $, $Date: 1997/04/24 22:44:29 $) - -=head1 DESCRIPTION - -This section deals with questions related to networking, the internet, -and a few on the web. - -=head2 My CGI script runs from the command line but not the browser. Can you help me fix it? - -Sure, but you probably can't afford our contracting rates :-) - -Seriously, if you can demonstrate that you've read the following FAQs -and that your problem isn't something simple that can be easily -answered, you'll probably receive a courteous and useful reply to your -question if you post it on comp.infosystems.www.authoring.cgi (if it's -something to do with HTTP, HTML, or the CGI protocols). Questions that -appear to be Perl questions but are really CGI ones that are posted to -comp.lang.perl.misc may not be so well received. - -The useful FAQs are: - - http://www.perl.com/perl/faq/idiots-guide.html - http://www3.pair.com/webthing/docs/cgi/faqs/cgifaq.shtml - http://www.perl.com/perl/faq/perl-cgi-faq.html - http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html - http://www.boutell.com/faq/ - -=head2 How do I remove HTML from a string? - -The most correct way (albeit not the fastest) is to use HTML::Parse -from CPAN (part of the libwww-perl distribution, which is a must-have -module for all web hackers). - -Many folks attempt a simple-minded regular expression approach, like -C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags -may continue over line breaks, they may contain quoted angle-brackets, -or HTML comment may be present. Plus folks forget to convert -entities, like C<<> for example. - -Here's one "simple-minded" approach, that works for most files: - - #!/usr/bin/perl -p0777 - s/<(?:[^>'"]*|(['"]).*?\1)*>//gs - -If you want a more complete solution, see the 3-stage striphtml -program in -http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/striphtml.gz -. - -=head2 How do I extract URLs? - -A quick but imperfect approach is - - #!/usr/bin/perl -n00 - # qxurl - tchrist@perl.com - print "$2\n" while m{ - < \s* - A \s+ HREF \s* = \s* (["']) (.*?) \1 - \s* > - }gsix; - -This version does not adjust relative URLs, understand alternate -bases, deal with HTML comments, deal with HREF and NAME attributes in -the same tag, or accept URLs themselves as arguments. It also runs -about 100x faster than a more "complete" solution using the LWP suite -of modules, such as the -http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/xurl.gz -program. - -=head2 How do I download a file from the user's machine? How do I open a file on another machine? - -In the context of an HTML form, you can use what's known as -B<multipart/form-data> encoding. The CGI.pm module (available from -CPAN) supports this in the start_multipart_form() method, which isn't -the same as the startform() method. - -=head2 How do I make a pop-up menu in HTML? - -Use the B<E<lt>SELECTE<gt>> and B<E<lt>OPTIONE<gt>> tags. The CGI.pm -module (available from CPAN) supports this widget, as well as many -others, including some that it cleverly synthesizes on its own. - -=head2 How do I fetch an HTML file? - -One approach, if you have the lynx text-based HTML browser installed -on your system, is this: - - $html_code = `lynx -source $url`; - $text_data = `lynx -dump $url`; - -The libwww-perl (LWP) modules from CPAN provide a more powerful way to -do this. They work through proxies, and don't require lynx: - - # print HTML from a URL - use LWP::Simple; - getprint "http://www.sn.no/libwww-perl/"; - - # print ASCII from HTML from a URL - use LWP::Simple; - use HTML::Parse; - use HTML::FormatText; - my ($html, $ascii); - $html = get("http://www.perl.com/"); - defined $html - or die "Can't fetch HTML from http://www.perl.com/"; - $ascii = HTML::FormatText->new->format(parse_html($html)); - print $ascii; - -=head2 how do I decode or create those %-encodings on the web? - -Here's an example of decoding: - - $string = "http://altavista.digital.com/cgi-bin/query?pg=q&what=news&fmt=.&q=%2Bcgi-bin+%2Bperl.exe"; - $string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge; - -Encoding is a bit harder, because you can't just blindly change -all the non-alphanumunder character (C<\W>) into their hex escapes. -It's important that characters with special meaning like C</> and C<?> -I<not> be translated. Probably the easiest way to get this right is -to avoid reinventing the wheel and just use the URI::Escape module, -which is part of the libwww-perl package (LWP) available from CPAN. - -=head2 How do I redirect to another page? - -Instead of sending back a C<Content-Type> as the headers of your -reply, send back a C<Location:> header. Officially this should be a -C<URI:> header, so the CGI.pm module (available from CPAN) sends back -both: - - Location: http://www.domain.com/newpage - URI: http://www.domain.com/newpage - -Note that relative URLs in these headers can cause strange effects -because of "optimizations" that servers do. - -=head2 How do I put a password on my web pages? - -That depends. You'll need to read the documentation for your web -server, or perhaps check some of the other FAQs referenced above. - -=head2 How do I edit my .htpasswd and .htgroup files with Perl? - -The HTTPD::UserAdmin and HTTPD::GroupAdmin modules provide a -consistent OO interface to these files, regardless of how they're -stored. Databases may be text, dbm, Berkley DB or any database with a -DBI compatible driver. HTTPD::UserAdmin supports files used by the -`Basic' and `Digest' authentication schemes. Here's an example: - - use HTTPD::UserAdmin (); - HTTPD::UserAdmin - ->new(DB => "/foo/.htpasswd") - ->add($username => $password); - -=head2 How do I make sure users can't enter values into a form that cause my CGI script to do bad things? - -Read the CGI security FAQ, at -http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html, and the -Perl/CGI FAQ at -http://www.perl.com/CPAN/doc/FAQs/cgi/perl-cgi-faq.html. - -In brief: use tainting (see L<perlsec>), which makes sure that data -from outside your script (eg, CGI parameters) are never used in -C<eval> or C<system> calls. In addition to tainting, never use the -single-argument form of system() or exec(). Instead, supply the -command and arguments as a list, which prevents shell globbing. - -=head2 How do I parse an email header? - -For a quick-and-dirty solution, try this solution derived -from page 222 of the 2nd edition of "Programming Perl": - - $/ = ''; - $header = <MSG>; - $header =~ s/\n\s+/ /g; # merge continuation lines - %head = ( UNIX_FROM_LINE, split /^([-\w]+):\s*/m, $header ); - -That solution doesn't do well if, for example, you're trying to -maintain all the Received lines. A more complete approach is to use -the Mail::Header module from CPAN (part of the MailTools package). - -=head2 How do I decode a CGI form? - -A lot of people are tempted to code this up themselves, so you've -probably all seen a lot of code involving C<$ENV{CONTENT_LENGTH}> and -C<$ENV{QUERY_STRING}>. It's true that this can work, but there are -also a lot of versions of this floating around that are quite simply -broken! - -Please do not be tempted to reinvent the wheel. Instead, use the -CGI.pm or CGI_Lite.pm (available from CPAN), or if you're trapped in -the module-free land of perl1 .. perl4, you might look into cgi-lib.pl -(available from http://www.bio.cam.ac.uk/web/form.html). - -=head2 How do I check a valid email address? - -You can't. - -Without sending mail to the address and seeing whether it bounces (and -even then you face the halting problem), you cannot determine whether -an email address is valid. Even if you apply the email header -standard, you can have problems, because there are deliverable -addresses that aren't RFC-822 (the mail header standard) compliant, -and addresses that aren't deliverable which are compliant. - -Many are tempted to try to eliminate many frequently-invalid email -addresses with a simple regexp, such as -C</^[\w.-]+\@([\w.-]\.)+\w+$/>. However, this also throws out many -valid ones, and says nothing about potential deliverability, so is not -suggested. Instead, see -http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/ckaddr.gz , -which actually checks against the full RFC spec (except for nested -comments), looks for addresses you may not wish to accept email to -(say, Bill Clinton or your postmaster), and then makes sure that the -hostname given can be looked up in DNS. It's not fast, but it works. - -Here's an alternative strategy used by many CGI script authors: Check -the email address with a simple regexp (such as the one above). If -the regexp matched the address, accept the address. If the regexp -didn't match the address, request confirmation from the user that the -email address they entered was correct. - -=head2 How do I decode a MIME/BASE64 string? - -The MIME-tools package (available from CPAN) handles this and a lot -more. Decoding BASE64 becomes as simple as: - - use MIME::base64; - $decoded = decode_base64($encoded); - -A more direct approach is to use the unpack() function's "u" -format after minor transliterations: - - tr#A-Za-z0-9+/##cd; # remove non-base64 chars - tr#A-Za-z0-9+/# -_#; # convert to uuencoded format - $len = pack("c", 32 + 0.75*length); # compute length byte - print unpack("u", $len . $_); # uudecode and print - -=head2 How do I return the user's email address? - -On systems that support getpwuid, the $E<lt> variable and the -Sys::Hostname module (which is part of the standard perl distribution), -you can probably try using something like this: - - use Sys::Hostname; - $address = sprintf('%s@%s', getpwuid($<), hostname); - -Company policies on email address can mean that this generates addresses -that the company's email system will not accept, so you should ask for -users' email addresses when this matters. Furthermore, not all systems -on which Perl runs are so forthcoming with this information as is Unix. - -The Mail::Util module from CPAN (part of the MailTools package) provides a -mailaddress() function that tries to guess the mail address of the user. -It makes a more intelligent guess than the code above, using information -given when the module was installed, but it could still be incorrect. -Again, the best way is often just to ask the user. - -=head2 How do I send/read mail? - -Sending mail: the Mail::Mailer module from CPAN (part of the MailTools -package) is UNIX-centric, while Mail::Internet uses Net::SMTP which is -not UNIX-centric. Reading mail: use the Mail::Folder module from CPAN -(part of the MailFolder package) or the Mail::Internet module from -CPAN (also part of the MailTools package). - - # sending mail - use Mail::Internet; - use Mail::Header; - # say which mail host to use - $ENV{SMTPHOSTS} = 'mail.frii.com'; - # create headers - $header = new Mail::Header; - $header->add('From', 'gnat@frii.com'); - $header->add('Subject', 'Testing'); - $header->add('To', 'gnat@frii.com'); - # create body - $body = 'This is a test, ignore'; - # create mail object - $mail = new Mail::Internet(undef, Header => $header, Body => \[$body]); - # send it - $mail->smtpsend or die; - -=head2 How do I find out my hostname/domainname/IP address? - -A lot of code has historically cavalierly called the C<`hostname`> -program. While sometimes expedient, this isn't very portable. It's -one of those tradeoffs of convenience versus portability. - -The Sys::Hostname module (part of the standard perl distribution) will -give you the hostname after which you can find out the IP address -(assuming you have working DNS) with a gethostbyname() call. - - use Socket; - use Sys::Hostname; - my $host = hostname(); - my $addr = inet_ntoa(scalar(gethostbyname($name)) || 'localhost'); - -Probably the simplest way to learn your DNS domain name is to grok -it out of /etc/resolv.conf, at least under Unix. Of course, this -assumes several things about your resolv.conf configuration, including -that it exists. - -(We still need a good DNS domain name-learning method for non-Unix -systems.) - -=head2 How do I fetch a news article or the active newsgroups? - -Use the Net::NNTP or News::NNTPClient modules, both available from CPAN. -This can make tasks like fetching the newsgroup list as simple as: - - perl -MNews::NNTPClient - -e 'print News::NNTPClient->new->list("newsgroups")' - -=head2 How do I fetch/put an FTP file? - -LWP::Simple (available from CPAN) can fetch but not put. Net::FTP (also -available from CPAN) is more complex but can put as well as fetch. - -=head2 How can I do RPC in Perl? - -A DCE::RPC module is being developed (but is not yet available), and -will be released as part of the DCE-Perl package (available from -CPAN). No ONC::RPC module is known. - -=head1 AUTHOR AND COPYRIGHT - -Copyright (c) 1997 Tom Christiansen and Nathan Torkington. -All rights reserved. See L<perlfaq> for distribution information. - diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index d7faca02e3..aa942c2da0 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq9 - Networking ($Revision: 1.16 $, $Date: 1997/04/23 18:12:06 $) +perlfaq9 - Networking ($Revision: 1.17 $, $Date: 1997/04/24 22:44:29 $) =head1 DESCRIPTION @@ -295,7 +295,7 @@ give you the hostname after which you can find out the IP address use Socket; use Sys::Hostname; my $host = hostname(); - my $addr = inet_ntoa(scalar(gethostbyname($host || 'localhost'))); + my $addr = inet_ntoa(scalar(gethostbyname($name)) || 'localhost'); Probably the simplest way to learn your DNS domain name is to grok it out of /etc/resolv.conf, at least under Unix. Of course, this diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index e3c4c9546d..a28487ac1d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -448,7 +448,7 @@ successfully changed. See also L</oct>, if all you have is a string. =item chomp -This is a slightly safer version of chop (see below). It removes any +This is a slightly safer version of L</chop>. It removes any line ending that corresponds to the current value of C<$/> (also known as $INPUT_RECORD_SEPARATOR in the C<English> module). It returns the total number of characters removed from all its arguments. It's often used to @@ -1731,7 +1731,7 @@ it succeeded, FALSE otherwise. See example in L<perlipc/"Sockets: Client/Server A local modifies the listed variables to be local to the enclosing block, subroutine, C<eval{}>, or C<do>. If more than one value is listed, the list must be placed in parentheses. See L<perlsub/"Temporary Values via -local()"> for details. +local()"> for details, including issues with tied arrays and hashes. But you really probably want to be using my() instead, because local() isn't what most people think of as "local"). See L<perlsub/"Private Variables @@ -2335,10 +2335,10 @@ If EXPR is omitted, uses $_. =item rand -Returns a random fractional number between 0 and the value of EXPR. -(EXPR should be positive.) If EXPR is omitted, returns a value between -0 and 1. Automatically calls srand() unless srand() has already been -called. See also srand(). +Returns a random fractional number greater than or equal to 0 and less +than the value of EXPR. (EXPR should be positive.) If EXPR is +omitted, the value 1 is used. Automatically calls srand() unless +srand() has already been called. See also srand(). (Note: If your rand function consistently returns numbers that are too large or too small, then your version of Perl was probably compiled diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 2eb5229060..28c196017c 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -161,7 +161,7 @@ Take this code: sv_setsv(ST(0), sv); This code tries to return a new SV (which contains the value 42) if it should -return a real value, or undef otherwise. Instead it has returned a null +return a real value, or undef otherwise. Instead it has returned a NULL pointer which, somewhere down the line, will cause a segmentation violation, bus error, or just weird results. Change the zero to C<&sv_undef> in the first line and all will be well. @@ -225,9 +225,12 @@ The C<av_len> function returns the highest index value in array (just like $#array in Perl). If the array is empty, -1 is returned. The C<av_fetch> function returns the value at index C<key>, but if C<lval> is non-zero, then C<av_fetch> will store an undef value at that index. -The C<av_store> function stores the value C<val> at index C<key>. -note that C<av_fetch> and C<av_store> both return C<SV**>'s, not C<SV*>'s -as their return value. +The C<av_store> function stores the value C<val> at index C<key>, and does +not increment the reference count of C<val>. Thus the caller is responsible +for taking care of that, and if C<av_store> returns NULL, the caller will +have to decrement the reference count to avoid a memory leak. Note that +C<av_fetch> and C<av_store> both return C<SV**>'s, not C<SV*>'s as their +return value. void av_clear(AV*); void av_undef(AV*); @@ -247,6 +250,9 @@ by using the following: This returns NULL if the variable does not exist. +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use the array access functions on tied arrays. + =head2 Working with HVs To create an HV, you use the following routine: @@ -327,6 +333,9 @@ The hash algorithm is defined in the C<PERL_HASH(hash, key, klen)> macro: while (i--) hash = hash * 33 + *s++; +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use the hash access functions on tied hashes. + =head2 Hash API Extensions Beginning with version 5.004, the following functions are also supported: @@ -368,6 +377,10 @@ dealing with keys that are not C<SV*>s: HeKEY(HE* he) HeKLEN(HE* he) +Note that both C<hv_store> and C<hv_store_ent> do not increment the +reference count of the stored C<val>, which is the caller's responsibility. +If these functions return a NULL value, the caller will usually have to +decrement the reference count of C<val> to avoid a memory leak. =head2 References @@ -697,7 +710,7 @@ stored in the C<mg_type> field. The C<obj> argument is stored in the C<mg_obj> field of the C<MAGIC> structure. If it is not the same as the C<sv> argument, the reference count of the C<obj> object is incremented. If it is the same, or if -the C<how> argument is "#", or if it is a null pointer, then C<obj> is +the C<how> argument is "#", or if it is a NULL pointer, then C<obj> is merely stored, without the reference count being incremented. There is also a function to add magic to an C<HV>: @@ -813,6 +826,65 @@ This routine checks to see what types of magic C<sv> has. If the mg_type field is an uppercase letter, then the mg_obj is copied to C<nsv>, but the mg_type field is changed to be the lowercase letter. +=head2 Understanding the Magic of Tied Hashes and Arrays + +Tied hashes and arrays are magical beasts of the 'P' magic type. + +WARNING: As of the 5.004 release, proper usage of the array and hash +access functions requires understanding a few caveats. Some +of these caveats are actually considered bugs in the API, to be fixed +in later releases, and are bracketed with [MAYCHANGE] below. If +you find yourself actually applying such information in this section, be +aware that the behavior may change in the future, umm, without warning. + +The C<av_store> function, when given a tied array argument, merely +copies the magic of the array onto the value to be "stored", using +C<mg_copy>. It may also return NULL, indicating that the value did not +actually need to be stored in the array. [MAYCHANGE] After a call to +C<av_store> on a tied array, the caller will usually need to call +C<mg_set(val)> to actually invoke the perl level "STORE" method on the +TIEARRAY object. If C<av_store> did return NULL, a call to +C<SvREFCNT_dec(val)> will also be usually necessary to avoid a memory +leak. [/MAYCHANGE] + +The previous paragraph is applicable verbatim to tied hash access using the +C<hv_store> and C<hv_store_ent> functions as well. + +C<av_fetch> and the corresponding hash functions C<hv_fetch> and +C<hv_fetch_ent> actually return an undefined mortal value whose magic +has been initialized using C<mg_copy>. Note the value so returned does not +need to be deallocated, as it is already mortal. [MAYCHANGE] But you will +need to call C<mg_get()> on the returned value in order to actually invoke +the perl level "FETCH" method on the underlying TIE object. Similarly, +you may also call C<mg_set()> on the return value after possibly assigning +a suitable value to it using C<sv_setsv>, which will invoke the "STORE" +method on the TIE object. [/MAYCHANGE] + +[MAYCHANGE] +In other words, the array or hash fetch/store functions don't really +fetch and store actual values in the case of tied arrays and hashes. They +merely call C<mg_copy> to attach magic to the values that were meant to be +"stored" or "fetched". Later calls to C<mg_get> and C<mg_set> actually +do the job of invoking the TIE methods on the underlying objects. Thus +the magic mechanism currently implements a kind of lazy access to arrays +and hashes. + +Currently (as of perl version 5.004), use of the hash and array access +functions requires the user to be aware of whether they are operating on +"normal" hashes and arrays, or on their tied variants. The API may be +changed to provide more transparent access to both tied and normal data +types in future versions. +[/MAYCHANGE] + +You would do well to understand that the TIEARRAY and TIEHASH interfaces +are mere sugar to invoke some perl method calls while using the uniform hash +and array syntax. The use of this sugar imposes some overhead (typically +about two to four extra opcodes per FETCH/STORE operation, in addition to +the creation of all the mortal variables required to invoke the methods). +This overhead will be comparatively small if the TIE methods are themselves +substantial, but if they are only a few statements long, the overhead +will not be insignificant. + =head1 Subroutines =head2 XSUBs and the Argument Stack @@ -1191,6 +1263,9 @@ Returns the SV at the specified index in the array. The C<key> is the index. If C<lval> is set then the fetch will be part of a store. Check that the return value is non-null before dereferencing it to a C<SV*>. +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied arrays. + SV** av_fetch _((AV* ar, I32 key, I32 lval)); =item av_len @@ -1230,8 +1305,14 @@ Shifts an SV off the beginning of the array. =item av_store Stores an SV in an array. The array index is specified as C<key>. The -return value will be null if the operation failed, otherwise it can be -dereferenced to get the original C<SV*>. +return value will be NULL if the operation failed or if the value did not +need to be actually stored within the array (as in the case of tied arrays). +Otherwise it can be dereferenced to get the original C<SV*>. Note that the +caller is responsible for suitably incrementing the reference count of C<val> +before the call, and decrementing it if the function returned NULL. + +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied arrays. SV** av_store _((AV* ar, I32 key, SV* val)); @@ -1544,7 +1625,7 @@ and C<hv_free_ent>. Deletes a key/value pair in the hash. The value SV is removed from the hash and returned to the caller. The C<klen> is the length of the key. The -C<flags> value will normally be zero; if set to G_DISCARD then null will be +C<flags> value will normally be zero; if set to G_DISCARD then NULL will be returned. SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags)); @@ -1553,7 +1634,7 @@ returned. Deletes a key/value pair in the hash. The value SV is removed from the hash and returned to the caller. The C<flags> value will normally be zero; if set -to G_DISCARD then null will be returned. C<hash> can be a valid precomputed +to G_DISCARD then NULL will be returned. C<hash> can be a valid precomputed hash value, or 0 to ask for it to be computed. SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); @@ -1579,6 +1660,9 @@ C<klen> is the length of the key. If C<lval> is set then the fetch will be part of a store. Check that the return value is non-null before dereferencing it to a C<SV*>. +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied hashes. + SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval)); =item hv_fetch_ent @@ -1591,6 +1675,9 @@ before accessing it. The return value when C<tb> is a tied hash is a pointer to a static location, so be sure to make a copy of the structure if you need to store it somewhere. +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied hashes. + HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); =item hv_free_ent @@ -1658,8 +1745,14 @@ Returns the package name of a stash. See C<SvSTASH>, C<CvSTASH>. Stores an SV in a hash. The hash key is specified as C<key> and C<klen> is the length of the key. The C<hash> parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value will be -null if the operation failed, otherwise it can be dereferenced to get the -original C<SV*>. +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise it can +be dereferenced to get the original C<SV*>. Note that the caller is +responsible for suitably incrementing the reference count of C<val> +before the call, and decrementing it if the function returned NULL. + +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied hashes. SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash)); @@ -1668,9 +1761,15 @@ original C<SV*>. Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash> parameter is the precomputed hash value; if it is zero then Perl will compute it. The return value is the new hash entry so created. It will be -null if the operation failed or if the entry was stored in a tied hash. -Otherwise the contents of the return value can be accessed using the -C<He???> macros described here. +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise the +contents of the return value can be accessed using the C<He???> macros +described here. Note that the caller is responsible for suitably +incrementing the reference count of C<val> before the call, and decrementing +it if the function returned NULL. + +See L<Understanding the Magic of Tied Hashes and Arrays> for more +information on how to use this function on tied hashes. HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash)); @@ -1981,7 +2080,7 @@ Releases a Perl interpreter. See L<perlembed>. Returns the AV of the specified Perl array. If C<create> is set and the Perl variable does not exist then it will be created. If C<create> is not -set and the variable does not exist then null is returned. +set and the variable does not exist then NULL is returned. AV* perl_get_av _((char* name, I32 create)); @@ -1989,7 +2088,7 @@ set and the variable does not exist then null is returned. Returns the CV of the specified Perl sub. If C<create> is set and the Perl variable does not exist then it will be created. If C<create> is not -set and the variable does not exist then null is returned. +set and the variable does not exist then NULL is returned. CV* perl_get_cv _((char* name, I32 create)); @@ -1997,7 +2096,7 @@ set and the variable does not exist then null is returned. Returns the HV of the specified Perl hash. If C<create> is set and the Perl variable does not exist then it will be created. If C<create> is not -set and the variable does not exist then null is returned. +set and the variable does not exist then NULL is returned. HV* perl_get_hv _((char* name, I32 create)); @@ -2005,7 +2104,7 @@ set and the variable does not exist then null is returned. Returns the SV of the specified Perl scalar. If C<create> is set and the Perl variable does not exist then it will be created. If C<create> is not -set and the variable does not exist then null is returned. +set and the variable does not exist then NULL is returned. SV* perl_get_sv _((char* name, I32 create)); @@ -2957,4 +3056,4 @@ API Listing by Dean Roehrich <F<roehrich@cray.com>>. =head1 DATE -Version 31.7: 1997/5/1 +Version 31.8: 1997/5/17 diff --git a/pod/perllol.pod b/pod/perllol.pod index ac36364ae0..1de3b1ad74 100644 --- a/pod/perllol.pod +++ b/pod/perllol.pod @@ -270,7 +270,7 @@ $x run from 4..8 and $y run from 7 to 12? Hmm... here's the simple way: @newLoL = (); for ($startx = $x = 4; $x <= 8; $x++) { - for ($starty = $y = 7; $x <= 12; $y++) { + for ($starty = $y = 7; $y <= 12; $y++) { $newLoL[$x - $startx][$y - $starty] = $LoL[$x][$y]; } } diff --git a/pod/perlop.pod b/pod/perlop.pod index d853865520..32a0827cb3 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -392,7 +392,7 @@ As a scalar operator: As a list operator: for (101 .. 200) { print; } # print $_ 100 times - @foo = @foo[$[ .. $#foo]; # an expensive no-op + @foo = @foo[0 .. $#foo]; # an expensive no-op @foo = @foo[$#foo-4 .. $#foo]; # slice last 5 items The range operator (in a list context) makes use of the magical @@ -1058,7 +1058,7 @@ of filenames. The loop is equivalent to the following Perl-like pseudo code: - unshift(@ARGV, '-') if $#ARGV < $[; + unshift(@ARGV, '-') unless @ARGV; while ($ARGV = shift) { open(ARGV, $ARGV); while (<ARGV>) { diff --git a/pod/perlrun.pod b/pod/perlrun.pod index c4679e1def..de7116d939 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -567,6 +567,17 @@ The command used to load the debugger code. The default is: BEGIN { require 'perl5db.pl' } +=item PERL5SHELL (specific to WIN32 port) + +May be set to an alternative shell that perl must use internally for +executing "backtick" commands or system(). Perl doesn't use COMSPEC +for this purpose because COMSPEC has a high degree of variability +among users, leading to portability concerns. Besides, perl can use +a shell that may not be fit for interactive use, and setting COMSPEC +to such a shell may interfere with the proper functioning of other +programs (which usually look in COMSPEC to find a shell fit for +interactive use). + =item PERL_DEBUG_MSTATS Relevant only if your perl executable was built with B<-DDEBUGGING_MSTATS>, diff --git a/pod/perlsub.pod b/pod/perlsub.pod index c124f21c6a..d08426adab 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -58,7 +58,7 @@ it was assigned to.) Note that assigning to the whole array @_ removes the aliasing, and does not update any arguments. The return value of the subroutine is the value of the last expression -evaluated. Alternatively, a return statement may be used exit the +evaluated. Alternatively, a return statement may be used to exit the subroutine, optionally specifying the returned value, which will be evaluated in the appropriate context (list, scalar, or void) depending on the context of the subroutine call. If you specify no return value, @@ -469,6 +469,42 @@ both supply a list context to the right-hand side, while supplies a scalar context. +A note about C<local()> and composite types is in order. Something +like C<local(%foo)> works by temporarily placing a brand new hash in +the symbol table. The old hash is left alone, but is hidden "behind" +the new one. + +This means the old variable is completely invisible via the symbol +table (i.e. the hash entry in the C<*foo> typeglob) for the duration +of the dynamic scope within which the C<local()> was seen. This +has the effect of allowing one to temporarily occlude any magic on +composite types. For instance, this will briefly alter a tied +hash to some other implementation: + + tie %ahash, 'APackage'; + [...] + { + local %ahash; + tie %ahash, 'BPackage'; + [..called code will see %ahash tied to 'BPackage'..] + { + local %ahash; + [..%ahash is a normal (untied) hash here..] + } + } + [..%ahash back to its initial tied self again..] + +As another example, a custom implementation of C<%ENV> might look +like this: + + { + local %ENV; + tie %ENV, 'MyOwnEnv'; + [..do your own fancy %ENV manipulation here..] + } + [..normal %ENV behavior here..] + + =head2 Passing Symbol Table Entries (typeglobs) [Note: The mechanism described in this section was originally the only diff --git a/pod/perltoc.pod b/pod/perltoc.pod index d58f12cf86..989c1efe01 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -775,60 +775,7 @@ search path? =item AUTHOR AND COPYRIGHT -=item DESCRIPTION - -=over - -=item My CGI script runs from the command line but not the browser. Can -you help me fix it? - -=item How do I remove HTML from a string? - -=item How do I extract URLs? - -=item How do I download a file from the user's machine? How do I open a -file on another machine? - -=item How do I make a pop-up menu in HTML? - -=item How do I fetch an HTML file? - -=item how do I decode or create those %-encodings on the web? - -=item How do I redirect to another page? - -=item How do I put a password on my web pages? - -=item How do I edit my .htpasswd and .htgroup files with Perl? - -=item How do I make sure users can't enter values into a form that cause my -CGI script to do bad things? - -=item How do I parse an email header? - -=item How do I decode a CGI form? - -=item How do I check a valid email address? - -=item How do I decode a MIME/BASE64 string? - -=item How do I return the user's email address? - -=item How do I send/read mail? - -=item How do I find out my hostname/domainname/IP address? - -=item How do I fetch a news article or the active newsgroups? - -=item How do I fetch/put an FTP file? - -=item How can I do RPC in Perl? - -=back - -=item AUTHOR AND COPYRIGHT - -=head2 perlfaq9 - Networking ($Revision: 1.16 $, $Date: 1997/04/23 18:12:06 +=head2 perlfaq9 - Networking ($Revision: 1.17 $, $Date: 1997/04/24 22:44:29 $) =item DESCRIPTION @@ -894,6 +841,10 @@ CGI script to do bad things? =over +=item List assignment to %ENV works + +=item "Can't locate Foo.pm in @INC" error now lists @INC + =item Compilation option: Binary compatibility with 5.003 =item $PERL5OPT environment variable @@ -904,6 +855,8 @@ CGI script to do bad things? =item Deprecated: Inherited C<AUTOLOAD> for non-methods +=item Previously deprecated %OVERLOAD is no longer usable + =item Subroutine arguments created only when they're modified =item Group vector changeable with C<$)> @@ -1241,8 +1194,8 @@ B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I<name>, B<-w>, B<-x> I<directory> =item ENVIRONMENT -HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, -PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL +HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL +(specific to WIN32 port), PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL =head2 perlfunc - Perl builtin functions @@ -2194,6 +2147,8 @@ program =back +=item Embedding Perl under Win32 + =item MORAL =item AUTHOR @@ -2408,6 +2363,8 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)> =item Finding Magic +=item Understanding the Magic of Tied Hashes and Arrays + =back =item Subroutines @@ -3518,6 +3475,8 @@ For static extensions, For dynamic extensions, For dynamic extensions =item VMS implementation +=item Win32 implementation + =back =item SEE ALSO @@ -3609,9 +3568,10 @@ ExtUtils::MakeMaker =item DESCRIPTION -catfile, static_lib (o), dynamic_lib (o), canonpath, perl_script, -pm_to_blib, test_via_harness (o), tool_autosplit (override), tools_other -(o), manifypods (o), dist_ci (o), dist_core (o), pasthru (o) +catfile, constants (o), static_lib (o), dynamic_bs (o), dynamic_lib (o), +canonpath, perl_script, pm_to_blib, test_via_harness (o), tool_autosplit +(override), tools_other (o), xs_o (o), top_targets (o), manifypods (o), +dist_ci (o), dist_core (o), pasthru (o) =head2 ExtUtils::MakeMaker - create an extension Makefile @@ -3786,6 +3746,22 @@ rmscopy($from,$to[,$date_flag]) =item AUTHOR +=head2 File::DosGlob - DOS like globbing and then some + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXPORTS (by request only) + +=item BUGS + +=item AUTHOR + +=item HISTORY + +=item SEE ALSO + =head2 File::Find, find - traverse a file tree =item SYNOPSIS diff --git a/pod/perltoot.pod b/pod/perltoot.pod index 2f5634c58c..3a35c05b90 100644 --- a/pod/perltoot.pod +++ b/pod/perltoot.pod @@ -89,7 +89,7 @@ the same name as the class as the constructor. =head2 Object Representation By far the most common mechanism used in Perl to represent a Pascal -record, a C struct, or a C++ class an anonymous hash. That's because a +record, a C struct, or a C++ class is an anonymous hash. That's because a hash has an arbitrary number of data fields, each conveniently accessed by an arbitrary name of your own devising. @@ -799,7 +799,7 @@ base class. If the original base class has been designed properly, then the new derived class can be used as a drop-in replacement for the old one. This means you should be able to write a program like this: - use Employee + use Employee; my $empl = Employee->new(); $empl->name("Jason"); $empl->age(23); diff --git a/pod/pod2man.PL b/pod/pod2man.PL index cd14ce2866..2c1837a37a 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -444,6 +444,7 @@ if ($name ne 'something') { last FCHECK; } next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME + next if /^=pod\b/; # It is OK to have =pod before NAME die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax; } die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax; @@ -499,16 +500,36 @@ print <<"END"; .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch .ds L" "" .ds R" "" +''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of +''' \\*(L" and \\*(R", except that they are used on ".xx" lines, +''' such as .IP and .SH, which do another additional levels of +''' double-quote interpretation +.ds M" """ +.ds S" """ +.ds N" """"" +.ds T" """"" .ds L' ' .ds R' ' +.ds M' ' +.ds S' ' +.ds N' ' +.ds T' ' 'br\\} .el\\{\\ .ds -- \\(em\\| .tr \\*(Tr .ds L" `` .ds R" '' +.ds M" `` +.ds S" '' +.ds N" `` +.ds T" '' .ds L' ` .ds R' ' +.ds M' ` +.ds S' ' +.ds N' ` +.ds T' ' .ds PI \\(*p 'br\\} END @@ -706,6 +727,10 @@ while (<>) { # trofficate backslashes; must do it before what happens below s/\\/noremap('\\e')/ge; +# protect leading periods and quotes against *roff +# mistaking them for directives +s/^(?:[A-Z]<)?[.']/\\&$&/gm; + # first hide the escapes in case we need to # intuit something and get it wrong due to fmting @@ -833,8 +858,19 @@ while (<>) { ($Cmd, $_) = split(' ', $_, 2); + $dotlevel = 1; + if ($Cmd eq 'head1') { + $dotlevel = 1; + } + elsif ($Cmd eq 'head2') { + $dotlevel = 1; + } + elsif ($Cmd eq 'item') { + $dotlevel = 2; + } + if (defined $_) { - &escapes; + &escapes($dotlevel); s/"/""/g; } @@ -883,7 +919,7 @@ while (<>) { if ($needspace) { &makespace; } - &escapes; + &escapes(0); clear_noremap(1); print $_, "\n"; $needspace = 1; @@ -915,6 +951,7 @@ sub nobreak { } sub escapes { + my $indot = shift; s/X<(.*?)>/mkindex($1)/ge; @@ -927,9 +964,19 @@ sub escapes { s/([^"])--"/$1\\*(--"/g; # fix up quotes; this is somewhat tricky + my $dotmacroL = 'L'; + my $dotmacroR = 'R'; + if ( $indot == 1 ) { + $dotmacroL = 'M'; + $dotmacroR = 'S'; + } + elsif ( $indot >= 2 ) { + $dotmacroL = 'N'; + $dotmacroR = 'T'; + } if (!/""/) { - s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge; - s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge; + s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge; + s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; } #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; diff --git a/pod/roffitall b/pod/roffitall index d69054f41b..cbd19af4fe 100644 --- a/pod/roffitall +++ b/pod/roffitall @@ -180,14 +180,22 @@ fi #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw +# First, create the raw data run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" echo "$me: running $run" eval $run $toroff + +#Now create the TOC echo "$me: parsing TOC" ./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" echo "$me: running $run" eval $run + +# Finally, recreate the Doc, without the blank page 0 +run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" +echo "$me: running $run" +eval $run $toroff rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" diff --git a/pod/splitpod b/pod/splitpod index 8db4060370..889dfa215a 100755 --- a/pod/splitpod +++ b/pod/splitpod @@ -18,7 +18,7 @@ while (<>) { } else { #s,L</,L<POSIX/,g; s,L</,L<perlfunc/,g; - $pod{$cur} .= $_ if $cur; + push @{$pod{$cur} ||= []}, $_ if $cur; } } @@ -27,6 +27,12 @@ for $f ( keys %syn ) { $flavor = $Flavor{$f}; $orig = $f; ($name = $f) =~ s/\W//g; + # deal with unbalanced =over and =back cause by the split + my $body = $pod{$orig}; + my $has_over = $body =~ /^=over/; + my $has_back = $body =~ /^=back/; + $body =~ s/^=over\s*//m if $has_over and !$has_back; + $body =~ s/^=back\s*//m if $has_back and !$has_over; open (POD, "> $name.pod") || die "can't open $name.pod: $!"; print POD <<EOF; =head1 NAME @@ -39,7 +45,7 @@ $syn{$orig} =head1 DESCRIPTION -$pod{$orig} +$body EOF @@ -178,7 +178,7 @@ PP(pp_rv2gv) GV *gv = (GV*) sv_newmortal(); gv_init(gv, 0, "", 0, 0); GvIOp(gv) = (IO *)sv; - SvREFCNT_inc(sv); + (void)SvREFCNT_inc(sv); sv = (SV*) gv; } else if (SvTYPE(sv) != SVt_PVGV) DIE("Not a GLOB reference"); @@ -776,6 +776,8 @@ PP(pp_modulo) if ((left_neg != right_neg) && ans) ans = right - ans; if (right_neg) { + /* XXX may warn: unary minus operator applied to unsigned type */ + /* could change -foo to be (~foo)+1 instead */ if (ans <= -(UV)IV_MAX) sv_setiv(TARG, (IV) -ans); else @@ -724,7 +724,7 @@ PP(pp_sort) cx->blk_gimme = G_SCALAR; PUSHSUB(cx); if (!CvDEPTH(cv)) - SvREFCNT_inc(cv); /* in preparation for POPSUB */ + (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ } sortcxix = cxstack_ix; @@ -773,6 +773,7 @@ PP(pp_flip) sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); if (op->op_flags & OPf_SPECIAL) { sv_setiv(targ, 1); + SETs(targ); RETURN; } else { @@ -2306,10 +2307,21 @@ PP(pp_require) if (!tryrsfp) { if (op->op_type == OP_REQUIRE) { SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name)); + SV *dirmsgsv = NEWSV(0, 0); + AV *ar = GvAVn(incgv); + I32 i; if (instr(SvPVX(msg), ".h ")) sv_catpv(msg, " (change .h to .ph maybe?)"); if (instr(SvPVX(msg), ".ph ")) sv_catpv(msg, " (did you run h2ph?)"); + sv_catpv(msg, " (@INC contains:"); + for (i = 0; i <= AvFILL(ar); i++) { + char *dir = SvPVx(*av_fetch(ar, i, TRUE), na); + sv_setpvf(dirmsgsv, " %s", dir); + sv_catsv(msg, dirmsgsv); + } + sv_catpvn(msg, ")", 1); + SvREFCNT_dec(dirmsgsv); DIE("%_", msg); } @@ -625,13 +625,17 @@ PP(pp_aassign) av_extend(ary, lastrelem - relem); i = 0; while (relem <= lastrelem) { /* gobble up all the rest */ + SV **didstore; sv = NEWSV(28,0); assert(*relem); sv_setsv(sv,*relem); *(relem++) = sv; - (void)av_store(ary,i++,sv); - if (magic) + didstore = av_store(ary,i++,sv); + if (magic) { mg_set(sv); + if (!didstore) + SvREFCNT_dec(sv); + } TAINT_NOT; } break; @@ -644,6 +648,7 @@ PP(pp_aassign) while (relem < lastrelem) { /* gobble up all the rest */ STRLEN len; + HE *didstore; if (*relem) sv = *(relem++); else @@ -652,9 +657,12 @@ PP(pp_aassign) if (*relem) sv_setsv(tmpstr,*relem); /* value */ *(relem++) = tmpstr; - (void)hv_store_ent(hash,sv,tmpstr,0); - if (magic) + didstore = hv_store_ent(hash,sv,tmpstr,0); + if (magic) { mg_set(tmpstr); + if (!didstore) + SvREFCNT_dec(tmpstr); + } TAINT_NOT; } if (relem == lastrelem) @@ -71,7 +71,7 @@ extern int h_errno; #endif #ifdef I_UTIME -# ifdef WIN32 +# ifdef _MSC_VER # include <sys/utime.h> # else # include <utime.h> @@ -469,8 +469,19 @@ PP(pp_binmode) else RETPUSHUNDEF; #else - if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) + if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1) { +#if defined(WIN32) && defined(__BORLANDC__) + /* The translation mode of the stream is maintained independent + * of the translation mode of the fd in the Borland RTL (heavy + * digging through their runtime sources reveal). User has to + * set the mode explicitly for the stream (though they don't + * document this anywhere). GSAR 97-5-24 + */ + PerlIO_seek(fp,0L,0); + fp->flags |= _F_BIN; +#endif RETPUSHYES; + } else RETPUSHUNDEF; #endif @@ -1243,7 +1254,11 @@ PP(pp_sysread) #ifdef HAS_SOCKET if (op->op_type == OP_RECV) { char namebuf[MAXPATHLEN]; +#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS) + bufsize = sizeof (struct sockaddr_in); +#else bufsize = sizeof namebuf; +#endif buffer = SvGROW(bufsv, length+1); /* 'offset' means 'flags' here */ length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, @@ -1283,7 +1298,11 @@ PP(pp_sysread) #ifdef HAS_SOCKET__bad_code_maybe if (IoTYPE(io) == 's') { char namebuf[MAXPATHLEN]; +#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS) + bufsize = sizeof (struct sockaddr_in); +#else bufsize = sizeof namebuf; +#endif length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0, (struct sockaddr *)namebuf, &bufsize); } @@ -1368,6 +1387,7 @@ PP(pp_send) } else length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length); + #else else DIE(no_sock_func, "send"); @@ -1986,6 +2006,17 @@ PP(pp_getpeername) case OP_GETPEERNAME: if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) goto nuts2; +#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS) + { + static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; + /* If the call succeeded, make sure we don't have a zeroed port/addr */ + if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET && + !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere, + sizeof(u_short) + sizeof(struct in_addr))) { + goto nuts2; + } + } +#endif break; } #ifdef BOGUS_GETNAME_RETURN @@ -183,6 +183,7 @@ OP* listkids _((OP* o)); OP* localize _((OP* arg, I32 lexical)); I32 looks_like_number _((SV* sv)); int magic_clearenv _((SV* sv, MAGIC* mg)); +int magic_clear_all_env _((SV* sv, MAGIC* mg)); int magic_clearpack _((SV* sv, MAGIC* mg)); int magic_clearsig _((SV* sv, MAGIC* mg)); int magic_existspack _((SV* sv, MAGIC* mg)); @@ -903,7 +903,9 @@ tryagain: goto defchar; else { regsawback = 1; - ret = reganode(REF, num); + ret = reganode((regflags & PMf_FOLD) + ? ((regflags & PMf_LOCALE) ? REFFL : REFF) + : REF, num); *flagp |= HASWIDTH; while (isDIGIT(*regparse)) regparse++; @@ -1667,6 +1669,12 @@ char *op; case REF: sv_catpvf(sv, "REF%d", ARG1(op)); break; + case REFF: + sv_catpvf(sv, "REFF%d", ARG1(op)); + break; + case REFFL: + sv_catpvf(sv, "REFFL%d", ARG1(op)); + break; case OPEN: sv_catpvf(sv, "OPEN%d", ARG1(op)); break; @@ -72,25 +72,27 @@ #define BOUNDL 21 /* no Match "" at any word boundary */ #define NBOUND 22 /* no Match "" at any word non-boundary */ #define NBOUNDL 23 /* no Match "" at any word non-boundary */ -#define REF 24 /* num Match some already matched string */ -#define OPEN 25 /* num Mark this point in input as start of #n. */ -#define CLOSE 26 /* num Analogous to OPEN. */ -#define MINMOD 27 /* no Next operator is not greedy. */ -#define GPOS 28 /* no Matches where last m//g left off. */ -#define IFMATCH 29 /* no Succeeds if the following matches. */ -#define UNLESSM 30 /* no Fails if the following matches. */ -#define SUCCEED 31 /* no Return from a subroutine, basically. */ -#define WHILEM 32 /* no Do curly processing and see if rest matches. */ -#define ALNUM 33 /* no Match any alphanumeric character */ -#define ALNUML 34 /* no Match any alphanumeric char in locale */ -#define NALNUM 35 /* no Match any non-alphanumeric character */ -#define NALNUML 36 /* no Match any non-alphanumeric char in locale */ -#define SPACE 37 /* no Match any whitespace character */ -#define SPACEL 38 /* no Match any whitespace char in locale */ -#define NSPACE 39 /* no Match any non-whitespace character */ -#define NSPACEL 40 /* no Match any non-whitespace char in locale */ -#define DIGIT 41 /* no Match any numeric character */ -#define NDIGIT 42 /* no Match any non-numeric character */ +#define REF 24 /* num Match already matched string */ +#define REFF 25 /* num Match already matched string, folded */ +#define REFFL 26 /* num Match already matched string, folded in loc. */ +#define OPEN 27 /* num Mark this point in input as start of #n. */ +#define CLOSE 28 /* num Analogous to OPEN. */ +#define MINMOD 29 /* no Next operator is not greedy. */ +#define GPOS 30 /* no Matches where last m//g left off. */ +#define IFMATCH 31 /* no Succeeds if the following matches. */ +#define UNLESSM 32 /* no Fails if the following matches. */ +#define SUCCEED 33 /* no Return from a subroutine, basically. */ +#define WHILEM 34 /* no Do curly processing and see if rest matches. */ +#define ALNUM 35 /* no Match any alphanumeric character */ +#define ALNUML 36 /* no Match any alphanumeric char in locale */ +#define NALNUM 37 /* no Match any non-alphanumeric character */ +#define NALNUML 38 /* no Match any non-alphanumeric char in locale */ +#define SPACE 39 /* no Match any whitespace character */ +#define SPACEL 40 /* no Match any whitespace char in locale */ +#define NSPACE 41 /* no Match any non-whitespace character */ +#define NSPACEL 42 /* no Match any non-whitespace char in locale */ +#define DIGIT 43 /* no Match any numeric character */ +#define NDIGIT 44 /* no Match any non-numeric character */ /* * Opcode notes: @@ -121,7 +123,7 @@ EXT char regarglen[] = { 0,0,0,0,0,0,0,0,0,0, /*CURLY*/ 4, /*CURLYX*/ 4, 0,0,0,0,0,0,0,0,0,0,0,0, - /*REF*/ 2, /*OPEN*/ 2, /*CLOSE*/ 2, + /*REF*/ 2, 2, 2, /*OPEN*/ 2, /*CLOSE*/ 2, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 }; #endif @@ -155,6 +157,8 @@ EXT char regkind[] = { NBOUND, NBOUND, REF, + REF, + REF, OPEN, CLOSE, MINMOD, @@ -181,7 +185,7 @@ EXT char regkind[] = { EXT char varies[]; #else EXT char varies[] = { - BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, WHILEM, 0 + BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL, WHILEM, 0 }; #endif @@ -825,7 +825,11 @@ char *prog; sayNO; nextchar = UCHARAT(++locinput); break; + case REFFL: + regtainted = TRUE; + /* FALL THROUGH */ case REF: + case REFF: n = ARG1(scan); /* which paren pair */ s = regstartp[n]; if (!s) @@ -835,12 +839,19 @@ char *prog; if (s == regendp[n]) break; /* Inline the first character, for speed. */ - if (UCHARAT(s) != nextchar) + if (UCHARAT(s) != nextchar && + (OP(scan) == REF || + (UCHARAT(s) != ((OP(scan) == REFF + ? fold : fold_locale)[nextchar])))) sayNO; ln = regendp[n] - s; if (locinput + ln > regeol) sayNO; - if (ln > 1 && memNE(s, locinput, ln)) + if (ln > 1 && (OP(scan) == REF + ? memNE(s, locinput, ln) + : (OP(scan) == REFF + ? ibcmp(s, locinput, ln) + : ibcmp_locale(s, locinput, ln)))) sayNO; locinput += ln; nextchar = UCHARAT(locinput); @@ -889,6 +889,7 @@ register SV *sv; STRLEN prevlen; int unref = 0; + sv_setpvn(t, "", 0); retry: if (!sv) { sv_catpv(t, "VOID"); diff --git a/t/comp/cpp.aux b/t/comp/cpp.aux index bb93d212c3..bb93d212c3 100755..100644 --- a/t/comp/cpp.aux +++ b/t/comp/cpp.aux diff --git a/t/harness b/t/harness index fe64a04629..fe64a04629 100644..100755 --- a/t/harness +++ b/t/harness diff --git a/t/lib/safe2.t b/t/lib/safe2.t index feaab16956..40c5098058 100755 --- a/t/lib/safe2.t +++ b/t/lib/safe2.t @@ -8,6 +8,8 @@ BEGIN { print "1..0\n"; exit 0; } + # test 30 rather naughtily expects English error messages + $ENV{'LC_ALL'} = 'C'; } # Tests Todo: diff --git a/t/op/flip.t b/t/op/flip.t index 475f55a8c8..7852d0cee9 100755 --- a/t/op/flip.t +++ b/t/op/flip.t @@ -2,7 +2,7 @@ # $RCSfile: flip.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:52 $ -print "1..8\n"; +print "1..9\n"; @a = (1,2,3,4,5,6,7,8,9,10,11,12); @@ -24,3 +24,6 @@ while (<of>) { $x = ($foo =~ y/\n/\n/); if ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";} + +$x = 3.14; +if (($x...$x) eq "1") {print "ok 9\n";} else {print "not ok 9\n";} diff --git a/t/op/groups.t b/t/op/groups.t index 078689b1c6..47aabe3d7b 100755 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -1,6 +1,9 @@ #!./perl -if (! -x ($groups = '/usr/ucb/groups') && ! -x ($groups = '/usr/bin/groups')) { +if (! -x ($groups = '/usr/ucb/groups') && + ! -x ($groups = '/usr/bin/groups') && + ! -x ($groups = '/bin/groups') +) { print "1..0\n"; exit 0; } diff --git a/t/op/magic.t b/t/op/magic.t index c2be2e5e68..49caab56b4 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -19,10 +19,11 @@ sub ok { } } -$Is_MSWin32 = ($^O eq 'MSWin32'); +$Is_MSWin32 = $^O eq 'MSWin32'; +$Is_VMS = $^O eq 'VMS'; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); -print "1..28\n"; +print "1..30\n"; eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval if ($Is_MSWin32) { ok 1, `cmd /x /c set foo` eq "foo=hi there\n"; } @@ -109,7 +110,7 @@ if ($Is_MSWin32) { for (19 .. 25) { ok $_, 1 } } else { - if ($^O eq 'qnx' || $^O eq 'amigaos') { + if ($^O eq 'qnx') { chomp($wd = `pwd`); } else { @@ -142,3 +143,22 @@ EOF ok 26, $] >= 5.00319, $]; ok 27, $^O; ok 28, $^T > 850000000, $^T; + +if ($Is_VMS) { + ok 29, 1; + ok 30, 1; +} +else { + $PATH = $ENV{PATH}; + $ENV{foo} = "bar"; + %ENV = (); + $ENV{PATH} = $PATH; + ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "") + : (`echo \$foo` eq "\n") ); + + $ENV{NoNeSuCh} = "foo"; + $0 = "bar"; + ok 30, ($Is_MSWin32 ? (`cmd /x /c set NoNeSuCh` eq "NoNeSuCh=foo\n") + : (`echo \$NoNeSuCh` eq "foo\n") ); +} + diff --git a/t/op/mkdir.t b/t/op/mkdir.t index 5a6dfe5f5c..5ba0a0f18d 100755 --- a/t/op/mkdir.t +++ b/t/op/mkdir.t @@ -6,9 +6,12 @@ print "1..7\n"; $^O eq 'MSWin32' ? `del /s /q blurfl 2>&1` : `rm -rf blurfl`; +# tests 3 and 7 rather naughtily expect English error messages +$ENV{'LC_ALL'} = 'C'; + print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); -print ($! =~ /exist/ ? "ok 3\n" : "not ok 3\n"); +print ($! =~ /exist|denied/ ? "ok 3\n" : "# $!\nnot ok 3\n"); print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n"); diff --git a/t/op/re_tests b/t/op/re_tests index c20fb89e80..77d97e2aeb 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -301,3 +301,6 @@ a(?:b|c|d)*(.) ace y $1 e a(?:b|c|d)+?(.) ace y $1 e a(?:b|(c|e){1,2}?|d)+?(.) ace y $1$2 ce ^(.+)?B AB y $1 A +'([a-z]+)\s\1'i Aa aa y $&-$1 Aa aa-Aa +'([a-z]+)\s\1'i Ab ab y $&-$1 Ab ab-Ab +foo\w*\d{4}baz foobar1234baz y $& foobar1234baz diff --git a/t/op/regexp.t b/t/op/regexp.t index c6969240fc..ea470f879b 100755 --- a/t/op/regexp.t +++ b/t/op/regexp.t @@ -1,5 +1,26 @@ #!./perl +# The tests are in a separate file 't/op/re_tests'. +# Each line in that file is a separate test. +# There are five columns, separated by tabs. +# +# Column 1 contains the pattern, optionally enclosed in C<''>. +# Modifiers can be put after the closing C<'>. +# +# Column 2 contains the string to be matched. +# +# Column 3 contains the expected result: +# y expect a match +# n expect no match +# c expect an error +# +# Columns 4 and 5 are used only of column 3 contains C<y>. +# +# Column 4 contains a string, usually C<$&>. +# +# Column 5 contains the expected result of double-quote +# interpolating that string after the match. + open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; @@ -15,7 +36,7 @@ while (<TESTS>) { ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_); $input = join(':',$pat,$subject,$result,$repl,$expect); $pat = "'$pat'" unless $pat =~ /^'/; - for $study ("", "study \$match") { + for $study ("", "study \$subject") { eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";"; if ($result eq 'c') { if ($@ eq '') { print "not ok $.\n"; next TEST } diff --git a/t/op/split.t b/t/op/split.t index 90bb436550..b449ba96fa 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -2,7 +2,7 @@ # $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $ -print "1..14\n"; +print "1..16\n"; $FS = ':'; @@ -66,3 +66,13 @@ print $_ eq "1|-|10||20" ? "ok 13\n" : "not ok 13\n"; # do subpatterns generate additional fields (with a limit)? $_ = join '|', split(/,|(-)/, "1-10,20,,,", 10); print $_ eq "1|-|10||20||||||" ? "ok 14\n" : "not ok 14\n"; + +# is the 'two undefs' bug fixed? +(undef, $a, undef, $b) = qw(1 2 3 4); +print "$a|$b" eq "2|4" ? "ok 15\n" : "not ok 15\n"; + +# .. even for locals? +{ + local(undef, $a, undef, $b) = qw(1 2 3 4); + print "$a|$b" eq "2|4" ? "ok 16\n" : "not ok 16\n"; +} diff --git a/t/op/stat.t b/t/op/stat.t index c1cc1573b4..aea5cc147c 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -74,7 +74,9 @@ if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";} if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";} eval '$> = $olduid;'; # switch uid back (may not be implemented) print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid); -if (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";} + +if ($Is_MSWin32 or ! -x 'Op.stat.tmp') {print "ok 11\n";} +else {print "not ok 11\n";} foreach ((12,13,14,15,16,17)) { print "ok $_\n"; #deleted tests @@ -158,24 +160,35 @@ else tty_test: -if ($Is_MSWin32) { - print "ok 36\n"; - print "ok 37\n"; +# To assist in automated testing when a controlling terminal (/dev/tty) +# may not be available (at, cron rsh etc), the PERL_SKIP_TTY_TEST env var +# can be set to skip the tests that need a tty. +unless($ENV{PERL_SKIP_TTY_TEST}) { + if ($Is_MSWin32) { + print "ok 36\n"; + print "ok 37\n"; + } + else { + unless (open(tty,"/dev/tty")) { + print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; + } + if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} + if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} + close(tty); + } + if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} + if (-t) {print "ok 39\n";} else {print "not ok 39\n";} } else { - unless (open(tty,"/dev/tty")) { - print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; - } - if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} - if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} - close(tty); + print "ok 36\n"; + print "ok 37\n"; + print "ok 38\n"; + print "ok 39\n"; } -if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} open(null,"/dev/null"); if (! -t null || -e '/xenix' || $^O eq 'machten' || $Is_MSWin32) - {print "ok 39\n";} else {print "not ok 39\n";} + {print "ok 40\n";} else {print "not ok 40\n";} close(null); -if (-t) {print "ok 40\n";} else {print "not ok 40\n";} # These aren't strictly "stat" calls, but so what? diff --git a/t/op/subst.t b/t/op/subst.t index b2332b84d1..3b4734eadb 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -2,7 +2,7 @@ # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $ -print "1..60\n"; +print "1..61\n"; $x = 'foo'; $_ = "x"; @@ -229,3 +229,8 @@ print exp_vars('$(DIR)',0) eq '$(UNDEFINEDNAME)/xxx' print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar' ? "ok 60\n" : "not ok 60\n"; +# a match nested in the RHS of a substitution: + +$_ = "abcd"; +s/../$x = $&, m#.#/eg; +print $x eq "cd" ? "ok 61\n" : "not ok 61\n"; diff --git a/t/op/taint.t b/t/op/taint.t index 1667152719..e170f284ed 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -96,7 +96,7 @@ print "1..135\n"; test 1, eval { `$echo 1` } eq "1\n"; - if ($Is_MSWin32) { + if ($Is_MSWin32 || $Is_VMS) { print "# Environment tainting tests skipped\n"; for (2..5) { print "ok $_\n" } } @@ -1334,7 +1334,7 @@ warn(pat,va_alist) } #ifndef VMS /* VMS' my_setenv() is in VMS.c */ -#ifndef _WIN32 +#ifndef WIN32 void my_setenv(nam,val) char *nam, *val; @@ -1382,6 +1382,74 @@ char *nam, *val; #endif /* MSDOS */ } +#else /* if WIN32 */ + +void +my_setenv(nam,val) +char *nam, *val; +{ + +#ifdef USE_WIN32_RTL_ENV + + register char *envstr; + STRLEN namlen = strlen(nam); + STRLEN vallen; + char *oldstr = environ[setenv_getix(nam)]; + + /* putenv() has totally broken semantics in both the Borland + * and Microsoft CRTLs. They either store the passed pointer in + * the environment without making a copy, or make a copy and don't + * free it. And on top of that, they dont free() old entries that + * are being replaced/deleted. This means the caller must + * free any old entries somehow, or we end up with a memory + * leak every time my_setenv() is called. One might think + * one could directly manipulate environ[], like the UNIX code + * above, but direct changes to environ are not allowed when + * calling putenv(), since the RTLs maintain an internal + * *copy* of environ[]. Bad, bad, *bad* stink. + * GSAR 97-06-07 + */ + + if (!val) { + if (!oldstr) + return; + val = ""; + vallen = 0; + } + else + vallen = strlen(val); + New(904, envstr, namlen + vallen + 3, char); + (void)sprintf(envstr,"%s=%s",nam,val); + (void)putenv(envstr); + if (oldstr) + Safefree(oldstr); +#ifdef _MSC_VER + Safefree(envstr); /* MSVCRT leaks without this */ +#endif + +#else /* !USE_WIN32_RTL_ENV */ + + /* The sane way to deal with the environment. + * Has these advantages over putenv() & co.: + * * enables us to store a truly empty value in the + * environment (like in UNIX). + * * we don't have to deal with RTL globals, bugs and leaks. + * * Much faster. + * Why you may want to enable USE_WIN32_RTL_ENV: + * * environ[] and RTL functions will not reflect changes, + * which might be an issue if extensions want to access + * the env. via RTL. This cuts both ways, since RTL will + * not see changes made by extensions that call the Win32 + * functions directly, either. + * GSAR 97-06-07 + */ + SetEnvironmentVariable(nam,val); + +#endif +} + +#endif /* WIN32 */ + I32 setenv_getix(nam) char *nam; @@ -1389,41 +1457,18 @@ char *nam; register I32 i, len = strlen(nam); for (i = 0; environ[i]; i++) { - if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') + if ( +#ifdef WIN32 + strnicmp(environ[i],nam,len) == 0 +#else + strnEQ(environ[i],nam,len) +#endif + && environ[i][len] == '=') break; /* strnEQ must come first to avoid */ } /* potential SEGV's */ return i; } -#else /* if _WIN32 */ - -void -my_setenv(nam,val) -char *nam, *val; -{ - register char *envstr; - STRLEN namlen = strlen(nam); - STRLEN vallen = strlen(val ? val : ""); - - New(904, envstr, namlen + vallen + 3, char); - (void)sprintf(envstr,"%s=%s",nam,val); - if (!vallen) { - /* An attempt to delete the entry. - * We try to fix a Win32 process handling goof: Children - * of the current process will end up seeing the - * grandparent's entry if the current process has never - * modified the entry being deleted. So we call _putenv() - * twice: once to pretend to modify the entry, and the - * second time to actually delete it. GSAR 97-03-19 - */ - envstr[namlen+1] = 'X'; envstr[namlen+2] = '\0'; - (void)_putenv(envstr); - envstr[namlen+1] = '\0'; - } - (void)_putenv(envstr); -} - -#endif /* _WIN32 */ #endif /* !VMS */ #ifdef UNLINK_ALL_VERSIONS diff --git a/utils/Makefile b/utils/Makefile index 1f8c5f4764..9dd24642f2 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -16,6 +16,8 @@ c2ph: c2ph.PL h2ph: h2ph.PL +h2xs: h2xs.PL + perlbug: perlbug.PL perldoc: perldoc.PL diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 5e22b7096e..6efbde051a 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -418,7 +418,7 @@ END # require autoloader if XS is disabled. # if XS is enabled, require autoloader unless autoloading is disabled. -if( $opt_X || (! $opt_A) ){ +if( $opt_X && (! $opt_A) ){ print PM <<"END"; require AutoLoader; END @@ -882,7 +882,7 @@ if ($^O eq 'VMS') { $_ = 'Makefile.PL' if $_ eq 'makefile.pl'; } } -print MANI join("\n",@files); +print MANI join("\n",@files), "\n"; close MANI; !NO!SUBS! diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 23acde403e..00fad311d2 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -481,10 +481,11 @@ EOF --- Environment for perl $]: EOF - for my $env (qw(PATH LD_LIBRARY_PATH), - sort grep { /^(?:PERL|LC_)/ } keys %ENV, - qw(LANG PERL_BADLANG - SHELL HOME LOGDIR)) { + for my $env (sort + (qw(PATH LD_LIBRARY_PATH + LANG PERL_BADLANG + SHELL HOME LOGDIR), + grep { /^(?:PERL|LC_)/ } keys %ENV)) { print OUT " $env", exists $ENV{$env} ? "=$ENV{$env}" : ' (unset)', "\n"; diff --git a/vms/ext/DCLsym/DCLsym.pm b/vms/ext/DCLsym/DCLsym.pm index 057951dd99..44c4b84a65 100644 --- a/vms/ext/DCLsym/DCLsym.pm +++ b/vms/ext/DCLsym/DCLsym.pm @@ -201,6 +201,8 @@ can also call methods directly to manipulate individual symbols. In some cases, this allows you finer control than using a tied hash aggregate. The following methods are supported: +=over + =item new This creates a C<VMS::DCLsym> object which can be used as a handle for later diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index 516e678e2c..218c406fa4 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -76,7 +76,7 @@ __END__ =head1 NAME -VMS::Stdio +VMS::Stdio - standard I/O functions via VMS extensions =head1 SYNOPSIS @@ -99,7 +99,7 @@ remove("another.file"); =head1 DESCRIPTION -This package gives Perl scripts access to VMS extensions to several +This package gives Perl scripts access via VMS extensions to several C stdio operations not available through Perl's CORE I/O functions. The specific routines are described below. These functions are prototyped as unary operators, with the exception of C<vmsopen> @@ -141,6 +141,8 @@ VMS::Stdio function. This compatibility interface will be removed in a future release of this extension, so please update your code to use the new routines. +=over + =item flush This function causes the contents of stdio buffers for the specified diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t index 62b06fe9ed..62b06fe9ed 100644..100755 --- a/vms/ext/filespec.t +++ b/vms/ext/filespec.t diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index cb4f7dd1f1..e451e1826b 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -145,7 +145,8 @@ sub scan_var { my($const) = $line =~ /^EXTCONST/; print "\tchecking for global variable\n" if $debug > 1; - $line =~ s/INIT\(.*\)//; + $line =~ s/\s*EXT/EXT/; + $line =~ s/INIT\s*\(.*\)//; $line =~ s/\[.*//; $line =~ s/=.*//; $line =~ s/\W*;?\s*$//; @@ -156,7 +157,7 @@ sub scan_var { else { $vars{$1}++; } } if ($isvaxc) { - my($type) = $line =~ /^EXT\w*\s+(\w+)/; + my($type) = $line =~ /^\s*EXT\w*\s+(\w+)/; print "\tchecking for use of enum (type is \"$type\")\n" if $debug > 2; if ($type eq 'expectation') { $used_expectation_enum++; @@ -194,18 +195,18 @@ LINE: while (<CPP>) { while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) { while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) { print "vms_proto>> $_" if $debug > 2; - if (/^EXT/) { &scan_var($_); } + if (/^\s*EXT/) { &scan_var($_); } else { &scan_func($_); } last LINE unless $_ = <CPP>; } print "vmsish.h>> $_" if $debug > 2; - if (/^EXT/) { &scan_var($_); } + if (/^\s*EXT/) { &scan_var($_); } last LINE unless $_ = <CPP>; } while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) { print "opcode.h>> $_" if $debug > 2; if (/^OP \*\s/) { &scan_func($_); } - if (/^EXT/) { &scan_var($_); } + if (/^\s*EXT/) { &scan_var($_); } if (/^\s+OP_/) { &scan_enum($_); } last LINE unless $_ = <CPP>; } @@ -216,12 +217,12 @@ LINE: while (<CPP>) { } while (/^#.*proto\.h/i .. /^#.*perl\.h/i) { print "proto.h>> $_" if $debug > 2; - if (/^EXT/) { &scan_var($_); } + if (/\s*^EXT/) { &scan_var($_); } else { &scan_func($_); } last LINE unless $_ = <CPP>; } print $_ if $debug > 3 && ($debug > 5 || length($_)); - if (/^EXT/) { &scan_var($_); } + if (/^\s*EXT/) { &scan_var($_); } } close CPP; diff --git a/vms/perlvms.pod b/vms/perlvms.pod index 5f9e91f635..c599e5834c 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -58,7 +58,7 @@ define a foreign command to invoke this image. Perl extensions are packages which provide both XS and Perl code to add new functionality to perl. (XS is a meta-language which simplifies writing C code which interacts with Perl, see -L<perlapi> for more details.) The Perl code for an +L<perlxs> for more details.) The Perl code for an extension is treated like any other library module - it's made available in your script through the appropriate C<use> or C<require> statement, and usually defines a Perl diff --git a/win32/Makefile b/win32/Makefile index 8c99ef7550..8c8b1ad0bc 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -13,10 +13,6 @@ INST_DRV=c: INST_TOP=$(INST_DRV)\perl # -# uncomment next line if you wish perl to run on Windows95 also -#RUNTIME=-MT - -# # uncomment next line if you are using Visual C++ 2.x #CCTYPE=MSVC20 @@ -24,6 +20,18 @@ INST_TOP=$(INST_DRV)\perl # uncomment next line if you want debug version of perl (big,slow) #CFG=Debug +# +# set the install locations of the compiler include/libraries +#CCHOME = f:\msvc20 +CCHOME = $(MSVCDIR) +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib + +# +# set this to your email address (perl will guess a value from +# from your loginname and your hostname, which may not be right) +#EMAIL = + ##################### CHANGE THESE ONLY IF YOU MUST ##################### # @@ -36,41 +44,47 @@ LIB32=$(LINK32) -lib # # Options # -PERLDLL = -D "PERLDLL" !IF "$(RUNTIME)" == "" RUNTIME = -MD !ENDIF -INCLUDES = -I ".\include" -I "." -I ".." +INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX -DEFINES = -D "WIN32" -D "_CONSOLE" -D "PERLDLL" +DEFINES = -DWIN32 -D_CONSOLE -DPERLDLL 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" +LIBC = msvcrt.lib WINIOMAYBE = !ELSE +LIBC = libcmt.lib WINIOMAYBE = win32io.obj !ENDIF !IF "$(CFG)" == "Debug" ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -Z7 -D "_DEBUG" +OPTIMIZE = -Od $(RUNTIME) -Z7 -D_DEBUG ! ELSE -OPTIMIZE = -Od $(RUNTIME)d -Z7 -D "_DEBUG" +OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG ! ENDIF LINK_DBG = -debug -pdb:none !ELSE ! IF "$(CCTYPE)" == "MSVC20" -OPTIMIZE = -Od $(RUNTIME) -D "NDEBUG" +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ELSE -OPTIMIZE = -Od $(RUNTIME) -D "NDEBUG" +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG ! ENDIF LINK_DBG = -release !ENDIF +# we don't add LIBC here, the compiler do it based on -MD/-MT +LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib + CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE) LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386 +OBJOUT_FLAG = -Fo #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -82,10 +96,11 @@ LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386 .SUFFIXES : .c .obj .dll .lib .exe .c.obj: - $(CC) -c $(CFLAGS) -Fo$@ $< + $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $< .obj.dll: - $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def -out:$@ $(LINK_FLAGS) $< $(LIBPERL) + $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ + -out:$@ $(LINK_FLAGS) $< $(LIBPERL) # INST_BIN=$(INST_TOP)\bin @@ -108,7 +123,12 @@ CONFIGPM=..\lib\Config.pm MINIMOD=..\lib\ExtUtils\Miniperl.pm PL2BAT=bin\PL2BAT.BAT +GLOBBAT = perlglob.bat + MAKE=nmake -nologo +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE=..\perl95.exe XCOPY=xcopy /f /r /i /d RCOPY=xcopy /f /r /i /e /d NULL= @@ -145,20 +165,20 @@ CORE_C= ..\av.c \ ..\universal.c \ ..\util.c -CORE_OBJ=..\av.obj \ +CORE_OBJ= ..\av.obj \ ..\deb.obj \ ..\doio.obj \ ..\doop.obj \ ..\dump.obj \ ..\globals.obj \ - ..\gv.obj \ - ..\hv.obj \ - ..\mg.obj \ - ..\op.obj \ + ..\gv.obj \ + ..\hv.obj \ + ..\mg.obj \ + ..\op.obj \ ..\perl.obj \ ..\perlio.obj \ ..\perly.obj \ - ..\pp.obj \ + ..\pp.obj \ ..\pp_ctl.obj \ ..\pp_hot.obj \ ..\pp_sys.obj \ @@ -166,56 +186,55 @@ CORE_OBJ=..\av.obj \ ..\regexec.obj \ ..\run.obj \ ..\scope.obj \ - ..\sv.obj \ + ..\sv.obj \ ..\taint.obj \ ..\toke.obj \ - ..\universal.obj \ + ..\universal.obj\ ..\util.obj WIN32_C = perllib.c \ win32.c \ win32io.c \ - win32sck.c \ + win32sck.c WIN32_OBJ = win32.obj \ win32io.obj \ - win32sck.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" - +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 @@ -249,7 +268,7 @@ POD2TEXT=$(PODDIR)\pod2text # Top targets # -ALL: $(PERLEXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) +all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) $(GLOBBAT) $(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c @@ -258,13 +277,26 @@ $(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 + perlglob.obj : perlglob.c ..\miniperlmain.obj : ..\miniperlmain.c $(CORE_H) +config.w32 : $(CFGSH_TMPL) + copy $(CFGSH_TMPL) config.w32 + +.\config.h : $(CFGSH_TMPL) + -del /f config.h + copy $(CFGH_TMPL) config.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 + $(MINIPERL) -I..\lib config_sh.PL "INST_DRV=$(INST_DRV)" \ + "INST_TOP=$(INST_TOP)" "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" \ + "cf_email=$(EMAIL)" "libs=$(LIBFILES)" \ + "libpth=$(CCLIBDIR)" "libc=$(LIBC)" \ + config.w32 > ..\config.sh $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl cd .. && miniperl configpm @@ -272,7 +304,8 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(XCOPY) ..\*.h ..\lib\CORE\*.* $(XCOPY) *.h ..\lib\CORE\*.* $(RCOPY) include ..\lib\CORE\*.* - $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) + $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \ + RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) $(MINIPERL) : ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ) $(LINK32) -subsystem:console -out:$@ @<< @@ -284,7 +317,7 @@ $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) - $(MINIPERL) -w makedef.pl > perldll.def + $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) $(LINK32) -dll -def:perldll.def -out:$@ @<< @@ -302,10 +335,11 @@ perlmain.c : runperl.c copy runperl.c perlmain.c perlmain.obj : perlmain.c - $(CC) $(CFLAGS) -U "PERLDLL" -c perlmain.c + $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c $(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj - $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB) + $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) \ + perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB) copy perl.exe $@ del perl.exe copy splittree.pl .. @@ -313,6 +347,21 @@ $(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj attrib -r ..\t\*.* copy test ..\t +perl95.c : runperl.c + copy runperl.c perl95.c + +perl95.obj : perl95.c + $(CC) $(CFLAGS) -MT -UPERLDLL -c perl95.c + +win32iomt.obj : win32io.c + $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32iomt.obj win32io.c + +$(PERL95EXE): $(PERLDLL) $(CONFIGPM) perl95.obj win32iomt.obj + $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) \ + perl95.obj win32iomt.obj $(PERLIMPLIB) + copy perl95.exe $@ + del perl95.exe + $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist ..\lib\auto md ..\lib\auto $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) @@ -354,9 +403,10 @@ $(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) cd ..\..\win32 doc: $(PERLEXE) - cd $(PODDIR) - nmake -f ../win32/pod.mak - cd ..\win32 + copy ..\README.win32 ..\pod\perlwin32.pod + $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \ + --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML::=|)" \ + --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse utils: $(PERLEXE) cd ..\utils @@ -369,7 +419,7 @@ utils: $(PERLEXE) distclean: clean -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) - -del /f *.def + -del /f *.def *.map -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ $(OPCODE_DLL) -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ @@ -378,18 +428,23 @@ distclean: clean -del /f $(PODDIR)\*.bat -rmdir /s /q ..\lib\auto -rmdir /s /q ..\lib\CORE + cd $(EXTDIR) + -del /s *.lib *.def *.map *.bs Makefile *.obj pm_to_blib + cd ..\win32 -install : ALL doc utils +install : all doc utils if not exist $(INST_TOP) mkdir $(INST_TOP) echo I $(INST_TOP) L $(LIBDIR) $(XCOPY) $(PERLEXE) $(INST_BIN)\*.* + $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* + $(XCOPY) $(GLOBBAT) $(INST_BIN)\*.* $(XCOPY) $(PERLDLL) $(INST_BIN)\*.* $(XCOPY) bin\*.* $(INST_BIN)\*.* $(RCOPY) ..\lib $(INST_LIB)\*.* $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* $(XCOPY) ..\pod\*.pod $(INST_POD)\*.* - $(XCOPY) ..\pod\*.html $(INST_HTML)\*.* + $(RCOPY) html\*.* $(INST_HTML)\*.* inst_lib : $(CONFIGPM) copy splittree.pl .. @@ -418,6 +473,8 @@ clean : -@erase $(MINIPERL) -@erase perlglob.obj -@erase perlmain.obj + -@erase config.w32 + -@erase /f config.h -@erase $(GLOBEXE) -@erase $(PERLEXE) -@erase $(PERLDLL) diff --git a/win32/config.bc b/win32/config.bc new file mode 100644 index 0000000000..4b148de2fc --- /dev/null +++ b/win32/config.bc @@ -0,0 +1,498 @@ +# +## This file was hand coded and a lot of information is invalid +# +## Configured by: ~cf_email~ +## Target system: WIN32 +# + +archlibexp='~INST_TOP~\lib' +archname='MSWin32' +cc='bcc32' +ccflags='-DWIN32' +cppflags='-DWIN32' +dlsrc='dl_win32.xs' +dynamic_ext='Fcntl IO Opcode SDBM_File Socket' +extensions='Fcntl IO Opcode SDBM_File Socket' +installarchlib='~INST_TOP~\lib' +installprivlib='~INST_TOP~\lib' +libpth='' +libs='' +osname='MSWin32' +osvers='4.0' +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' +so='dll' +startsh='#!/bin/sh' +static_ext=' ' +Author='' +CONFIG='true' +Date='$Date' +Header='' +Id='$Id' +Locker='' +Log='$Log' +Mcc='Mcc' +PATCHLEVEL='~PATCHLEVEL~' +POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"' +RCSfile='$RCSfile' +Revision='$Revision' +SUBVERSION='~SUBVERSION~' +Source='' +State='' +afs='false' +alignbytes='8' +aphostname='' +ar='tlib /P128' +archlib='~INST_TOP~\lib' +archobjs='' +awk='awk' +baserev='5.0' +bash='' +bin='~INST_TOP~\bin' +binexp='~INST_TOP~\bin' +bison='' +byacc='byacc' +byteorder='1234' +c='' +castflags='0' +cat='cat' +cccdlflags='' +ccdlflags=' ' +cf_by='garyng' +cf_email='71564.1743@compuserve.com' +cf_time='Thu Apr 11 06:20:49 PDT 1996' +chgrp='' +chmod='' +chown='' +clocktype='clock_t' +comm='comm' +compress='' +contains='grep' +cp='cp' +cpio='' +cpp='cpp32' +cpp_stuff='42' +cpplast='' +cppminus='' +cpprun='' +cppstdin='' +cryptlib='' +csh='undef' +d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_access='define' +d_alarm='undef' +d_archlib='define' +d_attribut='undef' +d_bcmp='undef' +d_bcopy='undef' +d_bincompat3='undef' +d_bsd='define' +d_bsdgetpgrp='undef' +d_bsdpgrp='undef' +d_bsdsetpgrp='undef' +d_bzero='undef' +d_casti32='define' +d_castneg='define' +d_charvspr='undef' +d_chown='undef' +d_chroot='undef' +d_chsize='define' +d_closedir='define' +d_const='define' +d_crypt='undef' +d_csh='undef' +d_cuserid='undef' +d_dbl_dig='define' +d_difftime='define' +d_dirnamlen='define' +d_dlerror='define' +d_dlopen='define' +d_dlsymun='undef' +d_dosuid='undef' +d_dup2='define' +d_eofnblk='define' +d_eunice='undef' +d_fchmod='undef' +d_fchown='undef' +d_fcntl='undef' +d_fd_macros='define' +d_fd_set='define' +d_fds_bits='define' +d_fgetpos='define' +d_flexfnam='define' +d_flock='define' +d_fork='undef' +d_fpathconf='undef' +d_fsetpos='define' +d_getgrps='undef' +d_setgrps='undef' +d_gethent='undef' +d_gethname='undef' +d_getlogin='undef' +d_getpgrp2='undef' +d_getpgrp='undef' +d_getpgid='undef' +d_getppid='undef' +d_getprior='undef' +d_gettimeod='undef' +d_htonl='define' +d_index='undef' +d_inetaton='undef' +d_isascii='define' +d_killpg='undef' +d_link='undef' +d_locconv='define' +d_lockf='undef' +d_lstat='undef' +d_mblen='define' +d_mbstowcs='define' +d_mbtowc='define' +d_memcmp='define' +d_memcpy='define' +d_memmove='define' +d_memset='define' +d_mkdir='define' +d_mkfifo='undef' +d_mktime='define' +d_msg='undef' +d_msgctl='define' +d_msgget='define' +d_msgrcv='define' +d_msgsnd='define' +d_mymalloc='undef' +d_nice='undef' +d_oldarchlib='undef' +d_oldsock='undef' +d_open3='undef' +d_pathconf='undef' +d_pause='define' +d_phostname='undef' +d_pipe='define' +d_poll='undef' +d_portable='define' +d_pwage='undef' +d_pwchange='undef' +d_pwclass='undef' +d_pwcomment='undef' +d_pwexpire='undef' +d_pwquota='undef' +d_readdir='define' +d_readlink='undef' +d_rename='define' +d_rewinddir='define' +d_rmdir='define' +d_safebcpy='undef' +d_safemcpy='undef' +d_sanemcmp='define' +d_seekdir='define' +d_select='define' +d_sem='undef' +d_semctl='define' +d_semget='define' +d_semop='define' +d_setegid='undef' +d_seteuid='undef' +d_setlinebuf='undef' +d_setlocale='define' +d_setpgid='undef' +d_setpgrp2='undef' +d_setpgrp='undef' +d_setprior='undef' +d_setregid='undef' +d_setresgid='undef' +d_setresuid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' +d_setsid='undef' +d_sfio='undef' +d_shm='undef' +d_shmat='undef' +d_shmatprototype='undef' +d_shmctl='define' +d_shmdt='define' +d_shmget='define' +d_shrplib='undef' +d_sigaction='undef' +d_sigintrp='' +d_sigsetjmp='undef' +d_sigvec='define' +d_sigvectr='undef' +d_socket='define' +d_sockpair='undef' +d_statblks='undef' +d_stdio_cnt_lval='define' +d_stdio_ptr_lval='define' +d_stdiobase='define' +d_stdstdio='define' +d_strchr='define' +d_strcoll='define' +d_strctcpy='define' +d_strerrm='strerror(e)' +d_strerror='define' +d_strtod='define' +d_strtol='define' +d_strtoul='define' +d_strxfrm='define' +d_suidsafe='undef' +d_symlink='undef' +d_syscall='undef' +d_sysconf='undef' +d_sysernlst='' +d_syserrlst='define' +d_system='define' +d_tcgetpgrp='undef' +d_tcsetpgrp='undef' +d_telldir='define' +d_time='define' +d_times='define' +d_truncate='undef' +d_tzname='define' +d_umask='define' +d_uname='undef' +d_vfork='undef' +d_void_closedir='undef' +d_voidsig='define' +d_voidtty='' +d_volatile='define' +d_vprintf='define' +d_wait4='undef' +d_waitpid='undef' +d_wcstombs='define' +d_wctomb='define' +d_xenix='undef' +date='date' +db_hashtype='int' +db_prefixtype='int' +defvoidused='15' +direntrytype='struct direct' +dlext='dll' +eagain='EAGAIN' +echo='echo' +egrep='egrep' +emacs='' +eunicefix=':' +exe_ext='.exe' +expr='expr' +find='find' +firstmakefile='makefile' +flex='' +fpostype='fpos_t' +freetype='void' +full_csh='' +full_sed='' +gcc='' +gccversion='' +gidtype='gid_t' +glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib ' +grep='grep' +groupcat='' +groupstype='gid_t' +h_fcntl='false' +h_sysfile='true' +hint='recommended' +hostcat='ypcat hosts' +huge='' +i_bsdioctl='' +i_db='undef' +i_dbm='undef' +i_dirent='define' +i_dld='undef' +i_dlfcn='define' +i_fcntl='define' +i_float='define' +i_gdbm='define' +i_grp='define' +i_limits='define' +i_locale='define' +i_malloc='define' +i_math='define' +i_memory='undef' +i_ndbm='undef' +i_neterrno='undef' +i_niin='undef' +i_pwd='undef' +i_rpcsvcdbm='define' +i_sfio='undef' +i_sgtty='undef' +i_stdarg='define' +i_stddef='define' +i_stdlib='define' +i_string='define' +i_sysdir='undef' +i_sysfile='undef' +i_sysfilio='define' +i_sysin='undef' +i_sysioctl='undef' +i_sysndir='undef' +i_sysparam='undef' +i_sysresrc='undef' +i_sysselct='undef' +i_syssockio='' +i_sysstat='define' +i_systime='undef' +i_systimek='undef' +i_systimes='undef' +i_systypes='define' +i_sysun='undef' +i_syswait='undef' +i_termio='undef' +i_termios='undef' +i_time='define' +i_unistd='undef' +i_utime='define' +i_values='undef' +i_varargs='undef' +i_varhdr='varargs.h' +i_vfork='undef' +incpath='' +inews='' +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='' +large='' +ld='tlink32' +lddlflags='-Tpd' +ldflags='' +less='less' +lib_ext='.lib' +libc='cw32mti.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='' +lkflags='' +ln='' +lns='' +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' +lseektype='off_t' +mail='' +mailx='' +make='dmake' +mallocobj='malloc.o' +mallocsrc='malloc.c' +malloctype='void *' +man1dir='~INST_TOP~\man\man1' +man1direxp='~INST_TOP~\man\man1' +man1ext='1' +man3dir='~INST_TOP~\man\man3' +man3direxp='~INST_TOP~\man\man3' +man3ext='3' +medium='' +mips='' +mips_type='' +mkdir='mkdir' +models='none' +modetype='mode_t' +more='more /e' +mv='' +myarchname='MSWin32' +mydomain='' +myhostname='' +myuname='' +n='-n' +nm_opt='' +nm_so_opt='' +nroff='' +o_nonblock='O_NONBLOCK' +obj_ext='.obj' +oldarchlib='' +oldarchlibexp='' +optimize='-O' +orderlib='false' +package='perl5' +pager='more /e' +passcat='' +patchlevel='2' +path_sep=';' +perl='perl' +perladmin='' +perlpath='~INST_TOP~\bin\perl.exe' +pg='pg' +phostname='hostname' +plibpth='' +pmake='' +pr='' +prefixexp='~INST_DRV~' +privlib='~INST_TOP~\lib' +prototype='define' +randbits='15' +ranlib='' +rd_nodata='-1' +rm='rm' +rmail='' +runnm='true' +scriptdir='~INST_TOP~\bin' +scriptdirexp='~INST_TOP~\bin' +sed='sed' +selecttype='int *' +sendmail='blat' +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='~INST_TOP~\lib\site' +sitearchexp='~INST_TOP~\lib\site' +sitelib='~INST_TOP~\lib\site' +sitelibexp='~INST_TOP~\lib\site' +sizetype='size_t' +sleep='' +smail='' +small='' +sockethdr='' +socketlib='' +sort='sort' +spackage='Perl5' +spitshell='cat' +split='' +ssizetype='int' +startperl='#perl' +stdchar='unsigned char' +stdio_base='((fp)->buffer)' +stdio_bufsiz='((fp)->level + (fp)->curp - (fp)->buffer)' +stdio_cnt='((fp)->level)' +stdio_ptr='((fp)->curp)' +strings='/usr/include/string.h' +submit='' +sysman='/usr/man/man1' +tail='' +tar='' +tbl='' +test='test' +timeincl='/usr/include/sys/time.h ' +timetype='time_t' +touch='touch' +tr='tr' +troff='' +uidtype='uid_t' +uname='uname' +uniq='uniq' +usedl='define' +usemymalloc='n' +usenm='false' +useperlio='undef' +useposix='true' +usesafe='true' +usevfork='false' +usrinc='/usr/include' +uuname='' +vi='' +voidflags='15' +xlibpth='/usr/lib/386 /lib/386' +zcat='' diff --git a/win32/config.w32 b/win32/config.vc index e977b17e07..0219969d89 100644 --- a/win32/config.w32 +++ b/win32/config.vc @@ -1,7 +1,7 @@ # ## This file was hand coded and a lot of information is invalid # -## Configured by: garyng +## Configured by: ~cf_email~ ## Target system: WIN32 # @@ -45,7 +45,7 @@ State='' afs='false' alignbytes='8' aphostname='' -ar='ar' +ar='lib' archlib='~INST_TOP~\lib' archobjs='' awk='awk' diff --git a/win32/config_H.bc b/win32/config_H.bc new file mode 100644 index 0000000000..5976289777 --- /dev/null +++ b/win32/config_H.bc @@ -0,0 +1,1798 @@ +/* + * 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. + * For a more permanent change edit config.sh and rerun config_h.SH. + * + * $Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $ + */ + +/* Configuration time: Thu Apr 11 06:20:49 PDT 1996 + * Configured by: garyng + * Target system: + */ + +#ifndef _config_h_ +#define _config_h_ + +/* MEM_ALIGNBYTES: + * This symbol contains the number of bytes required to align a + * double. Usual values are 2, 4 and 8. + * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture + * Binaries (MAB) for targets with varying alignment. This only matters + * for perl, where the config.h can be generated and installed on one + * system, and used by a different architecture to build an extension. + * The default is eight, for safety. + */ +#ifndef NeXT +#define MEM_ALIGNBYTES 8 /**/ +#else /* NeXT */ +#ifdef __m68k__ +#define MEM_ALIGNBYTES 2 +#else +#ifdef __i386__ +#define MEM_ALIGNBYTES 4 +#else /* __hppa__, __sparc__ and default for unknown architectures */ +#define MEM_ALIGNBYTES 8 +#endif /* __i386__ */ +#endif /* __m68k__ */ +#endif /* NeXT */ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "MSWin32" /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "c:\\perl\\bin" /**/ +#define BIN_EXP "c:\\perl\\bin" /**/ + +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define CAT3(a,b,c)a/**/b/**/c +#define CAT4(a,b,c,d)a/**/b/**/c/**/d +#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +#define CAT2(a,b)a ## b +#define CAT3(a,b,c)a ## b ## c +#define CAT4(a,b,c,d)a ## b ## c ## d +#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#define SCAT2(a,b)StGiFy(a) StGiFy(b) +#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c) +#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) +#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e) +#endif +#ifndef CAT2 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +#define CPPSTDIN "" +#define CPPMINUS "" + +/* HAS_ALARM: + * This symbol, if defined, indicates that the alarm routine is + * available. + */ +/*#define HAS_ALARM /**/ + +/* HASATTRIBUTE: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. This is normally only supported by GNU cc. + */ +/*#define HASATTRIBUTE /**/ +#ifndef HASATTRIBUTE +#define __attribute__(_arg_) +#endif + +/* HAS_BCMP: + * This symbol is defined if the bcmp() routine is available to + * compare blocks of memory. + */ +/*#define HAS_BCMP /**/ + +/* HAS_BCOPY: + * This symbol is defined if the bcopy() routine is available to + * copy blocks of memory. + */ +/*#define HAS_BCOPY /**/ + +/* HAS_BZERO: + * This symbol is defined if the bzero() routine is available to + * set a memory block to 0. + */ +/*#define HAS_BZERO /**/ + +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +#define CASTI32 /**/ + +/* CASTNEGFLOAT: + * This symbol is defined if the C compiler can cast negative + * numbers to unsigned longs, ints and shorts. + */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 0 = ok + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + * 4 = couldn't cast in argument expression list + */ +#define CASTNEGFLOAT /**/ +#define CASTFLAGS 0 /**/ + +/* HAS_CHOWN: + * This symbol, if defined, indicates that the chown routine is + * available. + */ +/*#define HAS_CHOWN /**/ + +/* HAS_CHROOT: + * This symbol, if defined, indicates that the chroot routine is + * available. + */ +/*#define HAS_CHROOT /**/ + +/* HAS_CHSIZE: + * This symbol, if defined, indicates that the chsize routine is available + * to truncate files. You might need a -lx to get this routine. + */ +#define HAS_CHSIZE /**/ + +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. + */ +/*#define VOID_CLOSEDIR /**/ + +/* HASCONST: + * This symbol, if defined, indicates that this C compiler knows about + * the const type. There is no need to actually test for that symbol + * within your programs. The mere use of the "const" keyword will + * trigger the necessary tests. + */ +#define HASCONST /**/ +#ifndef HASCONST +#define const +#endif + +/* HAS_CRYPT: + * This symbol, if defined, indicates that the crypt routine is available + * to encrypt passwords and the like. + */ +/*#define HAS_CRYPT /**/ + +/* HAS_CUSERID: + * This symbol, if defined, indicates that the cuserid routine is + * available to get character login names. + */ +/*#define HAS_CUSERID /**/ + +/* HAS_DBL_DIG: + * This symbol, if defined, indicates that this system's <float.h> + * or <limits.h> defines the symbol DBL_DIG, which is the number + * of significant digits in a double precision number. If this + * symbol is not defined, a guess of 15 is usually pretty good. + */ +#define HAS_DBL_DIG /**/ + +/* HAS_DIFFTIME: + * This symbol, if defined, indicates that the difftime routine is + * available. + */ +#define HAS_DIFFTIME /**/ + +/* HAS_DLERROR: + * This symbol, if defined, indicates that the dlerror routine is + * available to return a string describing the last error that + * occurred from a call to dlopen(), dlclose() or dlsym(). + */ +#define HAS_DLERROR /**/ + +/* HAS_DUP2: + * This symbol, if defined, indicates that the dup2 routine is + * available to duplicate file descriptors. + */ +#define HAS_DUP2 /**/ + +/* HAS_FCHMOD: + * This symbol, if defined, indicates that the fchmod routine is available + * to change mode of opened files. If unavailable, use chmod(). + */ +/*#define HAS_FCHMOD /**/ + +/* HAS_FCHOWN: + * This symbol, if defined, indicates that the fchown routine is available + * to change ownership of opened files. If unavailable, use chown(). + */ +/*#define HAS_FCHOWN /**/ + +/* HAS_FCNTL: + * This symbol, if defined, indicates to the C program that + * the fcntl() function exists. + */ +/*#define HAS_FCNTL /**/ + +/* HAS_FGETPOS: + * This symbol, if defined, indicates that the fgetpos routine is + * available to get the file position indicator, similar to ftell(). + */ +#define HAS_FGETPOS /**/ + +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +#define FLEXFILENAMES /**/ + +/* HAS_FLOCK: + * This symbol, if defined, indicates that the flock routine is + * available to do file locking. + */ +#define HAS_FLOCK /**/ + +/* HAS_FORK: + * This symbol, if defined, indicates that the fork routine is + * available. + */ +/*#define HAS_FORK /**/ + +/* HAS_FSETPOS: + * This symbol, if defined, indicates that the fsetpos routine is + * available to set the file position indicator, similar to fseek(). + */ +#define HAS_FSETPOS /**/ + +/* HAS_GETTIMEOFDAY: + * This symbol, if defined, indicates that the gettimeofday() system + * call is available for a sub-second accuracy clock. Usually, the file + * <sys/resource.h> needs to be included (see I_SYS_RESOURCE). + * The type "Timeval" should be used to refer to "struct timeval". + */ +/*#define HAS_GETTIMEOFDAY /**/ +#ifdef HAS_GETTIMEOFDAY +#define Timeval struct timeval /* Structure used by gettimeofday() */ +#endif + +/* HAS_GETGROUPS: + * This symbol, if defined, indicates that the getgroups() routine is + * available to get the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +/* HAS_SETGROUPS: + * This symbol, if defined, indicates that the setgroups() routine is + * available to set the list of process groups. If unavailable, multiple + * groups are probably not supported. + */ +/*#define HAS_GETGROUPS /**/ +/*#define HAS_SETGROUPS /**/ + +/* HAS_GETHOSTENT: + * This symbol, if defined, indicates that the gethostent routine is + * available to lookup host names in some data base or other. + */ +/*#define HAS_GETHOSTENT /**/ + +/* HAS_UNAME: + * This symbol, if defined, indicates that the C program may use the + * uname() routine to derive the host name. See also HAS_GETHOSTNAME + * and PHOSTNAME. + */ +/*#define HAS_UNAME /**/ + +/* HAS_GETLOGIN: + * This symbol, if defined, indicates that the getlogin routine is + * available to get the login name. + */ +/*#define HAS_GETLOGIN /**/ + +/* HAS_GETPGRP2: + * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) + * routine is available to get the current process group. + */ +/*#define HAS_GETPGRP2 /**/ + +/* HAS_GETPPID: + * This symbol, if defined, indicates that the getppid routine is + * available to get the parent process ID. + */ +/*#define HAS_GETPPID /**/ + +/* HAS_GETPRIORITY: + * This symbol, if defined, indicates that the getpriority routine is + * available to get a process's priority. + */ +/*#define HAS_GETPRIORITY /**/ + +/* HAS_HTONL: + * This symbol, if defined, indicates that the htonl() routine (and + * friends htons() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_HTONS: + * This symbol, if defined, indicates that the htons() routine (and + * friends htonl() ntohl() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHL: + * This symbol, if defined, indicates that the ntohl() routine (and + * friends htonl() htons() ntohs()) are available to do network + * order byte swapping. + */ +/* HAS_NTOHS: + * This symbol, if defined, indicates that the ntohs() routine (and + * friends htonl() htons() ntohl()) are available to do network + * order byte swapping. + */ +#define HAS_HTONL /**/ +#define HAS_HTONS /**/ +#define HAS_NTOHL /**/ +#define HAS_NTOHS /**/ + +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_KILLPG: + * This symbol, if defined, indicates that the killpg routine is available + * to kill process groups. If unavailable, you probably should use kill + * with a negative process number. + */ +/*#define HAS_KILLPG /**/ + +/* HAS_LINK: + * This symbol, if defined, indicates that the link routine is + * available to create hard links. + */ +/*#define HAS_LINK /**/ + +/* HAS_LOCALECONV: + * This symbol, if defined, indicates that the localeconv routine is + * available for numeric and monetary formatting conventions. + */ +#define HAS_LOCALECONV /**/ + +/* HAS_LOCKF: + * This symbol, if defined, indicates that the lockf routine is + * available to do file locking. + */ +/*#define HAS_LOCKF /**/ + +/* HAS_LSTAT: + * This symbol, if defined, indicates that the lstat routine is + * available to do file stats on symbolic links. + */ +/*#define HAS_LSTAT /**/ + +/* HAS_MBLEN: + * This symbol, if defined, indicates that the mblen routine is available + * to find the number of bytes in a multibye character. + */ +#define HAS_MBLEN /**/ + +/* HAS_MBSTOWCS: + * This symbol, if defined, indicates that the mbstowcs routine is + * available to covert a multibyte string into a wide character string. + */ +#define HAS_MBSTOWCS /**/ + +/* HAS_MBTOWC: + * This symbol, if defined, indicates that the mbtowc routine is available + * to covert a multibyte to a wide character. + */ +#define HAS_MBTOWC /**/ + +/* HAS_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * to compare blocks of memory. + */ +#define HAS_MEMCMP /**/ + +/* HAS_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy blocks of memory. + */ +#define HAS_MEMCPY /**/ + +/* HAS_MEMMOVE: + * This symbol, if defined, indicates that the memmove routine is available + * to copy potentially overlapping blocks of memory. This should be used + * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your + * own version. + */ +#define HAS_MEMMOVE /**/ + +/* HAS_MEMSET: + * This symbol, if defined, indicates that the memset routine is available + * to set blocks of memory. + */ +#define HAS_MEMSET /**/ + +/* HAS_MKDIR: + * This symbol, if defined, indicates that the mkdir routine is available + * to create directories. Otherwise you should fork off a new process to + * exec /bin/mkdir. + */ +#define HAS_MKDIR /**/ + +/* HAS_MKFIFO: + * This symbol, if defined, indicates that the mkfifo routine is + * available to create FIFOs. Otherwise, mknod should be able to + * do it for you. However, if mkfifo is there, mknod might require + * super-user privileges which mkfifo will not. + */ +/*#define HAS_MKFIFO /**/ + +/* HAS_MKTIME: + * This symbol, if defined, indicates that the mktime routine is + * available. + */ +#define HAS_MKTIME /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG /**/ + +/* HAS_NICE: + * This symbol, if defined, indicates that the nice routine is + * available. + */ +/*#define HAS_NICE /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 /**/ + +/* HAS_PATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given filename. + */ +/* HAS_FPATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given open file descriptor. + */ +/*#define HAS_PATHCONF /**/ +/*#define HAS_FPATHCONF /**/ + +/* HAS_PAUSE: + * This symbol, if defined, indicates that the pause routine is + * available to suspend a process until a signal is received. + */ +#define HAS_PAUSE /**/ + +/* HAS_PIPE: + * This symbol, if defined, indicates that the pipe routine is + * available to create an inter-process channel. + */ +#define HAS_PIPE /**/ + +/* HAS_POLL: + * This symbol, if defined, indicates that the poll routine is + * available to poll active file descriptors. + */ +/*#define HAS_POLL /**/ + +/* HAS_READDIR: + * This symbol, if defined, indicates that the readdir routine is + * available to read directory entries. You may have to include + * <dirent.h>. See I_DIRENT. + */ +#define HAS_READDIR /**/ + +/* HAS_SEEKDIR: + * This symbol, if defined, indicates that the seekdir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_SEEKDIR /**/ + +/* HAS_TELLDIR: + * This symbol, if defined, indicates that the telldir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_TELLDIR /**/ + +/* HAS_REWINDDIR: + * This symbol, if defined, indicates that the rewinddir routine is + * available. You may have to include <dirent.h>. See I_DIRENT. + */ +#define HAS_REWINDDIR /**/ + +/* HAS_READLINK: + * This symbol, if defined, indicates that the readlink routine is + * available to read the value of a symbolic link. + */ +/*#define HAS_READLINK /**/ + +/* HAS_RENAME: + * This symbol, if defined, indicates that the rename routine is available + * to rename files. Otherwise you should do the unlink(), link(), unlink() + * trick. + */ +#define HAS_RENAME /**/ + +/* HAS_RMDIR: + * This symbol, if defined, indicates that the rmdir routine is + * available to remove directories. Otherwise you should fork off a + * new process to exec /bin/rmdir. + */ +#define HAS_RMDIR /**/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. + */ +/*#define HAS_SAFE_MEMCPY /**/ + +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. + */ +#define HAS_SANE_MEMCMP /**/ + +/* HAS_SELECT: + * This symbol, if defined, indicates that the select routine is + * available to select active file descriptors. If the timeout field + * is used, <sys/time.h> may need to be included. + */ +#define HAS_SELECT /**/ + +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +/*#define HAS_SEM /**/ + +/* HAS_SETEGID: + * This symbol, if defined, indicates that the setegid routine is available + * to change the effective gid of the current program. + */ +/*#define HAS_SETEGID /**/ + +/* HAS_SETEUID: + * This symbol, if defined, indicates that the seteuid routine is available + * to change the effective uid of the current program. + */ +/*#define HAS_SETEUID /**/ + +/* HAS_SETLINEBUF: + * This symbol, if defined, indicates that the setlinebuf routine is + * available to change stderr or stdout from block-buffered or unbuffered + * to a line-buffered mode. + */ +/*#define HAS_SETLINEBUF /**/ + +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +#define HAS_SETLOCALE /**/ + +/* HAS_SETPGRP2: + * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) + * routine is available to set the current process group. + */ +/*#define HAS_SETPGRP2 /**/ + +/* HAS_SETPRIORITY: + * This symbol, if defined, indicates that the setpriority routine is + * available to set a process's priority. + */ +/*#define HAS_SETPRIORITY /**/ + +/* HAS_SETREGID: + * This symbol, if defined, indicates that the setregid routine is + * available to change the real and effective gid of the current + * process. + */ +/* HAS_SETRESGID: + * This symbol, if defined, indicates that the setresgid routine is + * available to change the real, effective and saved gid of the current + * process. + */ +/*#define HAS_SETREGID /**/ +/*#define HAS_SETRESGID /**/ + +/* HAS_SETREUID: + * This symbol, if defined, indicates that the setreuid routine is + * available to change the real and effective uid of the current + * process. + */ +/* HAS_SETRESUID: + * This symbol, if defined, indicates that the setresuid routine is + * available to change the real, effective and saved uid of the current + * process. + */ +/*#define HAS_SETREUID /**/ +/*#define HAS_SETRESUID /**/ + +/* HAS_SETRGID: + * This symbol, if defined, indicates that the setrgid routine is available + * to change the real gid of the current program. + */ +/*#define HAS_SETRGID /**/ + +/* HAS_SETRUID: + * This symbol, if defined, indicates that the setruid routine is available + * to change the real uid of the current program. + */ +/*#define HAS_SETRUID /**/ + +/* HAS_SETSID: + * This symbol, if defined, indicates that the setsid routine is + * available to set the process group ID. + */ +/*#define HAS_SETSID /**/ + +/* HAS_SHM: + * This symbol, if defined, indicates that the entire shm*(2) library is + * supported. + */ +/*#define HAS_SHM /**/ + +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. + */ +/* HAS_SHMAT_PROTOTYPE: + * This symbol, if defined, indicates that the sys/shm.h includes + * a prototype for shmat(). Otherwise, it is up to the program to + * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess, + * but not always right so it should be emitted by the program only + * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. + */ +#define Shmat_t void * /**/ +/*#define HAS_SHMAT_PROTOTYPE /**/ + +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION /**/ + +/* HAS_SOCKET: + * This symbol, if defined, indicates that the BSD socket interface is + * supported. + */ +/* HAS_SOCKETPAIR: + * This symbol, if defined, indicates that the BSD socketpair() call is + * supported. + */ +#define HAS_SOCKET /**/ +/*#define HAS_SOCKETPAIR /**/ + +/* USE_STAT_BLOCKS: + * This symbol is defined if this system has a stat structure declaring + * st_blksize and st_blocks. + */ +/*#define USE_STAT_BLOCKS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->curp) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->level) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->buffer) +#define FILE_bufsiz(fp) ((fp)->level + (fp)->curp - (fp)->buffer) +#endif + +/* HAS_STRCHR: + * This symbol is defined to indicate that the strchr()/strrchr() + * functions are available for string searching. If not, try the + * index()/rindex() pair. + */ +/* HAS_INDEX: + * This symbol is defined to indicate that the index()/rindex() + * functions are available for string searching. + */ +#define HAS_STRCHR /**/ +/*#define HAS_INDEX /**/ + +/* HAS_STRCOLL: + * This symbol, if defined, indicates that the strcoll routine is + * available to compare strings using collating information. + */ +#define HAS_STRCOLL /**/ + +/* USE_STRUCT_COPY: + * This symbol, if defined, indicates that this C compiler knows how + * to copy structures. If undefined, you'll need to use a block copy + * routine of some sort instead. + */ +#define USE_STRUCT_COPY /**/ + +/* HAS_STRERROR: + * This symbol, if defined, indicates that the strerror routine is + * available to translate error numbers to strings. See the writeup + * of Strerror() in this file before you try to define your own. + */ +/* HAS_SYS_ERRLIST: + * This symbol, if defined, indicates that the sys_errlist array is + * available to translate error numbers to strings. The extern int + * sys_nerr gives the size of that table. + */ +/* Strerror: + * This preprocessor symbol is defined as a macro if strerror() is + * not available to translate error numbers to strings but sys_errlist[] + * array is there. + */ +#define HAS_STRERROR /**/ +#define HAS_SYS_ERRLIST /**/ +#define Strerror(e) strerror(e) + +/* HAS_STRTOD: + * This symbol, if defined, indicates that the strtod routine is + * available to provide better numeric string conversion than atof(). + */ +#define HAS_STRTOD /**/ + +/* HAS_STRTOL: + * This symbol, if defined, indicates that the strtol routine is available + * to provide better numeric string conversion than atoi() and friends. + */ +#define HAS_STRTOL /**/ + +/* HAS_STRTOUL: + * This symbol, if defined, indicates that the strtoul routine is + * available to provide conversion of strings to unsigned long. + */ +#define HAS_STRTOUL /**/ + +/* HAS_STRXFRM: + * This symbol, if defined, indicates that the strxfrm() routine is + * available to transform strings. + */ +#define HAS_STRXFRM /**/ + +/* HAS_SYMLINK: + * This symbol, if defined, indicates that the symlink routine is available + * to create symbolic links. + */ +/*#define HAS_SYMLINK /**/ + +/* HAS_SYSCALL: + * This symbol, if defined, indicates that the syscall routine is + * available to call arbitrary system calls. If undefined, that's tough. + */ +/*#define HAS_SYSCALL /**/ + +/* HAS_SYSCONF: + * This symbol, if defined, indicates that sysconf() is available + * to determine system related limits and options. + */ +/*#define HAS_SYSCONF /**/ + +/* HAS_SYSTEM: + * This symbol, if defined, indicates that the system routine is + * available to issue a shell command. + */ +#define HAS_SYSTEM /**/ + +/* HAS_TCGETPGRP: + * This symbol, if defined, indicates that the tcgetpgrp routine is + * available to get foreground process group ID. + */ +/*#define HAS_TCGETPGRP /**/ + +/* HAS_TCSETPGRP: + * This symbol, if defined, indicates that the tcsetpgrp routine is + * available to set foreground process group ID. + */ +/*#define HAS_TCSETPGRP /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case <sys/types.h> should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include <sys/times.h>. + */ +#define HAS_TIMES /**/ + +/* HAS_TRUNCATE: + * This symbol, if defined, indicates that the truncate routine is + * available to truncate files. + */ +/*#define HAS_TRUNCATE /**/ + +/* HAS_TZNAME: + * This symbol, if defined, indicates that the tzname[] array is + * available to access timezone names. + */ +#define HAS_TZNAME /**/ + +/* HAS_UMASK: + * This symbol, if defined, indicates that the umask routine is + * available to set and get the value of the file creation mask. + */ +#define HAS_UMASK /**/ + +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. + */ +/*#define HAS_VFORK /**/ + +/* Signal_t: + * This symbol's value is either "void" or "int", corresponding to the + * appropriate return type of a signal handler. Thus, you can declare + * a signal handler using "Signal_t (*handler)()", and define the + * handler using "Signal_t handler(sig)". + */ +#define Signal_t void /* Signal handler's return type */ + +/* HASVOLATILE: + * This symbol, if defined, indicates that this C compiler knows about + * the volatile declaration. + */ +#define HASVOLATILE /**/ +#ifndef HASVOLATILE +#define volatile +#endif + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ + +/* HAS_WAIT4: + * This symbol, if defined, indicates that wait4() exists. + */ +/*#define HAS_WAIT4 /**/ + +/* HAS_WAITPID: + * This symbol, if defined, indicates that the waitpid routine is + * available to wait for child process. + */ +/*#define HAS_WAITPID /**/ + +/* HAS_WCSTOMBS: + * This symbol, if defined, indicates that the wcstombs routine is + * available to convert wide character strings to multibyte strings. + */ +#define HAS_WCSTOMBS /**/ + +/* HAS_WCTOMB: + * This symbol, if defined, indicates that the wctomb routine is available + * to covert a wide character to a multibyte. + */ +#define HAS_WCTOMB /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include <sys/types.h> to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ + +/* Groups_t: + * This symbol holds the type used for the second argument to + * [gs]etgroups(). Usually, this is the same of gidtype, but + * sometimes it isn't. It can be int, ushort, uid_t, etc... + * It may be necessary to include <sys/types.h> to get any + * typedef'ed information. This is only required if you have + * getgroups() or setgroups(). + */ +#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) +#define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */ +#endif + +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the <db.h> header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ + +/* I_DIRENT: + * This symbol, if defined, indicates to the C program that it should + * include <dirent.h>. Using this symbol also triggers the definition + * of the Direntry_t define which ends up being 'struct dirent' or + * 'struct direct' depending on the availability of <dirent.h>. + */ +/* DIRNAMLEN: + * This symbol, if defined, indicates to the C program that the length + * of directory entry names is provided by a d_namlen field. Otherwise + * you need to do strlen() on the d_name field. + */ +/* Direntry_t: + * This symbol is set to 'struct direct' or 'struct dirent' depending on + * whether dirent is available or not. You should use this pseudo type to + * portably declare your directory entries. + */ +#define I_DIRENT /**/ +#define DIRNAMLEN /**/ +#define Direntry_t struct direct + +/* I_DLFCN: + * This symbol, if defined, indicates that <dlfcn.h> exists and should + * be included. + */ +#define I_DLFCN /**/ + +/* I_FCNTL: + * This manifest constant tells the C program to include <fcntl.h>. + */ +#define I_FCNTL /**/ + +/* I_FLOAT: + * This symbol, if defined, indicates to the C program that it should + * include <float.h> to get definition of symbols like DBL_MAX or + * DBL_MIN, i.e. machine dependent floating point values. + */ +#define I_FLOAT /**/ + +/* I_GRP: + * This symbol, if defined, indicates to the C program that it should + * include <grp.h>. + */ +#define I_GRP /**/ + +/* I_LIMITS: + * This symbol, if defined, indicates to the C program that it should + * include <limits.h> to get definition of symbols like WORD_BIT or + * LONG_MAX, i.e. machine dependant limitations. + */ +#define I_LIMITS /**/ + +/* I_MATH: + * This symbol, if defined, indicates to the C program that it should + * include <math.h>. + */ +#define I_MATH /**/ + +/* I_MEMORY: + * This symbol, if defined, indicates to the C program that it should + * include <memory.h>. + */ +/*#define I_MEMORY /**/ + +/* I_NDBM: + * This symbol, if defined, indicates that <ndbm.h> exists and should + * be included. + */ +/*#define I_NDBM /**/ + +/* I_NET_ERRNO: + * This symbol, if defined, indicates that <net/errno.h> exists and + * should be included. + */ +/*#define I_NET_ERRNO /**/ + +/* I_NETINET_IN: + * This symbol, if defined, indicates to the C program that it should + * include <netinet/in.h>. Otherwise, you may try <sys/in.h>. + */ +/*#define I_NETINET_IN /**/ + +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include <pwd.h>. + */ +/* PWQUOTA: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_quota. + */ +/* PWAGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_age. + */ +/* PWCHANGE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_change. + */ +/* PWCLASS: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_class. + */ +/* PWEXPIRE: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_expire. + */ +/* PWCOMMENT: + * This symbol, if defined, indicates to the C program that struct passwd + * contains pw_comment. + */ +/*#define I_PWD /**/ +/*#define PWQUOTA /**/ +/*#define PWAGE /**/ +/*#define PWCHANGE /**/ +/*#define PWCLASS /**/ +/*#define PWEXPIRE /**/ +/*#define PWCOMMENT /**/ + +/* I_STDDEF: + * This symbol, if defined, indicates that <stddef.h> exists and should + * be included. + */ +#define I_STDDEF /**/ + +/* I_STDLIB: + * This symbol, if defined, indicates that <stdlib.h> exists and should + * be included. + */ +#define I_STDLIB /**/ + +/* I_STRING: + * This symbol, if defined, indicates to the C program that it should + * include <string.h> (USG systems) instead of <strings.h> (BSD systems). + */ +#define I_STRING /**/ + +/* I_SYS_DIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/dir.h>. + */ +/*#define I_SYS_DIR /**/ + +/* I_SYS_FILE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/file.h> to get definition of R_OK and friends. + */ +/*#define I_SYS_FILE /**/ + +/* I_SYS_IOCTL: + * This symbol, if defined, indicates that <sys/ioctl.h> exists and should + * be included. Otherwise, include <sgtty.h> or <termio.h>. + */ +/*#define I_SYS_IOCTL /**/ + +/* I_SYS_NDIR: + * This symbol, if defined, indicates to the C program that it should + * include <sys/ndir.h>. + */ +/*#define I_SYS_NDIR /**/ + +/* I_SYS_PARAM: + * This symbol, if defined, indicates to the C program that it should + * include <sys/param.h>. + */ +/*#define I_SYS_PARAM /**/ + +/* I_SYS_RESOURCE: + * This symbol, if defined, indicates to the C program that it should + * include <sys/resource.h>. + */ +/*#define I_SYS_RESOURCE /**/ + +/* I_SYS_SELECT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/select.h> in order to get definition of struct timeval. + */ +/*#define I_SYS_SELECT /**/ + +/* I_SYS_TIMES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/times.h>. + */ +/*#define I_SYS_TIMES /**/ + +/* I_SYS_TYPES: + * This symbol, if defined, indicates to the C program that it should + * include <sys/types.h>. + */ +#define I_SYS_TYPES /**/ + +/* I_SYS_UN: + * This symbol, if defined, indicates to the C program that it should + * include <sys/un.h> to get UNIX domain socket definitions. + */ +/*#define I_SYS_UN /**/ + +/* I_SYS_WAIT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/wait.h>. + */ +/*#define I_SYS_WAIT /**/ + +/* I_TERMIO: + * This symbol, if defined, indicates that the program should include + * <termio.h> rather than <sgtty.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +/* I_TERMIOS: + * This symbol, if defined, indicates that the program should include + * the POSIX termios.h rather than sgtty.h or termio.h. + * There are also differences in the ioctl() calls that depend on the + * value of this symbol. + */ +/* I_SGTTY: + * This symbol, if defined, indicates that the program should include + * <sgtty.h> rather than <termio.h>. There are also differences in + * the ioctl() calls that depend on the value of this symbol. + */ +/*#define I_TERMIO /**/ +/*#define I_TERMIOS /**/ +/*#define I_SGTTY /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <time.h>. + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h>. + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include <sys/time.h> with KERNEL defined. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL /**/ + +/* I_UNISTD: + * This symbol, if defined, indicates to the C program that it should + * include <unistd.h>. + */ +/*#define I_UNISTD /**/ + +/* I_UTIME: + * This symbol, if defined, indicates to the C program that it should + * include <utime.h>. + */ +#define I_UTIME /**/ + +/* I_STDARG: + * This symbol, if defined, indicates that <stdarg.h> exists and should + * be included. + */ +/* I_VARARGS: + * This symbol, if defined, indicates to the C program that it should + * include <varargs.h>. + */ +#define I_STDARG /**/ +/*#define I_VARARGS /**/ + +/* I_VFORK: + * This symbol, if defined, indicates to the C program that it should + * include vfork.h. + */ +/*#define I_VFORK /**/ + +/* INTSIZE: + * This symbol contains the value of sizeof(int) so that the C + * preprocessor can make decisions based on it. + */ +/* LONGSIZE: + * This symbol contains the value of sizeof(long) so that the C + * preprocessor can make decisions based on it. + */ +/* SHORTSIZE: + * This symbol contains the value of sizeof(short) so that the C + * preprocessor can make decisions based on it. + */ +#define INTSIZE 4 /**/ +#define LONGSIZE 4 /**/ +#define SHORTSIZE 2 /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Off_t off_t /* <offset> type */ + +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include <sys/types.h> + * to get any typedef'ed information. + */ +#define Mode_t mode_t /* file mode parameter for system calls */ + +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. + */ +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. + */ +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! + */ +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). + */ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK + +/* CAN_PROTOTYPE: + * If defined, this macro indicates that the C compiler can handle + * function prototypes. + */ +/* _: + * This macro is used to declare function parameters for folks who want + * to make declarations with prototypes using a different style than + * the above macros. Use double parentheses. For example: + * + * int main _((int argc, char *argv[])); + */ +#define CAN_PROTOTYPE /**/ +#ifdef CAN_PROTOTYPE +#define _(args) args +#else +#define _(args) () +#endif + +/* RANDBITS: + * This symbol contains the number of bits of random number the rand() + * function produces. Usual values are 15, 16, and 31. + */ +#define RANDBITS 15 /**/ + +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. + */ +#define Select_fd_set_t int * /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Size_t size_t /* length paramater for string functions */ + +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include <sys/types.h> or <unistd.h> + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). + */ +#define SSize_t int /* signed count of bytes */ + +/* STDCHAR: + * This symbol is defined to be the type of char used in stdio.h. + * It has the values "unsigned char" or "char". + */ +#define STDCHAR unsigned char /**/ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * <sys/types.h> to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ + +/* LOC_SED: + * This symbol holds the complete pathname to the sed program. + */ +#define LOC_SED "" /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "MSWin32" /**/ + +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * 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. + */ +#define ARCHLIB "c:\\perl\\lib" /**/ +#define ARCHLIB_EXP (win32PerlLibPath()) /**/ + +/* BINCOMPAT3: + * This symbol, if defined, indicates that Perl 5.004 should be + * binary-compatible with Perl 5.003. + */ +/*#define BINCOMPAT3 /**/ + +/* BYTEORDER: + * This symbol holds the hexadecimal constant defined in byteorder, + * i.e. 0x1234 or 0x4321, etc... + * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture + * Binaries (MAB) on either big endian or little endian machines. + * The endian-ness is available at compile-time. This only matters + * for perl, where the config.h can be generated and installed on + * one system, and used by a different architecture to build an + * extension. Older versions of NeXT that might not have + * defined either *_ENDIAN__ were all on Motorola 680x0 series, + * so the default case (for NeXT) is big endian to catch them. + * This might matter for NeXT 3.0. + */ +#ifndef NeXT +#define BYTEORDER 0x1234 /* large digits for MSB */ +#else /* NeXT */ +#ifdef __LITTLE_ENDIAN__ +#define BYTEORDER 0x1234 +#else /* __BIG_ENDIAN__ */ +#define BYTEORDER 0x4321 +#endif /* ENDIAN CHECK */ +#endif /* NeXT */ + +/* CSH: + * This symbol, if defined, indicates that the C-shell exists. + * If defined, contains the full pathname of csh. + */ +/*#define CSH "" /**/ + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ + +/* SETUID_SCRIPTS_ARE_SECURE_NOW: + * This symbol, if defined, indicates that the bug that prevents + * setuid scripts from being secure is not present in this kernel. + */ +/* DOSUID: + * This symbol, if defined, indicates that the C program should + * check the script that it is executing for setuid/setgid bits, and + * attempt to emulate setuid/setgid on systems that have disabled + * setuid #! scripts because the kernel can't do it securely. + * It is up to the package designer to make sure that this emulation + * is done securely. Among other things, it should do an fstat on + * the script it just opened to make sure it really is a setuid/setgid + * script, it should make sure the arguments passed correspond exactly + * to the argument on the #! line, and it should not trust any + * subprocesses to which it must pass the filename rather than the + * file descriptor of the script to be executed. + */ +/*#define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ +/*#define DOSUID /**/ + +/* Gconvert: + * This preprocessor macro is defined to convert a floating point + * number to a string without a trailing decimal point. This + * emulates the behavior of sprintf("%g"), but is sometimes much more + * efficient. If gconvert() is not available, but gcvt() drops the + * trailing decimal point, then gcvt() is used. If all else fails, + * a macro using sprintf("%g") is used. Arguments for the Gconvert + * macro are: value, number of digits, whether trailing zeros should + * be retained, and the output buffer. + * Possible values are: + * d_Gconvert='gconvert((x),(n),(t),(b))' + * d_Gconvert='gcvt((x),(n),(b))' + * 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)) + +/* HAS_GETPGID: + * This symbol, if defined, indicates to the C program that + * the getpgid(pid) function is available to get the + * process group id. + */ +/*#define HAS_GETPGID /**/ + +/* HAS_GETPGRP: + * This symbol, if defined, indicates that the getpgrp routine is + * available to get the current process group. + */ +/* USE_BSD_GETPGRP: + * This symbol, if defined, indicates that getpgrp needs one + * arguments whereas USG one needs none. + */ +/*#define HAS_GETPGRP /**/ +/*#define USE_BSD_GETPGRP /**/ + +/* HAS_INET_ATON: + * This symbol, if defined, indicates to the C program that the + * inet_aton() function is available to parse IP address "dotted-quad" + * strings. + */ +/*#define HAS_INET_ATON /**/ + +/* HAS_SETPGID: + * This symbol, if defined, indicates to the C program that + * the setpgid(pid, gpid) function is available to set the + * process group id. + */ +/*#define HAS_SETPGID /**/ + +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. + */ +/* USE_BSD_SETPGRP: + * This symbol, if defined, indicates that setpgrp needs two + * arguments whereas USG one needs none. See also HAS_SETPGID + * for a POSIX interface. + */ +/* USE_BSDPGRP: + * This symbol, if defined, indicates that the BSD notion of process + * group is to be used. For instance, you have to say setpgrp(pid, pgrp) + * instead of the USG setpgrp(). This should be obsolete since + * there are systems which have BSD-ish setpgrp but USG-ish getpgrp. + */ +/*#define HAS_SETPGRP /**/ +/*#define USE_BSD_SETPGRP /**/ +/*#define USE_BSDPGRP /**/ + +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* I_DBM: + * This symbol, if defined, indicates that <dbm.h> exists and should + * be included. + */ +/* I_RPCSVC_DBM: + * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and + * should be included. + */ +/*#define I_DBM /**/ +#define I_RPCSVC_DBM /**/ + +/* I_LOCALE: + * This symbol, if defined, indicates to the C program that it should + * include <locale.h>. + */ +#define I_LOCALE /**/ + +/* I_SFIO: + * This symbol, if defined, indicates to the C program that it should + * include <sfio.h>. + */ +/*#define I_SFIO /**/ + +/* I_SYS_STAT: + * This symbol, if defined, indicates to the C program that it should + * include <sys/stat.h>. + */ +#define I_SYS_STAT /**/ + +/* I_VALUES: + * This symbol, if defined, indicates to the C program that it should + * include <values.h> to get definition of symbols like MINFLOAT or + * MAXLONG, i.e. machine dependant limitations. Probably, you + * should use <limits.h> instead, if it is available. + */ +/*#define I_VALUES /**/ + +/* Free_t: + * This variable contains the return type of free(). It is usually + * void, but occasionally int. + */ +/* Malloc_t: + * This symbol is the type of pointer returned by malloc and realloc. + */ +#define Malloc_t void * /**/ +#define Free_t void /**/ + +/* MYMALLOC: + * This symbol, if defined, indicates that we're using our own malloc. + */ +/*#define MYMALLOC /**/ + +/* OLDARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user has perl5.000 or perl5.001 architecture-dependent + * public library files for perl5. For the most part, these + * files will work with 5.002 (and later), but that is not + * guaranteed. + */ +/* OLDARCHLIB_EXP: + * This symbol contains the ~name expanded version of OLDARCHLIB, to be + * used in programs that are not prepared to deal with ~ expansion at + * run-time. + */ +/*#define OLDARCHLIB "" /**/ +/*#define OLDARCHLIB_EXP "" /**/ + +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + */ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "c:\\perl\\lib" /**/ +#define PRIVLIB_EXP "c:\\perl\\lib" /**/ + +/* SH_PATH: + * This symbol contains the full pathname to the shell used on this + * on this system to execute Bourne shell scripts. Usually, this will be + * /bin/sh, though it's possible that some systems will have /bin/ksh, + * /bin/pdksh, /bin/ash, /bin/bash, or even something such as + * D:/bin/sh.exe. + */ +#define SH_PATH "cmd /x /c" /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. + */ +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. + */ +#define 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",0 /**/ +#define 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,0 /**/ + +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * Individual sites may place their own extensions and modules in + * this directory. + */ +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * 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" /**/ + +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * Individual sites may place their own extensions and modules in + * this directory. + */ +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define SITELIB "c:\\perl\\lib\\site" /**/ +#define SITELIB_EXP "c:\\perl\\lib\\site" /**/ + +/* STARTPERL: + * This variable contains the string to put in front of a perl + * script to make sure (one hopes) that it runs with perl and not + * some shell. + */ +#define STARTPERL "#perl" /**/ + +/* USE_PERLIO: + * This symbol, if defined, indicates that the PerlIO abstraction should + * be used throughout. If not defined, stdio should be + * used in a fully backward compatible manner. + */ +/*#define USE_PERLIO /**/ + +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. + */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + +#endif +#include <win32.h> +#ifndef DEBUGGING +#define DEBUGGING +#endif diff --git a/win32/config.H b/win32/config_H.vc index 2018198084..ced62a11c8 100644 --- a/win32/config.H +++ b/win32/config_H.vc @@ -21,8 +21,25 @@ /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. + * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture + * Binaries (MAB) for targets with varying alignment. This only matters + * for perl, where the config.h can be generated and installed on one + * system, and used by a different architecture to build an extension. + * The default is eight, for safety. */ +#ifndef NeXT #define MEM_ALIGNBYTES 8 /**/ +#else /* NeXT */ +#ifdef __m68k__ +#define MEM_ALIGNBYTES 2 +#else +#ifdef __i386__ +#define MEM_ALIGNBYTES 4 +#else /* __hppa__, __sparc__ and default for unknown architectures */ +#define MEM_ALIGNBYTES 8 +#endif /* __i386__ */ +#endif /* __m68k__ */ +#endif /* NeXT */ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -1425,7 +1442,7 @@ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... - * On NeXT 4 (and greater), you can build "Fat" Multiple Architecture + * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture * Binaries (MAB) on either big endian or little endian machines. * The endian-ness is available at compile-time. This only matters * for perl, where the config.h can be generated and installed on diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 020485d66a..0769ef3112 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -10,6 +10,10 @@ if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true $opt{SUBVERSION} = $2 || '00'; } +$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'}; +$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0] + unless $opt{'cf_email'}; + while (<>) { s/~([\w_]+)~/$opt{$1}/g; diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index 701022a7fc..9e5259b254 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -85,12 +85,15 @@ struct protoent *win32_getprotoent(void); struct servent *win32_getservent(void); void win32_sethostent(int stayopen); void win32_setnetent(int stayopen); +struct netent * win32_getnetent(void); +struct netent * win32_getnetbyname(char *name); +struct netent * win32_getnetbyaddr(long net, int type); void win32_setprotoent(int stayopen); void win32_setservent(int stayopen); -void win32_endhostent(); -void win32_endnetent(); -void win32_endprotoent(); -void win32_endservent(); +void win32_endhostent(void); +void win32_endnetent(void); +void win32_endprotoent(void); +void win32_endservent(void); // // direct to our version diff --git a/win32/makedef.pl b/win32/makedef.pl index f868203ba4..73380b4b55 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -14,6 +14,8 @@ # 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 +my $CCTYPE = shift || "MSVC"; + $skip_sym=<<'!END!OF!SKIP!'; Perl_SvIV Perl_SvNV @@ -119,18 +121,13 @@ Perl_yyname Perl_yyrule allgvs curblock -curcop -curcopdb curcsv -envgv lastretstr mystack_mark perl_init_ext perl_requirepv -siggv stack statusvalue_vms -tainting Perl_safexcalloc Perl_safexmalloc Perl_safexfree @@ -158,8 +155,8 @@ while (<GLOBAL>) { next if (/_amg[ \t]*$/); $symbol = "Perl_$_"; next if ($skip_sym =~ m/$symbol/m); - print "\t$symbol"; - }; + emit_symbol($symbol); +} close(GLOBAL); # also add symbols from interp.sym @@ -175,8 +172,8 @@ while (<INTERP>) { $symbol = $_; next if ($skip_sym =~ m/$symbol/m); #print "\t$symbol"; - print "\tPerl_$symbol"; - }; + emit_symbol("Perl_" . $symbol); +} #close(INTERP); @@ -186,8 +183,22 @@ while (<DATA>) { next if (/^#/); $symbol = $_; next if ($skip_sym =~ m/^$symbol/m); - print "\t$symbol"; - }; + emit_symbol($symbol); +} + +sub emit_symbol { + my $symbol = shift; + 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"; + print "\t_$symbol\n"; + } + else { + print "\t$symbol\n"; + } +} 1; __DATA__ @@ -259,8 +270,7 @@ win32_close win32_eof win32_read win32_write -win32_spawnvpe -win32_spawnle +win32_spawnvp win32_mkdir win32_rmdir win32_chdir diff --git a/win32/makefile.mk b/win32/makefile.mk new file mode 100644 index 0000000000..b91fffc187 --- /dev/null +++ b/win32/makefile.mk @@ -0,0 +1,586 @@ +# +# Makefile to build perl on Windowns NT using Microsoft NMAKE. +# +# +# 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. +# + +# +# Set these to wherever you want "nmake install" to put your +# newly built perl. +INST_DRV=c: +INST_TOP=$(INST_DRV)\perl + +# +# uncomment one if you are using Visual C++ 2.x or Borland +# comment out both if you are using Visual C++ 4.x and above +#CCTYPE=MSVC20 +CCTYPE=BORLAND + +# +# uncomment next line if you want debug version of perl (big,slow) +#CFG=Debug + +# +# set the install locations of the compiler include/libraries +#CCHOME = f:\msdev\vc +CCHOME = D:\bc5 +CCINCDIR = $(CCHOME)\include +CCLIBDIR = $(CCHOME)\lib + +# +# set this to point to cmd.exe (only needed if you use some +# alternate shell that doesn't grok cmd.exe style commands) +SHELL = g:\winnt\system32\cmd.exe + +# +# set this to your email address (perl will guess a value from +# from your loginname and your hostname, which may not be right) +#EMAIL = + +##################### CHANGE THESE ONLY IF YOU MUST ##################### + +# +# Programs to compile, build .lib files and link +# + +.USESHELL : + +.IF "$(CCTYPE)" == "BORLAND" + +CC = bcc32 +LINK32 = tlink32 +LIB32 = tlib +IMPLIB = implib + +# +# Options +# +RUNTIME = -D_RTLDLL +INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR) +#PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch +DEFINES = -DWIN32 -DPERLDLL +SUBSYS = console +LIBC = cw32mti.lib +LIBFILES = import32.lib $(LIBC) odbc32.lib odbccp32.lib + +WINIOMAYBE = + +.IF "$(CFG)" == "Debug" +OPTIMIZE = -v $(RUNTIME) +LINK_DBG = -v +.ELSE +OPTIMIZE = -O $(RUNTIME) +LINK_DBG = +.ENDIF + +CFLAGS = -w -tWM -tWD $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) +OBJOUT_FLAG = -o + +.ELSE + +CC=cl.exe +LINK32=link.exe +LIB32=$(LINK32) -lib +# +# Options +# +.IF "$(RUNTIME)" == "" +RUNTIME = -MD +.ENDIF +INCLUDES = -I.\include -I. -I.. +#PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX +DEFINES = -DWIN32 -D_CONSOLE -DPERLDLL +SUBSYS = console + +.IF "$(RUNTIME)" == "-MD" +LIBC = msvcrt.lib +WINIOMAYBE = +.ELSE +LIBC = libcmt.lib +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 = -debug -pdb:none +.ELSE +.IF "$(CCTYPE)" == "MSVC20" +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG +.ELSE +OPTIMIZE = -Od $(RUNTIME) -DNDEBUG +.ENDIF +LINK_DBG = -release +.ENDIF + +# we don't add LIBC here, the compiler do it based on -MD/-MT +LIBFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib \ + winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ + oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + version.lib odbc32.lib odbccp32.lib + +CFLAGS = -nologo -W3 $(INCLUDES) $(DEFINES) $(PCHFLAGS) $(OPTIMIZE) +LINK_FLAGS = -nologo $(LIBFILES) $(LINK_DBG) -machine:I386 +OBJOUT_FLAG = -Fo + +.ENDIF + +#################### 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) $(OBJOUT_FLAG)$@ $< + +.IF "$(CCTYPE)" == "BORLAND" + +.obj.dll: + $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32.obj $<,$@,,$(LIBFILES),$(*B).def + $(IMPLIB) $(*B).lib $@ +.ELSE + +.obj.dll: + $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ + -out:$@ $(LINK_FLAGS) $< $(LIBPERL) + +.ENDIF + +# +INST_BIN=$(INST_TOP)\bin +INST_LIB=$(INST_TOP)\lib +INST_POD=$(INST_LIB)\pod +INST_HTML=$(INST_POD)\html +LIBDIR=..\lib +EXTDIR=..\ext +PODDIR=..\pod +EXTUTILSDIR=$(LIBDIR)\extutils + +# +# various targets +PERLIMPLIB=..\perl.lib +MINIPERL=..\miniperl.exe +PERLDLL=..\perl.dll +PERLEXE=..\perl.exe +GLOBEXE=..\perlglob.exe +CONFIGPM=..\lib\Config.pm +MINIMOD=..\lib\ExtUtils\Miniperl.pm + +PL2BAT=bin\PL2BAT.BAT +GLOBBAT = perlglob.bat + +.IF "$(CCTYPE)" == "BORLAND" + +# Borland wildargs is incompatible with MS setargv +CFGSH_TMPL = config.bc +CFGH_TMPL = config_H.bc +# Borland's perl.exe will work on W95, so we don't make this + +.ELSE + +MAKE = nmake -nologo +CFGSH_TMPL = config.vc +CFGH_TMPL = config_H.vc +PERL95EXE=..\perl95.exe + +.ENDIF + +XCOPY=xcopy /f /r /i /d +RCOPY=xcopy /f /r /i /e /d +#NULL= + +# +# filenames given to xsubpp must have forward slashes (since it puts +# full pathnames in #line strings) +XSUBPP=..\$(MINIPERL) -I..\..\lib ..\$(EXTUTILSDIR)\xsubpp -C++ -prototypes + +CORE_C= ..\av.c \ + ..\deb.c \ + ..\doio.c \ + ..\doop.c \ + ..\dump.c \ + ..\globals.c \ + ..\gv.c \ + ..\hv.c \ + ..\mg.c \ + ..\op.c \ + ..\perl.c \ + ..\perlio.c \ + ..\perly.c \ + ..\pp.c \ + ..\pp_ctl.c \ + ..\pp_hot.c \ + ..\pp_sys.c \ + ..\regcomp.c \ + ..\regexec.c \ + ..\run.c \ + ..\scope.c \ + ..\sv.c \ + ..\taint.c \ + ..\toke.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 +SOCKET=$(EXTDIR)\Socket\Socket +FCNTL=$(EXTDIR)\Fcntl\Fcntl +OPCODE=$(EXTDIR)\Opcode\Opcode +SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File +IO=$(EXTDIR)\IO\IO + +SOCKET_DLL=..\lib\auto\Socket\Socket.dll +FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll +OPCODE_DLL=..\lib\auto\Opcode\Opcode.dll +SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll +IO_DLL=..\lib\auto\IO\IO.dll + +STATICLINKMODULES=DynaLoader +DYNALOADMODULES= \ + $(SOCKET_DLL) \ + $(FCNTL_DLL) \ + $(OPCODE_DLL) \ + $(SDBM_FILE_DLL)\ + $(IO_DLL) + +POD2HTML=$(PODDIR)\pod2html +POD2MAN=$(PODDIR)\pod2man +POD2LATEX=$(PODDIR)\pod2latex +POD2TEXT=$(PODDIR)\pod2text + +# +# Top targets +# + +all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) $(GLOBBAT) + +$(DYNALOADER).obj : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c + +#------------------------------------------------------------ + +$(GLOBEXE): perlglob.obj +.IF "$(CCTYPE)" == "BORLAND" + $(CC) -c -w -v -tWM -I$(CCINCDIR) perlglob.c + $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32.obj perlglob.obj \ + $(CCLIBDIR)\32BIT\wildargs.obj,$@,,import32.lib cw32mt.lib, +.ELSE + $(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 + +perlglob.obj : perlglob.c + +..\miniperlmain.obj : ..\miniperlmain.c $(CORE_H) + +config.w32 : $(CFGSH_TMPL) + copy $(CFGSH_TMPL) config.w32 + +.\config.h : $(CFGSH_TMPL) + -del /f config.h + copy $(CFGH_TMPL) config.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" \ + "cf_email=$(EMAIL)" "libs=$(LIBFILES:f)" \ + "libpth=$(strip $(CCLIBDIR) $(LIBFILES:d))" "libc=$(LIBC)" \ + config.w32 > ..\config.sh + +$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl + cd .. && miniperl configpm + if exist lib\* $(RCOPY) lib\*.* ..\lib\$(NULL) + $(XCOPY) ..\*.h ..\lib\CORE\*.* + $(XCOPY) *.h ..\lib\CORE\*.* + $(RCOPY) include ..\lib\CORE\*.* + $(MINIPERL) -I..\lib config_h.PL || $(MAKE) CCTYPE=$(CCTYPE) \ + RUNTIME=$(RUNTIME) CFG=$(CFG) $(CONFIGPM) + +$(MINIPERL) : ..\miniperlmain.obj $(CORE_OBJ) $(WIN32_OBJ) +.IF "$(CCTYPE)" == "BORLAND" + $(LINK32) -Tpe -ap $(LINK_FLAGS) \ + @$(mktmp c0x32.obj ..\miniperlmain.obj \ + $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\),$@,,$(LIBFILES),) +.ELSE + $(LINK32) -subsystem:console -out:$@ \ + @$(mktmp $(LINK_FLAGS) ..\miniperlmain.obj \ + $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\)) +.ENDIF + +$(WIN32_OBJ) : $(CORE_H) +$(CORE_OBJ) : $(CORE_H) +$(DLL_OBJ) : $(CORE_H) + +perldll.def : $(MINIPERL) $(CONFIGPM) + $(MINIPERL) -w makedef.pl $(CCTYPE) > perldll.def + +$(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ) +.IF "$(CCTYPE)" == "BORLAND" + $(LINK32) -Tpd -ap $(LINK_FLAGS) \ + @$(mktmp c0d32.obj $(CORE_OBJ:s,\,\\) \ + $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)\n \ + $@,\n \ + $(LIBFILES)\n \ + perldll.def\n) + $(IMPLIB) $*.lib $@ +.ELSE + $(LINK32) -dll -def:perldll.def -out:$@ \ + @$(mktmp $(LINK_FLAGS) $(CORE_OBJ:s,\,\\) \ + $(WIN32_OBJ:s,\,\\) $(DLL_OBJ:s,\,\\)) +.ENDIF + $(XCOPY) $(PERLIMPLIB) ..\lib\CORE + +perl.def : $(MINIPERL) makeperldef.pl + $(MINIPERL) -I..\lib makeperldef.pl $(NULL) > perl.def + +$(MINIMOD) : $(MINIPERL) ..\minimod.pl + cd .. && miniperl minimod.pl > lib\ExtUtils\Miniperl.pm + +perlmain.c : runperl.c + copy runperl.c perlmain.c + +perlmain.obj : perlmain.c + $(CC) $(CFLAGS) -UPERLDLL -c perlmain.c + + +$(PERLEXE): $(PERLDLL) $(CONFIGPM) perlmain.obj +.IF "$(CCTYPE)" == "BORLAND" + $(LINK32) -Tpe -ap $(LINK_FLAGS) \ + @$(mktmp c0x32.obj perlmain.obj $(WINIOMAYBE)\n \ + $@,\n \ + $(PERLIMPLIB) $(LIBFILES)\n) +.ELSE + $(LINK32) -subsystem:console -out:perl.exe $(LINK_FLAGS) \ + perlmain.obj $(WINIOMAYBE) $(PERLIMPLIB) + copy perl.exe $@ + del perl.exe +.ENDIF + copy splittree.pl .. + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + attrib -r ..\t\*.* + copy test ..\t + +.IF "$(CCTYPE)" != "BORLAND" + +perl95.c : runperl.c + copy runperl.c perl95.c + +perl95.obj : perl95.c + $(CC) $(CFLAGS) -MT -UPERLDLL -c perl95.c + +win32iomt.obj : win32io.c + $(CC) $(CFLAGS) -MT -c $(OBJOUT_FLAG)win32iomt.obj win32io.c + +$(PERL95EXE): $(PERLDLL) $(CONFIGPM) perl95.obj win32iomt.obj + $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) \ + perl95.obj win32iomt.obj $(PERLIMPLIB) + copy perl95.exe $@ + del perl95.exe + +.ENDIF + +$(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) + if not exist ..\lib\auto mkdir ..\lib\auto + $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c + $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c . + +$(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs + copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs + +$(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + +$(SDBM_FILE_DLL) : $(PERLEXE) $(SDBM_FILE).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + +$(FCNTL_DLL): $(PERLEXE) $(FCNTL).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + +$(OPCODE_DLL): $(PERLEXE) $(OPCODE).xs + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + +$(SOCKET_DLL): $(SOCKET).xs $(PERLEXE) + cd $(EXTDIR)\$(*B) && \ + ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\$(*B) && $(MAKE) + +doc: $(PERLEXE) + copy ..\README.win32 ..\pod\perlwin32.pod + $(PERLEXE) ..\installhtml --podroot=.. --htmldir=./html \ + --podpath=pod:lib:ext:utils --htmlroot="//$(INST_HTML:s,:,|,)" \ + --libpod=perlfunc:perlguts:perlvar:perlrun:perlop --recurse + +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\*.* + +distclean: clean + -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ + $(PERLIMPLIB) ..\miniperl.lib $(MINIMOD) + -del /f *.def *.map + -del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \ + $(OPCODE_DLL) + -del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \ + $(DYNALOADER).c + -del /f $(PODDIR)\*.html + -del /f $(PODDIR)\*.bat + -cd $(EXTDIR) && del /s *.lib *.def *.map *.bs Makefile *.obj pm_to_blib + -rmdir /s /q ..\lib\auto + -rmdir /s /q ..\lib\CORE + +install : all doc utils + if not exist $(INST_TOP) mkdir $(INST_TOP) + echo I $(INST_TOP) L $(LIBDIR) + $(XCOPY) $(PERLEXE) $(INST_BIN)\*.* +.IF "$(PERL95EXE)" != "" + $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* +.ENDIF + $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* + $(XCOPY) $(GLOBBAT) $(INST_BIN)\*.* + $(XCOPY) $(PERLDLL) $(INST_BIN)\*.* + $(XCOPY) bin\*.* $(INST_BIN)\*.* + $(RCOPY) ..\lib $(INST_LIB)\*.* + $(XCOPY) ..\pod\*.bat $(INST_BIN)\*.* + $(XCOPY) ..\pod\*.pod $(INST_POD)\*.* + $(RCOPY) html\*.* $(INST_HTML)\*.* + +inst_lib : $(CONFIGPM) + copy splittree.pl .. + $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" "../LIB/auto" + $(RCOPY) ..\lib $(INST_LIB)\*.* + +minitest : $(MINIPERL) $(GLOBEXE) $(CONFIGPM) + $(XCOPY) $(MINIPERL) ..\t\perl.exe +.IF "$(CCTYPE)" == "BORLAND" + $(XCOPY) $(GLOBBAT) ..\t\$(NULL) +.ELSE + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) +.ENDIF + attrib -r ..\t\*.* + copy test ..\t + cd ..\t && \ + $(MINIPERL) -I..\lib test base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t + +test : all + $(XCOPY) $(PERLEXE) ..\t\$(NULL) + $(XCOPY) $(PERLDLL) ..\t\$(NULL) +.IF "$(CCTYPE)" == "BORLAND" + $(XCOPY) $(GLOBBAT) ..\t\$(NULL) +.ELSE + $(XCOPY) $(GLOBEXE) ..\t\$(NULL) +.ENDIF + cd ..\t && $(PERLEXE) -I..\lib harness + +clean : + -@erase miniperlmain.obj + -@erase $(MINIPERL) + -@erase perlglob.obj + -@erase perlmain.obj + -@erase config.w32 + -@erase /f config.h + -@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/makeperldef.pl b/win32/makeperldef.pl index 0ad09b8303..620d2ebab3 100644 --- a/win32/makeperldef.pl +++ b/win32/makeperldef.pl @@ -1,4 +1,23 @@ +my $CCTYPE = ""; print "EXPORTS\n"; foreach (@ARGV) { - print "\tboot_$_\n" - }; + if (/CCTYPE=(.*)$/) { + $CCTYPE = $1; + next; + } + emit_symbol("boot_$_"); +} + +sub emit_symbol { + my $symbol = shift; + if ($CCTYPE eq "BORLAND") { + # workaround Borland quirk by export both the straight + # name and a name with leading underscore + print "\t$symbol=_$symbol\n"; + print "\t_$symbol\n"; + } + else { + print "\t$symbol\n"; + } +} + diff --git a/win32/perlglob.c b/win32/perlglob.c index 87e8e90cd4..b2fdca2f71 100644 --- a/win32/perlglob.c +++ b/win32/perlglob.c @@ -21,7 +21,6 @@ main(int argc, char *argv[]) BOOL downcase = TRUE; /* check out the file system characteristics */ - if (GetFullPathName(".", MAX_PATH, root, &dummy)) { if (dummy = strchr(root, '\\')) *++dummy = '\0'; @@ -31,7 +30,7 @@ main(int argc, char *argv[]) } } - _setmode(_fileno(stdout), _O_BINARY); + setmode(fileno(stdout), O_BINARY); for (i = 1; i < argc; i++) { len = strlen(argv[i]); if (downcase) diff --git a/win32/perllib.c b/win32/perllib.c index 0f63938f5c..45d64d394c 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -66,10 +66,10 @@ DllMain(HANDLE hModule, /* DLL module handle */ case DLL_PROCESS_ATTACH: /* #define DEFAULT_BINMODE */ #ifdef DEFAULT_BINMODE - _setmode( _fileno( stdin ), _O_BINARY ); - _setmode( _fileno( stdout ), _O_BINARY ); - _setmode( _fileno( stderr ), _O_BINARY ); - _fmode = _O_BINARY; + setmode( fileno( stdin ), O_BINARY ); + setmode( fileno( stdout ), O_BINARY ); + setmode( fileno( stderr ), O_BINARY ); + _fmode = O_BINARY; #endif PerlDllHandle = hModule; break; diff --git a/win32/win32.c b/win32/win32.c index 7fb04166c2..6fbe7339c5 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -34,8 +34,10 @@ static DWORD IdOS(void); extern WIN32_IOSUBSYSTEM win32stdio; -__declspec(thread) PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio; -/*__declspec(thread) PWIN32_IOSUBSYSTEM pIOSubSystem = NULL;*/ +#ifndef __BORLANDC__ /* pointers cannot be declared TLS! */ +__declspec(thread) +#endif +PWIN32_IOSUBSYSTEM pIOSubSystem = &win32stdio; BOOL ProbeEnv = FALSE; DWORD Win32System = (DWORD)-1; @@ -152,6 +154,10 @@ my_popen(char *cmd, char *mode) * GSAR 97/03/13 */ fixcmd(cmd); +#ifdef __BORLANDC__ /* workaround a Borland stdio bug */ + win32_fflush(stdout); + win32_fflush(stderr); +#endif return win32_popen(cmd, mode); #else /* @@ -187,11 +193,11 @@ my_popen(char *cmd, char *mode) goto error1; if ( *(mode + 1) == _T('t') ) - tm = _O_TEXT; + tm = O_TEXT; else if ( *(mode + 1) == _T('b') ) - tm = _O_BINARY; + tm = O_BINARY; else - tm = (*mode == 'w' ? _O_BINARY : _O_TEXT); + tm = (*mode == 'w' ? O_BINARY : O_TEXT); fixcmd(cmd); @@ -317,18 +323,19 @@ IdOS(void) static char * GetShell(void) { - static char* szWin95ShellEntry = "Win95Shell"; - static char* szWin95DefaultShell = "Cmd32.exe"; - static char* szWinNTDefaultShell = "cmd.exe"; - if (!ProbeEnv) { + char* defaultshell = (IsWinNT() ? "cmd.exe" : "command.com"); + /* we don't use COMSPEC here for two reasons: + * 1. the same reason perl on UNIX doesn't use SHELL--rampant and + * uncontrolled unportability of the ensuing scripts. + * 2. PERL5SHELL could be set to a shell that may not be fit for + * interactive use (which is what most programs look in COMSPEC + * for). + */ + char *usershell = getenv("PERL5SHELL"); + ProbeEnv = TRUE; - if (IsWin95()) { - strcpy(szShellPath, szWin95DefaultShell); - } - else { - strcpy(szShellPath, szWinNTDefaultShell); - } + strcpy(szShellPath, usershell ? usershell : defaultshell); } return szShellPath; } @@ -364,8 +371,7 @@ do_aspawn(void* really, void** mark, void** arglast) } argv[index++] = 0; - status = win32_spawnvpe(P_WAIT, cmd, (const char* const*)argv, - (const char* const*)environ); + status = win32_spawnvp(P_WAIT, cmd, (const char* const*)argv); Safefree(argv); @@ -408,10 +414,7 @@ do_spawn(char *cmd) } *a = Nullch; if(argv[0]) { - status = win32_spawnvpe(P_WAIT, - argv[0], - (const char* const*)argv, - (const char* const*)environ); + status = win32_spawnvp(P_WAIT, argv[0], (const char* const*)argv); if(status != -1 || errno == 0) needToTry = FALSE; } @@ -419,11 +422,10 @@ do_spawn(char *cmd) Safefree(cmd2); } if(needToTry) { - status = win32_spawnle(P_WAIT, - shell, - shell, - "/x", - "/c", cmd, (char*)0, environ); + 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); } if (status < 0) { if (dowarn) @@ -459,7 +461,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(stat(filename, &sbuf) < 0 || sbuf.st_mode & S_IFDIR == 0) { return NULL; } @@ -674,12 +676,14 @@ kill(int pid, int sig) * File system stuff */ +#if 0 int ioctl(int i, unsigned int u, char *data) { CROAK("ioctl not implemented!\n"); return -1; } +#endif unsigned int sleep(unsigned int t) @@ -805,7 +809,9 @@ __declspec(thread) char strerror_buffer[512]; DllExport char * win32_strerror(int e) { +#ifndef __BORLANDC__ /* Borland intolerance */ extern int sys_nerr; +#endif DWORD source = 0; if(e < 0 || e > sys_nerr) { @@ -1060,13 +1066,13 @@ win32_dup2(int fd1,int fd2) } DllExport int -win32_read(int fd, char *buf, unsigned int cnt) +win32_read(int fd, void *buf, unsigned int cnt) { return pIOSubSystem->pfnread(fd, buf, cnt); } DllExport int -win32_write(int fd, const char *buf, unsigned int cnt) +win32_write(int fd, const void *buf, unsigned int cnt) { return pIOSubSystem->pfnwrite(fd, buf, cnt); } @@ -1090,23 +1096,9 @@ win32_chdir(const char *dir) } DllExport int -win32_spawnvpe(int mode, const char *cmdname, - const char *const *argv, const char *const *envp) +win32_spawnvp(int mode, const char *cmdname, const char *const *argv) { - return pIOSubSystem->pfnspawnvpe(mode, cmdname, argv, envp); -} - -DllExport int -win32_spawnle(int mode, const char *cmdname, const char *arglist,...) -{ - const char* const* envp; - const char* const* argp; - - argp = &arglist; - while (*argp++) ; - envp = (const char* const*)*argp; - - return pIOSubSystem->pfnspawnvpe(mode, cmdname, &arglist, envp); + return pIOSubSystem->pfnspawnvp(mode, cmdname, argv); } int diff --git a/win32/win32.h b/win32/win32.h index ec9eb7cc53..344ddaba59 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -25,20 +25,45 @@ /* For UNIX compatibility. */ +#ifdef __BORLANDC__ + +#define _access access +#define _chdir chdir +#include <sys/types.h> + +#pragma warn -ccc +#pragma warn -rch +#pragma warn -sig +#pragma warn -pia +#pragma warn -par +#pragma warn -aus +#pragma warn -use +#pragma warn -csu +#pragma warn -pro + +#else + typedef long uid_t; typedef long gid_t; -extern char *staticlinkmodules[]; +#endif extern uid_t getuid(void); extern gid_t getgid(void); extern uid_t geteuid(void); extern gid_t getegid(void); - extern int setuid(uid_t uid); extern int setgid(gid_t gid); + extern int kill(int pid, int sig); +extern char *staticlinkmodules[]; + +/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls + * to read the environment, bypassing the runtime's (usually broken) + * facilities for accessing the same. See note in util.c/my_setenv(). + */ +/*#define USE_WIN32_RTL_ENV */ #define USE_SOCKETS_AS_HANDLES #ifndef USE_SOCKETS_AS_HANDLES extern FILE *myfdopen(int, char *); @@ -50,10 +75,10 @@ extern FILE *myfdopen(int, char *); #define STANDARD_C 1 /* Perl5 likes standard C. */ #define DOSISH 1 /* Take advantage of DOSish code in Perl5. */ -#define OP_BINARY _O_BINARY /* Mistake in in pp_sys.c. */ +#define OP_BINARY O_BINARY /* Mistake in in pp_sys.c. */ #undef pipe -#define pipe(fd) win32_pipe((fd), 512, _O_BINARY) /* the pipe call is a bit different */ +#define pipe(fd) win32_pipe((fd), 512, O_BINARY) /* the pipe call is a bit different */ #undef pause #define pause() sleep((32767L << 16) + 32767) @@ -73,7 +98,7 @@ struct tms { }; unsigned int sleep(unsigned int); -char *win32PerlLibPath(); +char *win32PerlLibPath(void); int mytimes(struct tms *timebuf); unsigned int myalarm(unsigned int sec); int do_aspawn(void* really, void** mark, void** arglast); @@ -86,6 +111,7 @@ typedef char * caddr_t; /* In malloc.c (core address). */ */ #define DllExport __declspec(dllexport) +#define DllImport __declspec(dllimport) /* * handle socket stuff, assuming socket is always available @@ -94,7 +120,9 @@ typedef char * caddr_t; /* In malloc.c (core address). */ #include <sys/socket.h> #include <netdb.h> +#ifdef _MSC_VER #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) +#endif int IsWin95(void); int IsWinNT(void); diff --git a/win32/win32io.c b/win32/win32io.c index db156cf133..0651781342 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -65,7 +65,7 @@ dummy_globalmode(int mode) return o; } -#ifdef _DLL +#if defined(_DLL) || defined(__BORLANDC__) /* It may or may not be fixed (ok on NT), but DLL runtime does not export the functions used in the workround */ @@ -147,10 +147,10 @@ my_open_osfhandle(long osfhandle, int flags) /* copy relevant flags from second parameter */ fileflags = FDEV; - if(flags & _O_APPEND) + if(flags & O_APPEND) fileflags |= FAPPEND; - if(flags & _O_TEXT) + if(flags & O_TEXT) fileflags |= FTEXT; /* attempt to allocate a C Runtime file handle */ @@ -190,6 +190,9 @@ my_get_osfhandle( int filehandle ) return _get_osfhandle(filehandle); } +#ifdef __BORLANDC__ +#define _chdir chdir +#endif /* simulate flock by locking a range on the file */ @@ -289,7 +292,7 @@ WIN32_IOSUBSYSTEM win32stdio = { dummy_globalmode, /* (*pfunc_globalmode)(int mode) */ my_open_osfhandle, my_get_osfhandle, - spawnvpe, + spawnvp, _mkdir, _rmdir, _chdir, diff --git a/win32/win32io.h b/win32/win32io.h index 45a31f7a48..678327cd20 100644 --- a/win32/win32io.h +++ b/win32/win32io.h @@ -1,6 +1,10 @@ #ifndef WIN32IO_H #define WIN32IO_H +#ifdef __BORLANDC__ +#include <stdarg.h> +#endif + typedef struct { int signature_begin; int * (*pfnerrno)(void); @@ -51,7 +55,7 @@ int (*pfnwrite)(int fd, const void *buf, unsigned int cnt); int (*pfnopenmode)(int mode); int (*pfn_open_osfhandle)(long handle, int flags); long (*pfn_get_osfhandle)(int fd); -int (*pfnspawnvpe)(int mode, const char *cmdname, const char *const *argv, const char *const *envp); +int (*pfnspawnvp)(int mode, const char *cmdname, const char *const *argv); int (*pfnmkdir)(const char *path); int (*pfnrmdir)(const char *path); int (*pfnchdir)(const char *path); diff --git a/win32/win32iop.h b/win32/win32iop.h index c33d944307..4b4b9973d3 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -9,8 +9,8 @@ /* * function prototypes for our own win32io layer */ -EXT int * win32_errno(); -EXT char *** win32_environ(); +EXT int * win32_errno(void); +EXT char *** win32_environ(void); EXT FILE* win32_stdin(void); EXT FILE* win32_stdout(void); EXT FILE* win32_stderr(void); @@ -57,9 +57,8 @@ EXT int win32_close(int fd); EXT int win32_eof(int fd); EXT int win32_read(int fd, void *buf, unsigned int cnt); EXT int win32_write(int fd, const void *buf, unsigned int cnt); -EXT int win32_spawnvpe(int mode, const char *cmdname, - const char *const *argv, const char *const *envp); -EXT int win32_spawnle(int mode, const char *cmdname, const char *,...); +EXT int win32_spawnvp(int mode, const char *cmdname, + const char *const *argv); EXT int win32_mkdir(const char *dir, int mode); EXT int win32_rmdir(const char *dir); EXT int win32_chdir(const char *dir); @@ -95,6 +94,12 @@ void * SetIOSubSystem(void *piosubsystem); #undef ferror #undef feof +#ifdef __BORLANDC__ +#undef ungetc +#undef getc +#undef fileno +#endif + #define stderr win32_stderr() #define stdout win32_stdout() #define stdin win32_stdin() @@ -144,8 +149,7 @@ void * SetIOSubSystem(void *piosubsystem); #define write(fd,b,s) win32_write(fd,b,s) #define _open_osfhandle stolen_open_osfhandle #define _get_osfhandle stolen_get_osfhandle -#define spawnvpe win32_spawnvpe -#define spawnle win32_spawnle +#define spawnvp win32_spawnvp #define mkdir win32_mkdir #define rmdir win32_rmdir #define chdir win32_chdir diff --git a/win32/win32sck.c b/win32/win32sck.c index 891438dac9..fe5b2e7153 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -22,7 +22,7 @@ #ifdef USE_SOCKETS_AS_HANDLES /* thanks to Beverly Brown (beverly@datacube.com) */ -#define OPEN_SOCKET(x) _open_osfhandle(x,_O_RDWR|_O_BINARY) +#define OPEN_SOCKET(x) _open_osfhandle(x,O_RDWR|O_BINARY) #define TO_SOCKET(x) _get_osfhandle(x) #else diff --git a/writemain.SH b/writemain.SH index c428383085..c428383085 100644..100755 --- a/writemain.SH +++ b/writemain.SH |