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>
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:
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
-------------
*) 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
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.
$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)"
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
# 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
# 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.
correctly. For example, h2ph breaks spectacularly on type casting and
certain structures.
--=head1 cd pod && make html && mv *.html (www home dir)
-
-Some sites may wish to make the documentation in the pod/ directory
-available in HTML format. Type
-
- cd pod && make html && mv *.html <www home dir>
-
-where F<www home dir> is wherever your site keeps HTML files.
++=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)
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
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
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
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
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
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
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
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
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
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.
--- /dev/null
+#!/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.
- # You should have at least run preprel before this.
+#
+# 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();
- die "Can't make a release with MANIFEST files missing.\n" if @$missfile;
- die "Can't make a release with files not listed in MANIFEST.\n" if @$missentry;
++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*");
--- /dev/null
+#!/bin/perl -w
+#
- # Originally from Tom Horsley. Generally hacked and extended by Tim Bunce.
++# 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 $
+
- require "getopts.pl";
-
++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; # like patch -pN, strip off N dir levels from file names
++$::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;
+
- die qq{
-
- patchls [options] patchfile [ ... ]
-
- -m print formatted Meta-information (Subject,From,Msg-ID etc)
- -p N strip N levels of directory Prefix (like patch), else automatic
- -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 attempt to Categorise the patch (sort by category with -m)
- -v more verbose
- -d still more verbosity for debugging
++usage unless @ARGV;
+
- } unless @ARGV;
++getopts("mihlvcp:") or usage;
+
- &Getopts("mihlvcp:");
++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} ||= { in => $in };
++ $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
++ # 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 = '';
+ }
- $ls->{Title}{$in}=1 if !$ls->{Title} and $::opt_m and $::opt_c
- and $ls->{files_by_patch};
- $ls->{category} = intuit_category($ls, $::opt_v) if $::opt_c;
++ # 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 "All files read.\n" if $::opt_v and @ARGV > 1;
++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 $in (sort keys %ls) {
- $ls = $ls{$in};
++ foreach $ls (@ls) {
++ next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+ list_files_by_patch($ls);
+ }
+}
+else {
+ my $c = '';
- foreach $ls (sort { $a->{category} cmp $b->{category} } values %ls) {
- print "\n $ls->{category}\n" if $ls->{category} ne $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};
- list_files_by_patch($ls);
++ 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) = ($ls{$out} ||= { in => $out }, $in) if $::opt_i;
- $ls->{files_by_patch}->{$out} = 1;
++
++ $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 = shift;
- my $name = $ls->{in};
++ 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;
++ $name = "\n$name" if @meta and $name;
+ }
+ # don't print the header unless the file contains something interesting
- return if !@meta and !$ls->{files_by_patch};
++ 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) ? " $ls->{category}" : "";
- print "$name$cat: " unless $::opt_h and !$::opt_v;
++ # 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->{files_by_patch} };
++ 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(@_));
+}
+
+
+
- # CORE LANGUAGE CHANGES
- # CORE PORTABILITY
- # OTHER CORE CHANGES
- # BUILD PROCESS
- # LIBRARY AND EXTENSIONS
- # TESTS
- # UTILITIES
- # DOCUMENTATION
-
- sub intuit_category {
- my($ls, $verb) = @_;
- return 'OTHER' unless $ls->{files_by_patch};
++sub categorize_files {
++ my($files, $verb) = @_;
+ my(%c, $refine);
- foreach (keys %{ $ls->{files_by_patch} }) {
- ++$c{'DOCUMENTATION'},next
- if m:^pod/:;
- ++$c{'UTILITIES'},next
- if m:^(utils|x2p|h2pl)/:;
- ++$c{'PORTABILITY'},next
++
++ 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{'LIBRARY AND EXTENSIONS'},next
++ $c{LIB} += 10,next
+ if m:^(lib|ext)/:;
- ++$c{'TESTS'},next
- if m:^t/:;
- ++$c{'CORE LANGUAGE'},next
- if m:^[^/]+\.([chH]|sym)$:;
- ++$c{'BUILD PROCESS'},next
++ $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};
++ $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';
+ }
- 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)/) {
- print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
- ++$c{$c[1]};
- goto refine;
++ else {
++ my($c, $v) = %c;
++ $c ||= 'OTHER'; $v ||= 0;
++ print " ".@$files." patches: $c: $v\n" if $verb;
++ return $c;
+ }
- print " ", join(", ", map { "$_: $c{$_}" } @c),".\n"
- if $verb and @v > 1;
- return $c[0];
+}
+
+
+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;
+}
+
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
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
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
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
installperl
installman
keywords.pl
-- lib/splain
myconfig
opcode.pl
perly.fixer
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.
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".
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.
=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
=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 $
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.
=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
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.
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
=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
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
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
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
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":
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
=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
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 *
=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
=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
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
++
#endif
#ifdef I_UTIME
--# ifdef WIN32
++# ifdef _MSC_VER
# include <sys/utime.h>
# else
# include <utime.h>
#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
I32 fd; /* file descriptor */
Off_t length; /* length to set file to */
{
-- extern long lseek();
struct flock fl;
struct stat filebuf;
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;
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)? */
}
#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
=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.
@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
);
# 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 {
#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;
#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)) {
# 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',
localize
looks_like_number
magic_clearenv
-magic_clearenviron
++magic_clear_all_env
magic_clearpack
magic_clearsig
magic_existspack
fi
# DDE SMES Supermax Enterprise Server
--case "`uname -svm`" in
--"UNIX_SV SMES mips")
++case "`uname -sm`" in
++"UNIX_SV SMES")
if test "$cc" = '/bin/cc' -o "$gccversion" = ""
then
# for cc we need -K PIC (not -K pic)
#!/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;
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
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
--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 \
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
$pod2html = "pod/pod2html";
++usage("") unless @ARGV;
# parse the command-line
$result = GetOptions( qw(
# 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
}
++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);
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,;
}
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);
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",
sub autosplit_lib_modules{
my(@modules) = @_; # list of Module names
-- while($_ = shift @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
$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);
=head1 SEE ALSO
L<CGI::Carp>, L<CGI>
--
++
=cut
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{$_};
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 {
("@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) = @_;
C<require ExtUtils::Liblist;>
--C<ExtUtils::Liblist::ext($potential_libs, $Verbose);>
++C<ExtUtils::Liblist::ext($self, $potential_libs, $Verbose);>
=head1 DESCRIPTION
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:
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>
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
my($self) = shift;
'# Phony target to force checking subdirectories.
FORCE:
++ '.$self->{NOECHO}.'$(NOOP)
';
}
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
";
=cut
--#use Config;
++use Config;
#use Cwd;
use File::Basename;
require Exporter;
$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) = @_;
$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) = @_;
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)
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)
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);
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 $@
';
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|\\$||
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) $@
};
}
"\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.
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";
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 \
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.
sub pasthru {
my($self) = shift;
-- return "PASTHRU = /nologo"
++ return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
}
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.
sub _write_win32 {
my($data) = @_;
++ require Config;
if (not $data->{DLBASE}) {
($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
$data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
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}}) {
# 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
}
init_globals();
# cache of %pages and %items from last time we ran pod2html
-- my $podpath = '';
#undef $opt_help if defined $opt_help;
# 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";
}
}
++ 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>
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);
$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 $_;
# is it the same podpath?
$_ = <CACHE>;
chomp($_);
-- $tests++ if (join(":", @podpath) eq $_);
++ $tests++ if (join(":", @$podpath) eq $_);
# is it the same podroot?
$_ = <CACHE>;
# load the cache if its good
if ($tests != 2) {
close(CACHE);
--
-- %items = ();
return 0;
}
# is it the same podpath?
$_ = <CACHE>;
chomp($_);
-- $tests++ if (join(":", @podpath) eq $_);
++ $tests++ if (join(":", @$podpath) eq $_);
# is it the same podroot?
$_ = <CACHE>;
# load the cache if its good
if ($tests != 2) {
close(CACHE);
--
-- %pages = ();
-- %items = ();
return 0;
}
# @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)
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');
--- /dev/null
--- /dev/null
++# 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;
# 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";
}
#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) {
}
}
}
--#endif /* neither OS2 nor AMIGAOS nor _WIN32 */
++#endif /* neither OS2 nor AMIGAOS nor WIN32 */
return 0;
}
}
int
-magic_clear_all_env()
++magic_clear_all_env(sv,mg)
++SV* sv;
++MAGIC* mg;
+ {
-#if defined(VMS) || defined(WIN32)
- DIE("'%ENV = @list;' is not implemented on this machine");
++#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;
+
- return 0;
+ #endif
++#endif
++ return 0;
+ }
+
+ int
magic_getsig(sv,mg)
SV* sv;
MAGIC* mg;
croak(no_aelem, (I32)LvTARGOFF(sv));
}
}
-- SvREFCNT_inc(value);
++ (void)SvREFCNT_inc(value);
SvREFCNT_dec(LvTARG(sv));
LvTARG(sv) = value;
LvTARGLEN(sv) = 0;
switch (op->op_type) {
case OP_UNDEF:
++ modcount++;
return op;
case OP_CONST:
if (!(op->op_private & (OPpCONST_ARYBASE)))
if (op->op_type == OP_TRANS)
return pmtrans(op, expr, repl);
++ hints |= HINT_BLOCK_SCOPE;
pm = (PMOP*)op;
if (expr->op_type == OP_CONST) {
#define PATCHLEVEL 4
--#define SUBVERSION 0
++#define SUBVERSION 1
/*
local_patches -- list of locally applied less-than-subversion patches.
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
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;
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;
#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
}
$exit = 1;
}
$last_blank = /^\s+$/;
-- close(ARGV) if eof;
++ if (eof) {
++ close(ARGV);
++ $last_blank = 0;
++ }
}
exit $exit
!NO!SUBS!
Mastering Regular Expressions (the Hip Owl Book):
ISBN 1-56592-257-3 (English)
++
++A new edition of Learning Perl is due mid/late 1997.
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
=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>
(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
=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.
=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
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.
--
=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
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
=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
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
=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
@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];
}
}
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
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>) {
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,
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
=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
=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
=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<$)>
=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
=back
++=item Embedding Perl under Win32
++
=item MORAL
=item AUTHOR
=item Finding Magic
++=item Understanding the Magic of Tied Hashes and Arrays
++
=back
=item Subroutines
=item VMS implementation
++=item Win32 implementation
++
=back
=item SEE ALSO
=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
=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
=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.
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);
.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
# 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;
+
++# 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
($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;
}
if ($needspace) {
&makespace;
}
-- &escapes;
++ &escapes(0);
clear_noremap(1);
print $_, "\n";
$needspace = 1;
}
sub escapes {
++ my $indot = shift;
s/X<(.*?)>/mkindex($1)/ge;
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;
} else {
#s,L</,L<POSIX/,g;
s,L</,L<perlfunc/,g;
-- $pod{$cur} .= $_ if $cur;
++ push @{$pod{$cur} ||= []}, $_ if $cur;
}
}
$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
=head1 DESCRIPTION
--$pod{$orig}
++$body
EOF
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");
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
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;
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
if (op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
++ SETs(targ);
RETURN;
}
else {
sv_catpv(msg, " (change .h to .ph maybe?)");
if (instr(SvPVX(msg), ".ph "))
sv_catpv(msg, " (did you run h2ph?)");
- sv_catpv(msg, "\n@INC contains:\n ");
++ 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\n ", dir);
++ sv_setpvf(dirmsgsv, " %s", dir);
+ sv_catsv(msg, dirmsgsv);
+ }
++ sv_catpvn(msg, ")", 1);
+ SvREFCNT_dec(dirmsgsv);
DIE("%_", msg);
}
#endif
#ifdef I_UTIME
--# ifdef WIN32
++# ifdef _MSC_VER
# include <sys/utime.h>
# else
# include <utime.h>
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
OP* localize _((OP* arg, I32 lexical));
I32 looks_like_number _((SV* sv));
int magic_clearenv _((SV* sv, MAGIC* mg));
-int magic_clear_all_env _((void));
++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));
# $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);
$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";}
}
}
--$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"; }
for (19 .. 25) { ok $_, 1 }
}
else {
-- if ($^O eq 'qnx' || $^O eq 'amigaos') {
++ if ($^O eq 'qnx') {
chomp($wd = `pwd`);
}
else {
ok 26, $] >= 5.00319, $];
ok 27, $^O;
ok 28, $^T > 850000000, $^T;
+
-if ($Is_MSWin32) {
- ok 29, 1;
- ok 30, 1;
++if ($Is_VMS) {
++ ok 29, 1;
++ ok 30, 1;
+ }
+ else {
- %ENV = ();
- ok 29, `echo \$foo` eq "\n";
-
- $ENV{NoNeSuCh} = "foo";
- $0 = "bar";
- ok 30, `echo \$NoNeSuCh` eq "foo\n";
++ $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") );
+ }
++
$^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");
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
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?
# $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";
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";
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" }
}
}
#ifndef VMS /* VMS' my_setenv() is in VMS.c */
--#ifndef _WIN32
++#ifndef WIN32
void
my_setenv(nam,val)
char *nam, *val;
#endif /* MSDOS */
}
--I32
--setenv_getix(nam)
--char *nam;
--{
-- register I32 i, len = strlen(nam);
--
-- for (i = 0; environ[i]; i++) {
-- if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
-- break; /* strnEQ must come first to avoid */
-- } /* potential SEGV's */
-- return i;
--}
--
--#else /* if _WIN32 */
++#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 = strlen(val ? val : "");
++ 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);
-- 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);
++ (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;
++{
++ register I32 i, len = strlen(nam);
++
++ for (i = 0; environ[i]; i++) {
++ 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;
}
--#endif /* _WIN32 */
#endif /* !VMS */
#ifdef UNLINK_ALL_VERSIONS
# 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
$_ = 'Makefile.PL' if $_ eq 'makefile.pl';
}
}
--print MANI join("\n",@files);
++print MANI join("\n",@files), "\n";
close MANI;
!NO!SUBS!
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*$//;
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++;
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>;
}
}
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;
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
# 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 #####################
#
#
# Options
#
!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 ##############
.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
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=
..\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 \
..\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
# Top targets
#
--ALL: $(PERLEXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD)
++all: $(PERLEXE) $(PERL95EXE) $(GLOBEXE) $(DYNALOADMODULES) $(MINIMOD) $(GLOBBAT)
$(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
- "cc=$(CC)" "ccflags=$(RUNTIME) -DWIN32" "cf_email=$(EMAIL)" 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
$(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:$@ @<<
$(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:$@ @<<
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 ..
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)
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
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 \
-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 ..
-@erase $(MINIPERL)
-@erase perlglob.obj
-@erase perlmain.obj
++ -@erase config.w32
++ -@erase /f config.h
-@erase $(GLOBEXE)
-@erase $(PERLEXE)
-@erase $(PERLDLL)
afs='false'
alignbytes='8'
aphostname=''
- ar='tlib'
-ar='ar'
++ar='tlib /P128'
archlib='~INST_TOP~\lib'
archobjs=''
awk='awk'
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
# 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
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
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
$symbol = $_;
next if ($skip_sym =~ m/$symbol/m);
#print "\t$symbol";
-- print "\tPerl_$symbol";
-- };
++ emit_symbol("Perl_" . $symbol);
++}
#close(INTERP);
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__
win32_eof
win32_read
win32_write
--win32_spawnvpe
--win32_spawnle
++win32_spawnvp
win32_mkdir
win32_rmdir
win32_chdir
++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";
++ }
++}
++
BOOL downcase = TRUE;
/* check out the file system characteristics */
--
if (GetFullPathName(".", MAX_PATH, root, &dummy)) {
if (dummy = strchr(root, '\\'))
*++dummy = '\0';
}
}
-- _setmode(_fileno(stdout), _O_BINARY);
++ setmode(fileno(stdout), O_BINARY);
for (i = 1; i < argc; i++) {
len = strlen(argv[i]);
if (downcase)
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;
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;
* 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
/*
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);
}
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);
}
*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;
}
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)
/* 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;
}
* 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)
DllExport char *
win32_strerror(int e)
{
++#ifndef __BORLANDC__ /* Borland intolerance */
extern int sys_nerr;
++#endif
DWORD source = 0;
if(e < 0 || e > sys_nerr) {
}
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);
}
}
DllExport int
--win32_spawnvpe(int mode, const char *cmdname,
-- const char *const *argv, const char *const *envp)
-{
- return pIOSubSystem->pfnspawnvpe(mode, cmdname, argv, envp);
-}
-
-DllExport int
-win32_spawnle(int mode, const char *cmdname, const char *arglist,...)
++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
/* 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 *);
#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)
};
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);
*/
#define DllExport __declspec(dllexport)
++#define DllImport __declspec(dllimport)
/*
* handle socket stuff, assuming socket is always available
#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);
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
*/
/* 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 */
return _get_osfhandle(filehandle);
}
++#ifdef __BORLANDC__
++#define _chdir chdir
++#endif
/* simulate flock by locking a range on the file */
dummy_globalmode, /* (*pfunc_globalmode)(int mode) */
my_open_osfhandle,
my_get_osfhandle,
-- spawnvpe,
++ spawnvp,
_mkdir,
_rmdir,
_chdir,
#ifndef WIN32IO_H
#define WIN32IO_H
++#ifdef __BORLANDC__
++#include <stdarg.h>
++#endif
++
typedef struct {
int signature_begin;
int * (*pfnerrno)(void);
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);
/*
* 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);
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);
#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()
#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
#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
projects / p5sagit/p5-mst-13.2.git / commitdiff