commit ff6b7ba98e8d4aab04cbe2bfdffdfc9171c1812b Author: Mark Murray Date: Wed Sep 9 07:00:04 1998 +0000 Initial import of Perl5. The king is dead; long live the king! diff --git a/contrib/perl5/Artistic b/contrib/perl5/Artistic new file mode 100644 index 00000000000..5f221241e80 --- /dev/null +++ b/contrib/perl5/Artistic @@ -0,0 +1,131 @@ + + + + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End diff --git a/contrib/perl5/Changes b/contrib/perl5/Changes new file mode 100644 index 00000000000..325ffeb6a56 --- /dev/null +++ b/contrib/perl5/Changes @@ -0,0 +1,15896 @@ +Please note: This file provides a summary of significant changes +between versions and sub-versions of Perl, not necessarily a complete +list of each modification. If you'd like more detailed information, +please consult the comments in the patches on which the relevant +release of Perl is based. (Patches can be found on any CPAN +site, in the .../src/5.0 directory for full version releases, +or in the .../src/5/0/unsupported directory for sub-version +releases.) + + + --------------- + CAST AND CREW + --------------- + +To give due honor to those who have made Perl what is is today, +here are some of the more common names in the Changes file, and their +current addresses (as of July 1998): + + Gisle Aas + Abigail + Kenneth Albanowski + Russ Allbery + Graham Barr + Spider Boardman + Tom Christiansen + Hallvard B Furuseth + M. J. T. Guy + Jarkko Hietaniemi + Nick Ing-Simmons + Andreas Koenig + Doug MacEachern + Paul Marquess + Stephen McCamant + Laszlo Molnar + Hans Mulder + Matthias Neeracher + Jeff Okamoto + Ulrich Pfeifer + Tom Phoenix + Joshua Pritikin + Norbert Pueschel + Dean Roehrich + Hugo van der Sanden + Roderick Schertler + Kurt D. Starsinic + Dan Sugalski + Larry W. Virden + Ilya Zakharevich + +And the Keepers of the Patch Pumpkin: + + Charles Bailey + Malcolm Beattie + Tim Bunce + Andy Dougherty + Gurusamy Sarathy + Chip Salzenberg + +And, of course, the Author of Perl: + + Larry Wall + + +NOTE: Each change entry shows the change number; who checked it into the +repository; when; description of the change; which branch the change +happened in; and the affected files. The file lists have a short symbolic +indicator: + + ! modified + + added + - deleted + +> branched (from elsewhere) + !> merged changes (from elsewhere) + + +---------------- +Version 5.005_02 Second maintenance release of 5.005 +---------------- + +____________________________________________________________________________ +[ 1758] By: gsar on 1998/08/08 03:45:04 + Log: set patchlevel.h, other minor tweaks + Branch: maint-5.005/perl + ! Changes patchlevel.h pod/perlhist.pod pod/perlport.pod +____________________________________________________________________________ +[ 1757] By: gsar on 1998/08/08 03:33:33 + Log: prevent lexical leaks from Benchmark into target code (inspired by + an attempt by John Allen) + Branch: maint-5.005/perl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 1755] By: gsar on 1998/08/07 23:58:33 + Log: temporary opcode.pl workaround for ebcdic (suggested by + David J. Fiander and M.J.T. Guy) + Branch: maint-5.005/perl + ! opcode.pl +____________________________________________________________________________ +[ 1754] By: gsar on 1998/08/07 22:21:10 + Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Date: Fri, 7 Aug 1998 09:56:01 +0100 (BST) + Message-Id: <9808070856.AA28065@claudius.bfsec.bt.co.uk> + Subject: [PATCH 5.005_50 & 5.005_02] Fix for command line use of source filters + Branch: maint-5.005/perl + ! perl.c +____________________________________________________________________________ +[ 1753] By: gsar on 1998/08/07 22:19:42 + Log: perlport.pod notes from Jarkko Hietaniemi; utime() note for Win32 + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 1752] By: gsar on 1998/08/07 22:08:29 + Log: perlport.pod v1.33 from Chris Nandor + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 1751] By: gsar on 1998/08/07 22:01:04 + Log: From: Ilya Zakharevich + Date: Thu, 6 Aug 1998 19:44:16 -0400 (EDT) + Message-Id: <199808062344.TAA09505@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Minor cleanup of RE tests and docs + Branch: maint-5.005/perl + ! pod/perlre.pod t/op/regexp.t +____________________________________________________________________________ +[ 1750] By: gsar on 1998/08/07 21:51:52 + Log: allow more compatible interpretation of spaces File::DosGlob::glob() + patterns + Branch: maint-5.005/perl + ! lib/File/DosGlob.pm +____________________________________________________________________________ +[ 1749] By: gsar on 1998/08/07 21:36:04 + Log: don't use © in Test.pm (suggested by M.J.T. Guy) + Branch: maint-5.005/perl + ! lib/Test.pm +____________________________________________________________________________ +[ 1748] By: gsar on 1998/08/07 21:31:46 + Log: From: Dominic Dunlop + Date: Thu, 6 Aug 1998 12:38:07 +0000 + Message-Id: + Subject: [Patch perl5.005_02-TRIAL2] Update hints, Configure for MachTen 4.1.1 + Branch: maint-5.005/perl + ! Configure hints/machten.sh +____________________________________________________________________________ +[ 1746] By: gsar on 1998/08/05 22:55:59 + Log: MM_Win32.pm and Liblist.pm tweaks + Branch: maint-5.005/perl + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 1745] By: gsar on 1998/08/05 21:57:00 + Log: pod/perlfaq* update from Tom Christiansen + Branch: maint-5.005/perl + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq8.pod +____________________________________________________________________________ +[ 1744] By: gsar on 1998/08/05 21:53:30 + Log: From: Chris Nandor + Date: Wed, 5 Aug 1998 15:38:48 -0400 + Message-Id: + Subject: [PATCH] perlport 1.32 + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 1743] By: gsar on 1998/08/05 21:52:05 + Log: README.os2 update + From: Ilya Zakharevich + Date: Wed, 5 Aug 1998 05:44:46 -0400 (EDT) + Message-Id: <199808050944.FAA09053@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Additional OS/2 tweaks: docs, tests + Branch: maint-5.005/perl + ! README.os2 t/lib/posix.t t/op/exec.t +____________________________________________________________________________ +[ 1742] By: gsar on 1998/08/05 21:50:07 + Log: additional INSTALL notes from Jarkko Hietaniemi + on semget failure in t/lib/ipc_sysv.t + Branch: maint-5.005/perl + ! INSTALL +____________________________________________________________________________ +[ 1741] By: gsar on 1998/08/05 21:46:13 + Log: correct URL for perlcrt.dll + Branch: maint-5.005/perl + ! Changes win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1740] By: gsar on 1998/08/05 10:05:46 + Log: update Changes, patchlevel, tweak Liblist.pm + Branch: maint-5.005/perl + ! Changes lib/ExtUtils/Liblist.pm patchlevel.h +____________________________________________________________________________ +[ 1739] By: gsar on 1998/08/05 09:10:45 + Log: newer cperl-mode.el + From: Ilya Zakharevich + Date: Wed, 5 Aug 1998 03:50:16 -0400 (EDT) + Message-Id: <199808050750.DAA07240@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] CPerl update + Branch: maint-5.005/perl + ! emacs/cperl-mode.el +____________________________________________________________________________ +[ 1738] By: gsar on 1998/08/05 09:08:33 + Log: support :nosearch in ExtUtils::Liblist for win32, and make -lfoo + processing (somewhat) compiler-specific + Branch: maint-5.005/perl + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 1737] By: gsar on 1998/08/05 03:20:03 + Log: add index entries for -X + From: Ilya Zakharevich + Date: Sun, 02 Aug 1998 16:33:18 EDT + Message-Id: <199808022033.QAA18778@monk.mps.ohio-state.edu> + Subject: [PATCH] A missing docu patch + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1736] By: gsar on 1998/08/05 03:09:58 + Log: make Test::Harness optionally check for stray files when running tests + From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 18:12:48 -0400 (EDT) + Message-Id: <199808022212.SAA20126@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] File leaked from test suite + Branch: maint-5.005/perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 1735] By: gsar on 1998/08/05 02:29:46 + Log: back out change#1703 that break bincompat with PERL_OBJECT and + MULTIPLICITY + Branch: maint-5.005/perl + ! ext/re/re.pm regcomp.c regexec.c thrdvar.h +____________________________________________________________________________ +[ 1734] By: gsar on 1998/08/05 02:23:47 + Log: fixes to enable ISC to build IPC/SysV + From: Jarkko Hietaniemi + Date: 05 Aug 1998 00:59:13 +0300 + Message-ID: + Subject: [PATCH] 5.005_02-TRIAL1: (Re: Bug in pp_rename and ISC hint) + Branch: maint-5.005/perl + ! ext/IPC/SysV/SysV.xs hints/isc.sh hints/isc_2.sh +____________________________________________________________________________ +[ 1733] By: gsar on 1998/08/05 01:20:29 + Log: let some 'tr' be '$tr' for occult reasons + From: Jeff Okamoto + Date: Mon, 3 Aug 1998 11:04:30 -0700 (PDT) + Message-Id: <199808031804.LAA25595@xfiles.intercon.hp.com> + Subject: PATCH: Configure uses tr, not $tr + Branch: maint-5.005/perl + ! Configure +____________________________________________________________________________ +[ 1732] By: gsar on 1998/08/05 01:16:40 + Log: perlre.pod tweak suggested by Mike Wescott + Branch: maint-5.005/perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 1731] By: gsar on 1998/08/05 01:10:41 + Log: explain caveat about use of numeric constants in podoc for sysopen() + From: "David J. Fiander" + Date: Tue, 4 Aug 1998 13:09:58 -0400 + Message-Id: <199808041709.NAA01750@mks.com> + Subject: Re: [PATCH] 5.005_01: OE MVS + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1730] By: gsar on 1998/08/05 00:46:53 + Log: end pod processing when source file is closed (prevents it carrying + over into require()d files) + Branch: maint-5.005/perl + ! t/comp/require.t toke.c +____________________________________________________________________________ +[ 1729] By: gsar on 1998/08/04 23:03:23 + Log: correct prototype for des_fcrypt(), explain how to add it in more + detail, and supply a patch for libdes-3.06 + Branch: maint-5.005/perl + + win32/des_fcrypt.patch + ! MANIFEST README.win32 win32/Makefile win32/makefile.mk + ! win32/win32.c +____________________________________________________________________________ +[ 1728] By: gsar on 1998/08/04 21:50:40 + Log: tweak to avoid ambiguity warnings + Branch: maint-5.005/perl + ! pp.c +____________________________________________________________________________ +[ 1727] By: gsar on 1998/08/04 20:31:04 + Log: remove useless 'rcsid' (extension of a suggestion by + Stephen McCamant) + Branch: maint-5.005/perl + ! embed.h ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.c + ! global.sym gv.c perl.c vms/gen_shrfls.pl +____________________________________________________________________________ +[ 1726] By: gsar on 1998/08/04 19:52:43 + Log: correct Pod::Html's notion of email addresses + From: abigail@fnx.com + Date: Mon, 3 Aug 1998 20:22:49 -0400 (EDT) + Message-ID: <19980804002249.2011.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.005_01] lib/Pod/Html.pm + Branch: maint-5.005/perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 1725] By: gsar on 1998/08/04 19:50:06 + Log: perlport.pod additions from Peter Prymmer + Date: Mon, 3 Aug 98 15:31:35 PDT + Message-Id: <9808032231.AA22324@forte.com> + -- + Date: Tue, 4 Aug 98 12:44:20 PDT + Message-Id: <9808041944.AA04815@forte.com> + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 1724] By: gsar on 1998/08/04 18:08:07 + Log: From: Chris Nandor + Date: Mon, 3 Aug 1998 13:35:25 -0400 + Message-Id: + Subject: [PATCH] perlport 1.30 + Branch: maint-5.005/perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 1723] By: gsar on 1998/08/04 18:06:13 + Log: update postscript generator + From: Tom Christiansen + Date: Mon, 3 Aug 1998 05:29:25 -0600 + Message-Id: <199808031129.FAA24985@chthon.perl.com> + Subject: PATCH: pod/roffitall (5.005_02) + Branch: maint-5.005/perl + ! pod/roffitall +____________________________________________________________________________ +[ 1722] By: gsar on 1998/08/03 17:01:12 + Log: applied suggested patch, slightly tweaked + From: Jarkko Hietaniemi + Date: Mon, 3 Aug 1998 11:52:30 +0300 (EET DST) + Message-Id: <199808030852.LAA14153@alpha.hut.fi> + Subject: [PATCH] perl5.005_02-TRIAL1: pod/perlhist.pod + Branch: maint-5.005/perl + ! pod/perlhist.pod +____________________________________________________________________________ +[ 1721] By: gsar on 1998/08/03 16:30:20 + Log: fix segfault when threadsv is used as foreach itervar + From: Stephen McCamant + Date: Sun, 02 Aug 1998 21:44:34 CDT + Message-Id: <13765.8641.997452.14516@alias-2.pr.mcs.net> + Subject: [PATCH] threadsv index in enteriter targ in op_free() + Branch: maint-5.005/perl + ! op.c +____________________________________________________________________________ +[ 1720] By: gsar on 1998/08/02 23:33:42 + Log: close() open files before unlink() + From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 18:14:22 -0400 (EDT) + Message-Id: <199808022214.SAA20135@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] File leaked from test suite - tests + Branch: maint-5.005/perl + ! t/base/rs.t t/op/defins.t +____________________________________________________________________________ +[ 1719] By: gsar on 1998/08/02 23:31:51 + Log: more pack() tests + From: Jarkko Hietaniemi + Date: Mon, 3 Aug 1998 00:59:41 +0300 (EET DST) + Message-Id: <199808022159.AAA17160@alpha.hut.fi> + Subject: Re: uudecode 'u' problem + Branch: maint-5.005/perl + ! t/op/pack.t +____________________________________________________________________________ +[ 1718] By: gsar on 1998/08/02 23:26:51 + Log: t/TEST aesthetic tweak suggested by Jarkko + Branch: maint-5.005/perl + ! t/TEST +____________________________________________________________________________ +[ 1717] By: gsar on 1998/08/02 23:23:43 + Log: add Digital Unix 3.x notes to README.threads (as suggested by + Phoenix ) + Branch: maint-5.005/perl + ! README.threads +____________________________________________________________________________ +[ 1716] By: gsar on 1998/08/02 23:15:00 + Log: allow *FOO{BAR}[0] etc. (without intervening arrow) + From: Stephen McCamant + Date: Sun, 2 Aug 1998 16:16:50 -0500 (CDT) + Message-ID: <13764.54929.60137.104838@alias-2.pr.mcs.net> + Subject: [PATCH] Re: Minor nit in glob notation + Branch: maint-5.005/perl + ! Changes op.c +____________________________________________________________________________ +[ 1715] By: gsar on 1998/08/02 22:49:53 + Log: fix unpack('u',...) problem with spaces in input + Branch: maint-5.005/perl + ! pp.c t/op/pack.t +____________________________________________________________________________ +[ 1714] By: gsar on 1998/08/02 21:27:19 + Log: update location of perlcrt.dll for win32 builds + Branch: maint-5.005/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1713] By: gsar on 1998/08/02 09:28:32 + Log: From: Ilya Zakharevich + Date: Sun, 2 Aug 1998 04:35:11 -0400 (EDT) + Message-Id: <199808020835.EAA09367@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Better debugging output from malloc.c + Branch: maint-5.005/perl + ! malloc.c +____________________________________________________________________________ +[ 1712] By: gsar on 1998/08/02 09:16:55 + Log: fix longstanding bug in pack('u',...) (reads garbage beyond the end + of the input string) + Branch: maint-5.005/perl + ! pp.c +____________________________________________________________________________ +[ 1711] By: gsar on 1998/08/02 08:14:25 + Log: update Changes, tweak Porting/makerel + Branch: maint-5.005/perl + ! Changes Porting/makerel +____________________________________________________________________________ +[ 1710] By: gsar on 1998/08/02 07:31:37 + Log: remove CRs from djgpp/configure.bat (Porting/makerel adds them) + Branch: maint-5.005/perl + ! djgpp/configure.bat +____________________________________________________________________________ +[ 1709] By: gsar on 1998/08/02 07:27:34 + Log: Porting/makerel tweaks + Branch: maint-5.005/perl + ! Porting/makerel +____________________________________________________________________________ +[ 1708] By: gsar on 1998/08/02 07:09:35 + Log: fixes for pod noises + Branch: maint-5.005/perl + ! ext/B/B/Bytecode.pm ext/Thread/Thread/Specific.pm + ! pod/perlembed.pod pod/perlfaq.pod +____________________________________________________________________________ +[ 1707] By: gsar on 1998/08/02 06:59:47 + Log: malloc.c tweaks + From: Ilya Zakharevich + Date: Sat, 01 Aug 1998 18:46:32 EDT + Message-Id: <199808012246.SAA00699@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_*] Better malloc.c + Branch: maint-5.005/perl + ! malloc.c +____________________________________________________________________________ +[ 1706] By: gsar on 1998/08/02 06:56:37 + Log: fix quoting of keys with embedded nulls + From: Slaven Rezic + Date: Sat, 01 Aug 1998 13:38:03 +0200 + Message-Id: <199808011138.NAA05189@mail.cs.tu-berlin.de> + Subject: Data::Dumper 2.09, patch + Branch: maint-5.005/perl + ! ext/Data/Dumper/Dumper.xs +____________________________________________________________________________ +[ 1705] By: gsar on 1998/08/02 06:50:07 + Log: From: pvhp@forte.com (Peter Prymmer) + Date: Fri, 31 Jul 1998 14:50:41 PDT + Message-Id: <9807312150.AA08867@forte.com> + Subject: Re: \Q doesn't work in interpolated regular expressions + Branch: maint-5.005/perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 1704] By: gsar on 1998/08/02 06:37:06 + Log: add test for magic autovivification + From: "M.J.T. Guy" + Date: Thu, 30 Jul 1998 12:18:15 +0100 + Message-Id: + Subject: Re: Perl5.005_01 failing to autovivify subroutine args + Branch: maint-5.005/perl + ! pod/perldiag.pod t/cmd/subval.t +____________________________________________________________________________ +[ 1703] By: gsar on 1998/08/02 06:26:57 + Log: From: Ilya Zakharevich + Date: Tue, 21 Jul 1998 23:58:53 -0400 (EDT) + Message-Id: <199807220358.XAA19811@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_76] better RE colors + Branch: maint-5.005/perl + ! ext/re/re.pm regcomp.c regexec.c thrdvar.h +____________________________________________________________________________ +[ 1702] By: gsar on 1998/08/02 06:22:15 + Log: mark link type of exported functions for OS/2 + From: Ilya Zakharevich + Date: Sun, 26 Jul 1998 21:03:03 -0400 (EDT) + Message-Id: <199807270103.VAA04977@monk.mps.ohio-state.edu> + Subject: Re: Compiler linkage's types [PATCH 5.005] + Branch: maint-5.005/perl + ! os2/os2ish.h proto.h +____________________________________________________________________________ +[ 1701] By: gsar on 1998/08/02 06:16:03 + Log: tweaked version of suggested patch + From: Ilya Zakharevich + Date: Mon, 20 Jul 1998 21:40:00 -0400 (EDT) + Message-Id: <199807210140.VAA17186@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_75] Enable -DS + Branch: maint-5.005/perl + ! README.threads ext/Thread/Thread.xs ext/Thread/typemap mg.c + ! op.c perl.c perl.h pod/perlrun.pod pp.c pp_hot.c scope.c + ! thread.h util.c win32/win32thread.c +____________________________________________________________________________ +[ 1700] By: gsar on 1998/08/02 05:54:00 + Log: up patchlevel to 5.005_02 + Branch: maint-5.005/perl + ! Changes patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1699] By: gsar on 1998/08/02 05:50:01 + Log: From: Ilya Zakharevich + Message-Id: <199807180809.EAA09379@monk.mps.ohio-state.edu> + Date: Sat, 18 Jul 1998 04:09:26 -0400 (EDT) + Subject: [PATCH 5.004_72] Make tests succeed on OS/2 + Branch: maint-5.005/perl + ! t/io/fs.t t/lib/io_pipe.t t/lib/io_sock.t t/op/stat.t +____________________________________________________________________________ +[ 1698] By: gsar on 1998/08/02 05:41:41 + Log: use I32_MAX as the limit when U16_MAX > I32_MAX (for CRAY) + Branch: maint-5.005/perl + ! regcomp.c +____________________________________________________________________________ +[ 1697] By: gsar on 1998/08/02 05:20:12 + Log: support OE/MVS + From: Jarkko Hietaniemi + Message-Id: <199808010903.MAA09371@alpha.hut.fi> + Date: Sat, 1 Aug 1998 12:03:02 +0300 (EET DST) + Subject: [PATCH] 5.005_01: OE MVS + Branch: maint-5.005/perl + + README.os390 ebcdic.c + ! Configure MANIFEST doio.c ext/Errno/Errno_pm.PL gv.c handy.h + ! hints/os390.sh lib/bigint.pl mg.c patchlevel.h perl.c perl.h + ! perly.c perly.h perly.y perly_c.diff pod/perldelta.pod + ! pod/perlport.pod pp.c pp_ctl.c pp_hot.c pp_sys.c sv.c + ! t/base/term.t t/comp/package.t t/comp/require.t + ! t/lib/bigintpm.t t/lib/cgi-html.t t/lib/filehand.t t/lib/ph.t + ! t/op/auto.t t/op/bop.t t/op/each.t t/op/magic.t t/op/misc.t + ! t/op/ord.t t/op/pack.t t/op/quotemeta.t t/op/re_tests + ! t/op/regexp.t t/op/sort.t t/op/sprintf.t t/op/subst.t + ! t/op/taint.t t/op/universal.t t/pragma/constant.t + ! t/pragma/overload.t t/pragma/subs.t toke.c x2p/a2p.h + ! x2p/a2py.c +____________________________________________________________________________ +[ 1696] By: gsar on 1998/08/02 05:03:09 + Log: VMS patches + From: pvhp@forte.com (Peter Prymmer) + Message-Id: <9807290017.AA01833@forte.com> + Date: Tue, 28 Jul 98 17:17:33 PDT + Subject: Re: Not OK: perl 5.00501 on VMS_AXP-thread I7.2 + -- + From: Dan Sugalski + Message-Id: <3.0.5.32.19980729125623.00b562b0@ous.edu> + Date: Wed, 29 Jul 1998 12:56:23 -0700 + Subject: [PATCH 5.005_01]Typo in CONFIGURE.COM (vms) + -- + From: Dan Sugalski + Date: Thu, 30 Jul 1998 09:02:24 -0700 + Message-Id: <3.0.5.32.19980730090224.00b70eb0@ous.edu> + Subject: [PATCH 5.005_01]VMS config SOCKETSHR typo patch and fcntl check + Branch: maint-5.005/perl + ! configure.com vms/subconfigure.com +____________________________________________________________________________ +[ 1695] By: gsar on 1998/08/02 04:49:32 + Log: rename duplicate warning in regexec.c + Branch: maint-5.005/perl + ! regexec.c +____________________________________________________________________________ +[ 1694] By: gsar on 1998/08/02 04:44:20 + Log: beware egcs' ld on Solaris + From: Tom Spindler + Message-ID: <19980801212158.A2934@home.merit.edu> + Date: Sat, 1 Aug 1998 21:21:58 -0400 + Subject: Re: [PATCH perl5.005_01] hints/solaris_2.sh, egcs, and ld + Branch: maint-5.005/perl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 1693] By: gsar on 1998/08/02 04:41:43 + Log: de-utf-ized variation of Ilya's patch + From: Jan-Pieter Cornet + Date: 31 Jul 1998 12:44:57 +0200 + Message-ID: <6ps779$hmj$1@xs1.xs4all.nl> + Subject: Re: s/\s*$//g in majordomo causes segfault under 5.005_01 + Branch: maint-5.005/perl + ! regexec.c +____________________________________________________________________________ +[ 1692] By: gsar on 1998/08/02 04:39:14 + Log: better validation of SysV IPC availability + From: Jarkko Hietaniemi + Date: Fri, 31 Jul 1998 13:13:57 +0300 (EEST) + Message-Id: <199807311013.NAA28887@koah.research.nokia.com> + Subject: Re: lib/ipc_sysv.t fails under FreeBSD 2.2.1 + Branch: maint-5.005/perl + ! Configure INSTALL ext/IPC/SysV/SysV.xs pod/perldiag.pod + ! t/lib/ipc_sysv.t +____________________________________________________________________________ +[ 1691] By: gsar on 1998/08/02 04:32:30 + Log: fix bug in display of watched expressions + From: Ilya Zakharevich + Date: Thu, 30 Jul 1998 20:02:04 -0400 (EDT) + Message-Id: <199807310002.UAA21681@monk.mps.ohio-state.edu> + Subject: Re: Bug? in perl5db.pl [PATCH] + Branch: maint-5.005/perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 1690] By: gsar on 1998/08/02 04:29:08 + Log: applied all but one hunk + From: Horst von Brand + Date: Thu, 30 Jul 1998 17:19:42 -0400 + Message-Id: <199807302119.RAA06852@sleipnir.valparaiso.cl> + Subject: Some typos in perldelta.pod + Branch: maint-5.005/perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 1689] By: gsar on 1998/08/02 04:27:02 + Log: From: Andy Dougherty + Date: Thu, 30 Jul 1998 10:22:36 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.005_05] Remove redundant dTHR + Branch: maint-5.005/perl + ! mg.c sv.c +____________________________________________________________________________ +[ 1688] By: gsar on 1998/08/02 04:25:49 + Log: From: Tom Hughes + Date: 30 Jul 1998 09:47:31 +0100 + Message-ID: + Subject: Class::Struct has an incomplete tied array package + Branch: maint-5.005/perl + ! lib/Class/Struct.pm +____________________________________________________________________________ +[ 1687] By: gsar on 1998/08/02 04:21:48 + Log: ensure implicit close on local(*FH) doesn't affect $! and thence $? + Branch: maint-5.005/perl + ! sv.c t/op/die_exit.t +____________________________________________________________________________ +[ 1686] By: gsar on 1998/08/02 03:57:28 + Log: From: Jarkko Hietaniemi + Date: Thu, 30 Jul 1998 00:39:30 +0300 (EET DST) + Message-Id: <199807292139.AAA01795@alpha.hut.fi> + Subject: Re: [PATCH] 5.004_05-MAINT_TRIAL_5: three locale fixes + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.xs pod/perllocale.pod +____________________________________________________________________________ +[ 1685] By: gsar on 1998/08/02 03:54:15 + Log: PERL_OBJECT bincompat fixes from Douglas Lankshear + Date: Wed, 29 Jul 1998 10:45:31 -0700 + Message-ID: <000101bdbb18$ae767550$a32fa8c0@tau.Active> + Subject: [PATCH 5.005_01] Fixes binary compatibility for PERL_OBJECT + -- + Date: Sat, 1 Aug 1998 09:33:19 -0700 + Message-ID: <000701bdbd6a$17ada180$a32fa8c0@tau.Active> + Subject: [PATCH 5.005_01] + Branch: maint-5.005/perl + ! perl.h proto.h +____________________________________________________________________________ +[ 1684] By: gsar on 1998/08/02 03:49:33 + Log: hand-apply whitespace-mutiliated patch + From: Nicholas Clark + Date: Tue, 28 Jul 1998 16:40:42 +0100 (BST) + Message-Id: <199807281540.QAA04640@flirble.org> + Subject: [PATCH] POSIX::ELOOP + Branch: maint-5.005/perl + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 1683] By: gsar on 1998/08/02 03:45:26 + Log: document return values of do() better + From: "M.J.T. Guy" + Date: Tue, 28 Jul 1998 12:44:36 +0100 + Message-Id: + Subject: [PATCH] Re: Obscurity of lexicals with do "" + Branch: maint-5.005/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1682] By: gsar on 1998/08/02 03:42:26 + Log: avoid reusing foreach itervar if magic got tacked onto it + From: Stephen McCamant + Date: Tue, 28 Jul 1998 22:18:25 -0500 (CDT) + Message-ID: <13758.36756.215424.719750@alias-2.pr.mcs.net> + Subject: [PATCH] Re: pos() resetting changed with 5.005? + Branch: maint-5.005/perl + ! pp_hot.c +____________________________________________________________________________ +[ 1681] By: gsar on 1998/08/02 03:39:27 + Log: From: Nick Ing-Simmons + Date: Wed, 29 Jul 1998 13:28:14 +0100 + Message-Id: <199807291228.NAA20055@tiuk.ti.com> + Subject: [Patch] Math::Complex - Ambiguous call resolved as CORE::foo() + Branch: maint-5.005/perl + + Porting/fixCORE + ! MANIFEST lib/Math/Complex.pm +____________________________________________________________________________ +[ 1680] By: gsar on 1998/08/02 03:33:07 + Log: From: h.sanden@elsevier.nl (Hugo van der Sanden) + Date: Mon, 27 Jul 1998 13:34:45 +0200 + Message-Id: <199807271134.NAA24475@dorlas.elsevier.nl> + Subject: perlcall.pod + Branch: maint-5.005/perl + ! pod/perlcall.pod +____________________________________________________________________________ +[ 1679] By: gsar on 1998/08/02 03:29:41 + Log: MM_Win32::maybe_command() case-insesitivity tweak + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 1678] By: gsar on 1998/08/02 03:24:29 + Log: fix MM_Win32::maybe_command() + Branch: maint-5.005/perl + ! lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 1677] By: gsar on 1998/08/01 19:52:19 + Log: fixes for overloading bugs and docs, tweaked some + From: Ilya Zakharevich + Date: Sat, 25 Jul 1998 21:28:16 -0400 (EDT) + Message-Id: <199807260128.VAA10543@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_76] better overloading + Branch: maint-5.005/perl + ! Changes gv.c lib/dumpvar.pl lib/overload.pm lib/perl5db.pl + ! t/pragma/overload.t +____________________________________________________________________________ +[ 1676] By: gsar on 1998/08/01 19:37:13 + Log: stray s/foo/PL_foo/ + From: win@in.rhein-main.de (Winfried Koenig) + Date: Mon, 27 Jul 98 21:13 MET + Message-Id: + Subject: Bug in pp_rename and ISC hint + Branch: maint-5.005/perl + ! pp_sys.c +____________________________________________________________________________ +[ 1675] By: gsar on 1998/08/01 19:22:13 + Log: newer Porting/patchls from maint-5.004 + Branch: maint-5.005/perl + ! Porting/patchls +____________________________________________________________________________ +[ 1674] By: gsar on 1998/08/01 17:50:44 + Log: fix buggy detection of failed glob() + Branch: maint-5.005/perl + ! pp_hot.c +____________________________________________________________________________ +[ 1673] By: gsar on 1998/07/29 18:14:32 + Log: fix typo in change#1489 that prevented magic-autovivification + Branch: maint-5.005/perl + ! mg.c + +---------------- +Version 5.005_01 First maintenance release of 5.005 +---------------- + +____________________________________________________________________________ +[ 1669] By: gsar on 1998/07/26 23:19:02 + Log: update Changes; add sv_*_mg() entries in win32/GenCAPI.pl + Branch: maint-5.005/perl + ! Changes proto.h win32/GenCAPI.pl +____________________________________________________________________________ +[ 1668] By: gsar on 1998/07/26 21:12:11 + Log: s/TMP_CRLF_PATCH/PERL_STRICT_CR/ with sense reversed, so they + can disable it from config.sh if they want; up patchlevel to 5_01; + little tweaks to pods + Branch: maint-5.005/perl + ! README.win32 patchlevel.h pod/perldelta.pod toke.c + ! win32/Makefile win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk win32/win32.c +____________________________________________________________________________ +[ 1662] By: gsar on 1998/07/26 05:01:52 + Log: add missing sv_*_mg() prototypes in proto.h, update perlhist.pod + Branch: maint-5.005/perl + ! pod/perlhist.pod proto.h +____________________________________________________________________________ +[ 1658] By: gsar on 1998/07/26 02:23:46 + Log: VMS patches from Dan Sugalski + Date: Fri, 24 Jul 1998 11:38:25 -0700 + Message-Id: <3.0.5.32.19980724113825.00a067b0@ous.edu> + Subject: [PATCH 5.005] version number problem with VMS (Corrected) + -- + Date: Fri, 24 Jul 1998 12:30:36 -0700 + Message-Id: <3.0.5.32.19980724123036.009f0390@ous.edu> + Subject: [PATCH 5.005]Tweaks to README.vms + -- + Date: Sat, 25 Jul 1998 17:56:55 -0700 (PDT) + Message-ID: + Subject: [PATCH 5.005] Final build cleanup patch + Branch: maint-5.005/perl + ! README.vms vms/descrip_mms.template vms/subconfigure.com +____________________________________________________________________________ +[ 1657] By: gsar on 1998/07/26 02:19:50 + Log: another platform where pp_sselect() needs a whole fd_set buffer + From: Lupe Christoph + Date: Sat, 25 Jul 1998 19:49:33 +0200 (MET DST) + Message-Id: <199807251749.TAA22347@alanya.m.isar.de> + Subject: Patch for Not OK: perl 5.005 on i86pc-solaris-thread 2.6 + Branch: maint-5.005/perl + ! pp_sys.c +____________________________________________________________________________ +[ 1656] By: gsar on 1998/07/26 02:12:46 + Log: fix problem building modules on dos-djgpp + From: Laszlo Molnar + Date: Sat, 25 Jul 1998 00:53:39 +0200 + Message-ID: <19980725005339.C222@cdata.tvnet.hu> + Subject: [PATCH 5.005] dos-djgpp and modules problem + Branch: maint-5.005/perl + ! djgpp/fixpmain +____________________________________________________________________________ +[ 1655] By: gsar on 1998/07/26 02:11:09 + Log: From: Tom Spindler + Date: Wed, 22 Jul 1998 16:11:07 -0400 + Message-ID: <19980722161107.A16813@home.merit.edu> + Subject: [PATCH 5.005] BeOS tweak + Branch: maint-5.005/perl + ! hints/beos.sh +____________________________________________________________________________ +[ 1654] By: gsar on 1998/07/26 02:09:29 + Log: various pod tweaks + Branch: maint-5.005/perl + ! Changes pod/perldelta.pod pod/perlmodinstall.pod + ! pod/perltoc.pod +____________________________________________________________________________ +[ 1653] By: gsar on 1998/07/26 02:05:46 + Log: fix emacs/ptags for PL_* changes + From: Ilya Zakharevich + Date: Fri, 24 Jul 1998 03:12:35 -0400 (EDT) + Message-Id: <199807240712.DAA04204@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_76] Yet better ptags + Branch: maint-5.005/perl + ! emacs/ptags +____________________________________________________________________________ +[ 1652] By: gsar on 1998/07/26 02:03:01 + Log: fix behavior of <=> on bigints + From: "M.J.T. Guy" + Message-Id: + Date: Fri, 24 Jul 1998 18:29:53 +0100 + Subject: [PATCH] Re: Math::BigInt <=> op is not correct. + Branch: maint-5.005/perl + ! lib/Math/BigInt.pm t/lib/bigintpm.t +____________________________________________________________________________ +[ 1649] By: gsar on 1998/07/24 03:56:56 + Log: create maint-5.005 branch + Branch: maint-5.005/perl + +> (branch 1079 files) +____________________________________________________________________________ +[ 1648] By: gsar on 1998/07/24 03:36:35 + Log: un-checked-in 5.005 Changes (this is 5.005 *exactly*) + Branch: perl + ! Changes + +------------- +Version 5.005 Production release +------------- + +____________________________________________________________________________ +[ 1647] By: gsar on 1998/07/22 21:11:29 + Log: sneak in hints/irix_6.sh update + Branch: perl + ! Changes hints/irix_6.sh +____________________________________________________________________________ +[ 1646] By: gsar on 1998/07/22 21:00:44 + Log: Update perldelta and Changes; refresh perltoc; newer perlembed.pod + from Jon Orwant ; update guts documentation + to reflect PL_* changes; is this *it* for 5.005? + Branch: perl + ! Changes README.win32 patchlevel.h pod/perlcall.pod + ! pod/perldelta.pod pod/perlembed.pod pod/perlguts.pod + ! pod/perltoc.pod pod/perlxs.pod +____________________________________________________________________________ +[ 1645] By: gsar on 1998/07/22 19:37:41 + Log: don't use qualify() in class methods + From: Albert Dvornik + Date: 22 Jul 1998 15:14:46 EDT + Message-Id: + Subject: [PATCH 5.005-MAYBE] Bug in IO::Handle->input_record_separator + Branch: perl + ! ext/IO/lib/IO/Handle.pm +____________________________________________________________________________ +[ 1644] By: gsar on 1998/07/22 18:13:31 + Log: newer perlembed.pod + Branch: perl + ! pod/perlembed.pod +____________________________________________________________________________ +[ 1643] By: gsar on 1998/07/22 18:03:42 + Log: From: Andy Dougherty + Date: Wed, 22 Jul 1998 13:42:20 EDT + Message-Id: + Subject: Re: 5.005 - a sneak preview + Branch: perl + ! Porting/pumpkin.pod +____________________________________________________________________________ +[ 1642] By: gsar on 1998/07/22 17:58:42 + Log: add perlmodinstall, regen perltoc + Branch: perl + + pod/perlmodinstall.pod + ! MANIFEST pod/Makefile pod/buildtoc pod/perl.pod + ! pod/perltoc.pod win32/pod.mak +____________________________________________________________________________ +[ 1641] By: gsar on 1998/07/22 17:11:55 + Log: support optional crypt() with PERL_OBJECT + From: "Douglas Lankshear" + Date: Wed, 22 Jul 1998 08:21:10 PDT + Message-Id: <000701bdb584$5b57c070$a32fa8c0@tau.Active> + Subject: [PATCH 5.005 maybe] for crypt with PERL_OBJECT + Branch: perl + ! iperlsys.h pp.c win32/Makefile win32/makefile.mk + ! win32/perlhost.h win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 1640] By: gsar on 1998/07/22 17:09:11 + Log: win32 tweaks + Date: Wed, 22 Jul 1998 07:09:09 PDT + Message-Id: <000001bdb57a$4bc9dd00$a32fa8c0@tau.Active> + From: "Douglas Lankshear" + Branch: perl + ! win32/Makefile win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 1639] By: gsar on 1998/07/22 17:00:30 + Log: From: d-lewart@uiuc.edu (Daniel S. Lewart) + Date: Wed, 22 Jul 1998 06:20:08 CDT + Message-Id: <199807221120.GAA07962@staff2.cso.uiuc.edu> + Subject: [PATCH] lib/Sys/Syslog.pm doc + Branch: perl + ! Changes lib/Sys/Syslog.pm +____________________________________________________________________________ +[ 1638] By: gsar on 1998/07/22 09:12:26 + Log: up patchlevel etc (only doc patching from now on, testing in progress) + Branch: perl + ! Changes patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1637] By: gsar on 1998/07/22 08:27:09 + Log: VMS patches from Dan Sugalski + Date: Tue, 21 Jul 1998 16:04:40 PDT + Message-Id: <3.0.5.32.19980721160440.00a916f0@ous.edu> + Subject: [PATCH 5.004_76]Document Vax C's death for VMS + -- + Date: Tue, 21 Jul 1998 16:08:57 PDT + Message-Id: <3.0.5.32.19980721160857.00a6d250@ous.edu> + Subject: [PATCH 5.004_76]fix clean/realclean targets of VMS' makefile + -- + Date: Tue, 21 Jul 1998 16:05:56 PDT + Message-Id: <3.0.5.32.19980721160556.00a1a100@ous.edu> + Subject: [PATCH 5.004_76]Note the record-read capabilities of $/ in perldelta.pod + Branch: perl + ! README.vms pod/perldelta.pod vms/descrip_mms.template +____________________________________________________________________________ +[ 1636] By: gsar on 1998/07/22 08:04:37 + Log: fix quoting in t/io/inplace.t + Branch: perl + ! t/io/inplace.t +____________________________________________________________________________ +[ 1635] By: gsar on 1998/07/22 07:59:30 + Log: From: Dan Sugalski + Date: Tue, 21 Jul 1998 13:06:44 PDT + Message-Id: <3.0.5.32.19980721130644.00ac5100@ous.edu> + Subject: [PATCH 5.004_76]t/io/inplace.t enabled for VMS + Branch: perl + ! t/io/inplace.t vms/test.com +____________________________________________________________________________ +[ 1634] By: gsar on 1998/07/22 07:55:35 + Log: From: Dan Sugalski + Date: Tue, 21 Jul 1998 12:42:20 PDT + Message-Id: <3.0.5.32.19980721124220.00a82a20@ous.edu> + Subject: [PATCH 5.004_76]Fix inplace editing for VMS + Branch: perl + ! doio.c +____________________________________________________________________________ +[ 1633] By: gsar on 1998/07/22 07:53:53 + Log: fix AIX hints for PL_* changes + From: Jarkko Hietaniemi + Date: Tue, 21 Jul 1998 22:53:54 +0300 + Message-Id: <199807211953.WAA55724@vipunen.hut.fi> + Subject: Re: _76 fails to link B extension on AIX 414 + Branch: perl + ! perl_exp.SH +____________________________________________________________________________ +[ 1632] By: gsar on 1998/07/22 07:51:56 + Log: From: Anton Berezin + Date: Tue, 21 Jul 1998 21:46:45 +0200 + Message-Id: <199807211946.VAA01301@lion.plab.ku.dk> + Subject: [PATCH _76] t/op/eval.t test for eval & scoping of lexicals + Branch: perl + ! t/op/eval.t +____________________________________________________________________________ +[ 1631] By: gsar on 1998/07/22 07:48:20 + Log: applied patch, with tweak suggested by Michael Parker + From: Andy Dougherty + Date: Tue, 21 Jul 1998 14:30:05 EDT + Message-Id: + Subject: Re: Not OK: _76 on IP22-irix6.2 fails tests + Branch: perl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 1630] By: gsar on 1998/07/22 07:40:25 + Log: better diagnostic on errno.t failure + From: Graham Barr + Date: Tue, 21 Jul 1998 13:07:29 CDT + Message-Id: <19980721130729.K4337@asic.sc.ti.com> + Branch: perl + ! t/lib/errno.t +____________________________________________________________________________ +[ 1629] By: gsar on 1998/07/22 07:36:38 + Log: win32 tweaks: disable XSLOCKS in perl.c, correct typo, search + the registry for anything that begins with "PERL", not "PERL5" + From: "Douglas Lankshear" + Date: Tue, 21 Jul 1998 11:08:00 PDT + Message-Id: <000601bdb4d2$7ee74720$a32fa8c0@tau.Active> + Branch: perl + ! perl.c win32/perlhost.h win32/win32.c +____________________________________________________________________________ +[ 1628] By: gsar on 1998/07/22 07:28:35 + Log: suppress redefined warnings on C + Branch: perl + ! op.c +____________________________________________________________________________ +[ 1627] By: gsar on 1998/07/22 07:15:19 + Log: remove spurious $VERSION line that confuses CPAN + From: Johan Vromans + Date: Tue, 21 Jul 1998 20:01:36 +0200 + Message-Id: <13748.55168.397720.564438@phoenix.squirrel.nl> + Subject: Re: 5.004_76 missing version numbers + Branch: perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 1626] By: gsar on 1998/07/22 06:57:56 + Log: From: Andy Dougherty + Date: Tue, 21 Jul 1998 10:20:13 EDT + Message-Id: + Subject: [PATCH] Porting/config* updates for 5.005 + Branch: perl + ! Changes Porting/config.sh Porting/config_H +____________________________________________________________________________ +[ 1625] By: gsar on 1998/07/22 06:46:38 + Log: add a few more globals with old names #defined + Branch: perl + ! embed.pl embedvar.h +____________________________________________________________________________ +[ 1624] By: gsar on 1998/07/22 06:39:22 + Log: allow extensions to be specified as paths + From: Paul Johnson + Date: Tue, 21 Jul 1998 12:04:27 BST + Message-Id: <19980721120427.F903@west-tip.transeda.com> + Subject: [PATCH] 5.004_75 Embed and static extensions + Branch: perl + ! lib/ExtUtils/Embed.pm +____________________________________________________________________________ +[ 1623] By: gsar on 1998/07/22 06:12:50 + Log: make $ prototype to accept THREADSVs + Branch: perl + ! op.c +____________________________________________________________________________ +[ 1622] By: gsar on 1998/07/22 06:04:25 + Log: fix Liblist.pm to find entries that are plain pathnames on win32 + Branch: perl + ! lib/ExtUtils/Liblist.pm +____________________________________________________________________________ +[ 1621] By: gsar on 1998/07/22 05:10:53 + Log: perlfaq update from From Tom Christiansen and Nathan Torkington + (removes all mention of training courses from perlfaq*.pod) + Branch: perl + ! pod/perlfaq.pod pod/perlfaq2.pod pod/perlfaq3.pod + ! pod/perlfaq4.pod pod/perlfaq6.pod pod/perlfaq7.pod + ! pod/perlfaq8.pod pod/perlfaq9.pod +____________________________________________________________________________ +[ 1620] By: gsar on 1998/07/22 02:51:13 + Log: applied patch, modulo parts already added to perldelta + From: Stephen McCamant + Date: Tue, 21 Jul 1998 17:06:23 CDT + Message-Id: <13749.3106.995764.413053@alias-2.pr.mcs.net> + Subject: [PATCH] Re: Beta2 is available + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 1619] By: gsar on 1998/07/22 02:45:55 + Log: applied patch, add new message to perldeta + From: Stephen McCamant + Date: Tue, 21 Jul 1998 16:12:25 CDT + Message-Id: <13749.910.83378.949909@alias-2.pr.mcs.net> + Subject: [PATCH] Band-aid patch for local($avhv->{a}) + Branch: perl + ! pod/perldelta.pod pod/perldiag.pod pp.c pp_hot.c +____________________________________________________________________________ +[ 1618] By: gsar on 1998/07/22 02:08:00 + Log: fix up B modules for PL_* changes + Branch: perl + ! ext/B/B/C.pm ext/B/B/CC.pm ext/B/B/Stackobj.pm +____________________________________________________________________________ +[ 1617] By: gsar on 1998/07/22 01:42:14 + Log: From: Malcolm Beattie + Date: Tue, 21 Jul 1998 18:13:16 BST + Message-Id: <199807211713.SAA20735@sable.ox.ac.uk> + Subject: Compiler docs for 5.005 + Branch: perl + ! ext/B/B.pm ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/CC.pm + ! ext/B/O.pm +____________________________________________________________________________ +[ 1616] By: gsar on 1998/07/22 01:29:09 + Log: s/PL_sv/PL_bytecode_sv/ etc., so we have unique, case-insensitive + names + Branch: perl + ! bytecode.h bytecode.pl byterun.c embedvar.h interp.sym + ! intrpvar.h +____________________________________________________________________________ +[ 1615] By: nick on 1998/07/21 22:26:34 + Log: Mingw32 PERL_OBJECT tweaks + Branch: perl + ! ext/Fcntl/Fcntl.xs ext/IO/IO.xs ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 1614] By: gsar on 1998/07/21 19:43:32 + Log: fix off-by-one in change#623 that broke lexical lookups in eval'' + Branch: perl + ! pp_ctl.c + +---------------- +Version 5.004_76 5.005 Public Beta, Issue 2 +---------------- + +____________________________________________________________________________ +[ 1613] By: gsar on 1998/07/21 10:26:01 + Log: final tweaks before beta2 + Branch: perl + + Porting/findvars + +> Porting/fixvars + - fixvars + ! Changes MANIFEST intrpvar.h iperlsys.h + ! lib/ExtUtils/MM_Win32.pm win32/perlhost.h +____________________________________________________________________________ +[ 1612] By: gsar on 1998/07/21 07:15:54 + Log: fixes to enable PERL_OBJECT build with mingw32/egcs-1.0.2 + Branch: perl + ! ext/Opcode/Opcode.xs proto.h win32/makedef.pl + ! win32/makefile.mk win32/perlhost.h win32/win32.c win32/win32.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 1611] By: gsar on 1998/07/21 07:12:00 + Log: fix bytecode.pl with moved var names + Branch: perl + ! bytecode.pl byterun.c byterun.h ext/B/B/Asmdata.pm +____________________________________________________________________________ +[ 1610] By: gsar on 1998/07/21 05:51:10 + Log: tweak toke.c + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 1609] By: gsar on 1998/07/21 05:46:59 + Log: change case of PERL_OBJECT filenames, consistent with the rest + Branch: perl + + XSlock.h objXSUB.h + - ObjXSub.h XSLock.h + ! MANIFEST XSUB.h lib/ExtUtils/MM_Win32.pm perl.h + ! win32/GenCAPI.pl win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1608] By: gsar on 1998/07/21 05:31:13 + Log: part 2 of PERL_OBJECT fixes (globals in bytecode.h moved to intrpvar.h) + Branch: perl + ! bytecode.h byterun.c embedvar.h interp.sym intrpvar.h +____________________________________________________________________________ +[ 1607] By: gsar on 1998/07/21 05:29:10 + Log: part 1 of PERL_OBJECT fixes for new var names + Branch: perl + ! ObjXSub.h bytecode.h globals.c iperlsys.h perl.h pp_ctl.c + ! run.c win32/GenCAPI.pl +____________________________________________________________________________ +[ 1606] By: gsar on 1998/07/21 05:17:26 + Log: From: Stephen McCamant + Date: Mon, 20 Jul 1998 23:53:32 CDT + Message-Id: <13748.6947.311341.657005@alias-2.pr.mcs.net> + Subject: [PATCH] redundant RV2GVs in ck_fun() + Branch: perl + ! op.c +____________________________________________________________________________ +[ 1605] By: gsar on 1998/07/21 05:13:28 + Log: From: Stephen McCamant + Date: Mon, 20 Jul 1998 23:32:42 CDT + Message-Id: <13748.6392.921893.643238@alias-2.pr.mcs.net> + Subject: B::Deparse 0.56 (first testsuite fixes; big) + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1604] By: gsar on 1998/07/21 05:07:29 + Log: applied a slightly tweaked version of suggested patch + From: Colin Kuskie + Date: Mon, 20 Jul 1998 15:58:31 -0700 (PDT) + Message-ID: + Subject: [PATCH _75] More documentation for -i prefix + Branch: perl + ! pod/perlrun.pod +____________________________________________________________________________ +[ 1603] By: gsar on 1998/07/21 04:59:19 + Log: disable malloced_size() feedback with -DLEAKTEST + From: Ilya Zakharevich + Date: Mon, 20 Jul 1998 21:20:21 -0400 (EDT) + Message-Id: <199807210120.VAA15031@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_75] -DLEAKTEST broken + Branch: perl + ! av.c sv.c +____________________________________________________________________________ +[ 1602] By: gsar on 1998/07/21 04:57:43 + Log: fix hints/hpux.sh for cpp recognition + From: Andy Dougherty + Date: Mon, 20 Jul 1998 12:46:33 -0400 (EDT) + Message-Id: + Subject: RE: Configure misses preprocessor on HP-UX + Branch: perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 1601] By: gsar on 1998/07/21 04:55:51 + Log: From: Ilya Zakharevich + Date: Sun, 19 Jul 1998 18:16:38 -0400 (EDT) + Message-Id: <199807192216.SAA10482@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Compile (?{}) into a correct package + Branch: perl + ! pp_ctl.c t/op/pat.t +____________________________________________________________________________ +[ 1600] By: gsar on 1998/07/21 04:48:32 + Log: allocate a whole fd_set for pp_sselect() on more platforms + From: Jarkko Hietaniemi + Date: 20 Jul 1998 00:14:18 +0300 + Message-ID: + Subject: Re: Not OK: perl 5.00475 +DEVEL_BETA_ISSUE_1 on OPENSTEP-Mach 4_1 (UNINSTALLED) + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 1599] By: gsar on 1998/07/21 04:44:04 + Log: add tests to check if context propagation works + From: Francois Desarmenien + Date: Sun, 19 Jul 1998 12:28:33 +0200 + Message-ID: <35B1CA51.A606AD27@club-internet.fr> + Subject: Re: m//g strange behaviour in 5.004 + Branch: perl + + t/op/context.t + ! MANIFEST +____________________________________________________________________________ +[ 1598] By: gsar on 1998/07/21 04:37:49 + Log: applied RE doc patches, with tweaks to the prose + From: Ilya Zakharevich + Date: Sat, 18 Jul 1998 23:11:13 -0400 (EDT) + Message-Id: <199807190311.XAA25080@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Document irregular zero-length matches + -- + Date: Sun, 19 Jul 1998 00:38:44 -0400 (EDT) + Message-Id: <199807190438.AAA26226@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Another irregularity of expressions documented + Branch: perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 1597] By: gsar on 1998/07/21 04:16:51 + Log: pod tweak suggested by Ilya + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1596] By: gsar on 1998/07/21 04:12:39 + Log: enable color output with -Mre=debugcolor with -DDEBUGGING + From: Ilya Zakharevich + Date: Sat, 18 Jul 1998 17:34:00 -0400 (EDT) + Message-Id: <199807182134.RAA20644@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Better -Mre=colordb + Branch: perl + ! ext/re/re.xs +____________________________________________________________________________ +[ 1595] By: gsar on 1998/07/21 04:07:44 + Log: From: "John L. Allen" + Date: Thu, 16 Jul 1998 11:43:54 -0400 (EDT) + Message-ID: + Subject: [PATCH _75 & _05] perlbug does not report usage on invalid flags + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 1594] By: gsar on 1998/07/21 04:06:06 + Log: don't use SelectSaver on IO::Handle->input_*() methods + From: Robin Barker + Date: Thu, 16 Jul 1998 15:00:39 +0100 (BST) + Message-Id: <199807161400.PAA25532@tempest.cise.npl.co.uk> + Subject: Re: Bug in IO::Handle->input_record_separator + Branch: perl + ! ext/IO/lib/IO/Handle.pm +____________________________________________________________________________ +[ 1593] By: gsar on 1998/07/21 04:03:46 + Log: applied a tweaked version of suggested patch + From: Ilya Zakharevich + Date: Wed, 15 Jul 1998 17:02:48 -0400 (EDT) + Message-Id: <199807152102.RAA19952@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Enable/document colors in re.pm + Branch: perl + ! ext/re/re.pm +____________________________________________________________________________ +[ 1592] By: gsar on 1998/07/21 03:49:55 + Log: remove compat3.sym and rename perld4.pod + Branch: perl + +> pod/perl5004delta.pod + - compat3.sym pod/perld4.pod + ! MANIFEST +____________________________________________________________________________ +[ 1591] By: gsar on 1998/07/21 03:38:16 + Log: update patchlevel, Changes + Branch: perl + ! Changes patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1590] By: gsar on 1998/07/21 03:06:04 + Log: documentation tweaks from Abigail + Date: Fri, 17 Jul 1998 20:52:36 -0400 (EDT) + Message-ID: <19980718005236.5154.qmail@betelgeuse.wayne.fnx.com> + Subject: Re: [PATCH 5.00475] pod/perlsyn.pod + -- + Date: Thu, 16 Jul 1998 17:00:49 -0400 (EDT) + Message-ID: <19980716210049.16156.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.00475] pod/perlguts.pod + -- + Date: Thu, 16 Jul 1998 16:52:05 -0400 (EDT) + Message-ID: <19980716205205.15949.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.00475] Tweaking pod/perlfunc.pod + -- + Date: Fri, 17 Jul 1998 22:58:05 -0400 (EDT) + Message-ID: <19980718025805.7135.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH, 5.00475], pod/perlsub.pod + -- + Date: Sat, 18 Jul 1998 04:02:00 -0400 (EDT) + Message-ID: <19980718080200.9927.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.00475] pod/perlfunc.pod + Branch: perl + ! pod/perlfunc.pod pod/perlguts.pod pod/perlsub.pod + ! pod/perlsyn.pod +____________________________________________________________________________ +[ 1589] By: gsar on 1998/07/21 02:44:25 + Log: VMS patches from Dan Sugalski + Date: Wed, 15 Jul 1998 09:38:12 -0700 + Message-Id: <3.0.5.32.19980715093812.00a42a50@ous.edu> + Subject: [PATCH 5.005-beta1]Quick VMS config update + -- + Date: Wed, 15 Jul 1998 12:53:52 -0700 + Message-Id: <3.0.5.32.19980715125352.00a25cb0@ous.edu> + Subject: Re: $ebcdic has broken VMS in _75 (Now with doc patch!) + -- + Date: Thu, 16 Jul 1998 11:15:44 -0700 + Message-Id: <3.0.5.32.19980716111544.00b78770@ous.edu> + Subject: [PATCH 5.004_75]Another VMS tweak for the Vax C compiler + -- + Date: Thu, 16 Jul 1998 11:21:55 -0700 + Message-Id: <3.0.5.32.19980716112155.00a66c50@ous.edu> + Subject: [PATCH 5.004_75]Get archname correct for thread build on VMS + -- + Date: Thu, 16 Jul 1998 11:25:04 -0700 + Message-Id: <3.0.5.32.19980716112504.00ae0d50@ous.edu> + Subject: [PATCH 5.004_75]Thread build tweaks for VMS 6.2 and older + -- + Date: Fri, 17 Jul 1998 15:29:13 -0700 + Message-Id: <3.0.5.32.19980717152913.00a469b0@ous.edu> + Subject: [PATCH 5.004_75]Missed a header file in VMS build procedure + -- + Date: Mon, 20 Jul 1998 10:20:49 -0700 + Message-Id: <3.0.5.32.19980720102049.00a05100@ous.edu> + Subject: [PATCH 5.004_75]Tweaks to Thread.XS for OLD_PTHREADS_API build + -- + Date: Mon, 20 Jul 1998 10:13:03 -0700 + Message-Id: <3.0.5.32.19980720101303.00a17100@ous.edu> + Subject: [PATCH 5.004_75]Explicitly specify extensions during VMS config process + -- + From: Brad Hughes + Date: Mon, 20 Jul 1998 15:51:22 -0700 + Message-Id: <3.0.5.32.19980720155122.00a41950@ous.edu> + Subject: patch for readme.vms + Branch: perl + ! README.vms ext/Thread/Thread.xs vms/descrip_mms.template + ! vms/gen_shrfls.pl vms/subconfigure.com +____________________________________________________________________________ +[ 1588] By: gsar on 1998/07/21 01:26:20 + Log: change#1481 didn't go through at all, redo it + Branch: perl + ! t/base/rs.t +____________________________________________________________________________ +[ 1587] By: gsar on 1998/07/21 01:21:41 + Log: workaround C<"foo" "bar"> catenation-intolerant compilers + Branch: perl + ! regexec.c toke.c +____________________________________________________________________________ +[ 1586] By: gsar on 1998/07/21 01:05:49 + Log: do not override PERL_DESTRUCT_LEVEL if use has it set + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 1585] By: gsar on 1998/07/21 00:39:17 + Log: fix small memory leak when mess_sv happens to be touched by magic + Branch: perl + ! perl.c t/lib/thread.t t/op/local.t t/op/pat.t t/op/regexp.t +____________________________________________________________________________ +[ 1584] By: gsar on 1998/07/21 00:37:32 + Log: fix memory leak in C + Branch: perl + ! scope.c +____________________________________________________________________________ +[ 1583] By: TimBunce on 1998/07/20 22:14:11 + Log: Update Changes and patchlevel.h for release. At last. + Branch: maint-5.004/perl + ! Changes patchlevel.h +____________________________________________________________________________ +[ 1582] By: gsar on 1998/07/20 21:28:43 + Log: add rsfp_filters and perldb to pollutants list + Branch: perl + ! embed.pl +____________________________________________________________________________ +[ 1581] By: nick on 1998/07/20 19:22:37 + Log: Integrate mainline pre-beta2 - just in case + Branch: ansiperl + !> (integrate 66 files) +____________________________________________________________________________ +[ 1580] By: TimBunce on 1998/07/20 17:16:38 + Log: Assorted patches: + + Title: "Clean up hash array allocation" + From: Gurusamy Sarathy + Msg-ID: <199807201052.GAA13336@aatma.engin.umich.edu> + Files: hv.c + + Title: "Further fixes for cppstdin on HP-UX 11" + From: Andy Dougherty + Msg-ID: + Files: hints/hpux.sh + Branch: maint-5.004/perl + ! hints/hpux.sh hv.c +____________________________________________________________________________ +[ 1579] By: TimBunce on 1998/07/20 09:46:14 + Log: Assorted patches: + + Title: "Fix C<$1 .. $2> coredump under debugger" + From: Gurusamy Sarathy + Msg-ID: <199807200042.UAA23288@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "Fix lvalue leaks stemming from failure to free LvTARG(sv)" + From: Gurusamy Sarathy + Msg-ID: <199807191829.OAA12433@aatma.engin.umich.edu> + Files: embed.h perl.h proto.h global.sym mg.c sv.c t/op/substr.t t/op/vec.t + + Title: "fix major bug (from 5.003_96); void contexts were using the context + of the enclosing sub!" + From: Francois Desarmenien , Gurusamy Sarathy + + Msg-ID: <199807180927.FAA08032@aatma.engin.umich.edu>, + <35B1CA51.A606AD27@club-internet.fr> + Files: op.h + + Title: "Update lib/Getopt/Long.pm (from perl5.005 beta 1)" + From: Johan Vromans + Msg-ID: <13745.47704.943964.34613@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "Add Porting/p4d2p utility for converting perforce diffs" + From: Gurusamy Sarathy + Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu> + Files: MANIFEST Porting/p4d2p + Branch: maint-5.004/perl + + Porting/p4d2p + ! MANIFEST embed.h global.sym lib/Getopt/Long.pm mg.c op.h + ! perl.h pp_ctl.c proto.h sv.c t/op/substr.t t/op/vec.t +____________________________________________________________________________ +[ 1578] By: gsar on 1998/07/20 09:38:39 + Log: complete s/foo/PL_foo/ changes (all escaped cases identified with + brute force search script). Result builds and passes all tests on + Solaris. win32 and PERL_OBJECT are still untested. + Branch: perl + ! XSLock.h XSUB.h bytecode.h bytecode.pl byterun.c cc_runtime.h + ! djgpp/djgpp.c embed.pl ext/B/B.xs ext/B/B/Asmdata.pm + ! ext/B/byteperl.c ext/DB_File/DB_File.xs ext/DB_File/typemap + ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_vms.xs ext/GDBM_File/typemap ext/IO/IO.xs + ! ext/IPC/SysV/SysV.xs ext/NDBM_File/typemap + ! ext/ODBM_File/ODBM_File.xs ext/ODBM_File/typemap + ! ext/Opcode/Opcode.xs ext/POSIX/POSIX.xs ext/SDBM_File/typemap + ! ext/Thread/Thread.xs ext/attrs/attrs.xs fakethr.h gv.c hv.c + ! lib/ExtUtils/typemap malloc.c mg.c op.c os2/OS2/PrfDB/PrfDB.xs + ! os2/OS2/PrfDB/typemap os2/OS2/REXX/REXX.xs os2/os2.c + ! os2/os2ish.h perl.c perl.h pp.c pp_ctl.c pp_hot.c pp_sys.c + ! regcomp.c regcomp.h regexec.c scope.c scope.h sv.h taint.c + ! toke.c util.c vms/ext/DCLsym/DCLsym.xs vms/ext/Stdio/Stdio.xs + ! vms/vms.c vms/vmsish.h win32/win32.c win32/win32thread.c +____________________________________________________________________________ +[ 1577] By: TimBunce on 1998/07/20 08:28:17 + Log: Title: "Make failed matches return empty list in list context" + From: "Paul E. Maisano" , Gurusamy Sarathy + , Paul Maisano + Msg-ID: <199807200002.UAA21398@aatma.engin.umich.edu>, + <199807200027.KAA27815@ironbark-ridge.aaii.oz.au>, + <35B156FB.504E66E@aaii.oz.au> + Files: pod/perlop.pod pp_hot.c t/op/pat.t + Branch: maint-5.004/perl + ! pod/perlop.pod pp_hot.c t/op/pat.t +____________________________________________________________________________ +[ 1576] By: TimBunce on 1998/07/20 08:11:37 + Log: Title: "win32 update from 5.005 beta 2 for 5.004_05" + From: Gurusamy Sarathy + Msg-ID: <199807192332.TAA20905@aatma.engin.umich.edu> + Files: win32/include/dirent.h win32/include/sys/socket.h proto.h + lib/ExtUtils/Liblist.pm lib/ExtUtils/Mksymlists.pm + win32/win32.h win32/win32iop.h README.win32 installperl + pp_ctl.c win32/Makefile win32/config.bc win32/config.vc + win32/config_H.bc win32/config_H.vc win32/config_h.PL + win32/config_sh.PL win32/dl_win32.xs win32/makedef.pl + win32/makefile.mk win32/pod.mak win32/win32.c + win32/win32sck.c win32/bin/pl2bat.pl + Branch: maint-5.004/perl + ! README.win32 installperl lib/ExtUtils/Liblist.pm + ! lib/ExtUtils/Mksymlists.pm pp_ctl.c proto.h win32/Makefile + ! win32/bin/pl2bat.pl win32/config.bc win32/config.vc + ! win32/config_H.bc win32/config_H.vc win32/config_h.PL + ! win32/config_sh.PL win32/dl_win32.xs win32/include/dirent.h + ! win32/include/sys/socket.h win32/makedef.pl win32/makefile.mk + ! win32/pod.mak win32/win32.c win32/win32.h win32/win32iop.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 1575] By: gsar on 1998/07/20 01:27:14 + Log: integrate ansi branch to get s/foo/PL_foo/ changes + Branch: perl + +> fixvars + !> (integrate 537 files) +____________________________________________________________________________ +[ 1574] By: gsar on 1998/07/20 00:33:43 + Log: fix C<$1 .. $2> coredump under debugger + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 1573] By: gsar on 1998/07/20 00:28:27 + Log: misc win32 config tweaks + Branch: perl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/config_h.PL win32/makefile.mk +____________________________________________________________________________ +[ 1572] By: nick on 1998/07/19 19:04:58 + Log: Missed file that had changed + Branch: ansiperl + ! embedvar.h +____________________________________________________________________________ +[ 1571] By: nick on 1998/07/19 18:57:35 + Log: Another threaded, perl malloc issue, x2p's Makefile.SH has a + pattern match... + Branch: ansiperl + ! x2p/Makefile.SH +____________________________________________________________________________ +[ 1570] By: nick on 1998/07/19 18:16:20 + Log: Drat! - threaded perl-malloc has mutex that needs PL_ + Branch: ansiperl + ! malloc.c perl.h +____________________________________________________________________________ +[ 1569] By: nick on 1998/07/19 17:55:22 + Log: PL_ for perl's malloc + Branch: ansiperl + ! hv.c malloc.c +____________________________________________________________________________ +[ 1568] By: nick on 1998/07/19 16:23:30 + Log: PL_ minir tidy up + Branch: ansiperl + ! embed.pl ext/Thread/Thread.xs util.c +____________________________________________________________________________ +[ 1567] By: nick on 1998/07/19 13:21:07 + Log: Add PL_ to merged file + Branch: ansiperl + ! pp_hot.c +____________________________________________________________________________ +[ 1566] By: nick on 1998/07/19 12:38:30 + Log: Merge Mainline + Branch: ansiperl + + fixvars + !> (integrate 29 files) +____________________________________________________________________________ +[ 1565] By: gsar on 1998/07/19 07:06:54 + Log: tweak pod in MakeMaker.pm + From: Paul Johnson + Date: Sat, 18 Jul 1998 15:58:48 +0100 + Message-ID: <19980718155847.D903@west-tip.transeda.com> + Subject: [PATCH]5.004_75 (DOC) MakeMaker.pm + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1564] By: gsar on 1998/07/19 07:04:45 + Log: From: Gisle Aas + Date: 17 Jul 1998 22:49:32 +0200 + Message-ID: + Subject: [PATCH _75] sv_gets() did not NUL-terminate SV when reading records + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1563] By: gsar on 1998/07/19 07:03:32 + Log: update freebsd hints + From: Mik Firestone + Date: Fri, 17 Jul 1998 15:24:26 -0400 (EDT) + Message-Id: <199807171924.AA05297@interlock2.lexmark.com> + Subject: [PATCH 5.005b1] hints/freebsd.sh + Branch: perl + ! hints/freebsd.sh +____________________________________________________________________________ +[ 1562] By: gsar on 1998/07/19 07:01:33 + Log: From: Mark Bixby + Date: Fri, 17 Jul 1998 10:37:49 -0700 (PDT) + Message-Id: <199807171737.KAA06967@spock.dis.cccd.edu> + Subject: [PATCH 5.005b1] MPE/iX hints and readme tweaks + Branch: perl + ! README.mpeix hints/mpeix.sh +____________________________________________________________________________ +[ 1561] By: gsar on 1998/07/19 07:00:19 + Log: From: Norton Allen + Date: Fri, 17 Jul 1998 12:37:27 -0400 (edt) + Message-Id: <199807171637.MAA24830@bottesini.harvard.edu> + Subject: [PATCH: 75] make install fails + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1560] By: gsar on 1998/07/19 06:58:55 + Log: fix flawed substitution-loop detection on zero-length matches + From: Ilya Zakharevich + Date: Fri, 17 Jul 1998 13:55:38 -0400 (EDT) + Message-Id: <199807171755.NAA27720@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Substitution loop in devel branch + Branch: perl + ! pp_hot.c t/op/subst.t +____________________________________________________________________________ +[ 1559] By: gsar on 1998/07/19 06:56:19 + Log: add perltrap entry about "${#a}", as suggested by + andy barfoot + Branch: perl + ! pod/perltrap.pod +____________________________________________________________________________ +[ 1558] By: gsar on 1998/07/19 06:43:53 + Log: From: Anton Berezin + Date: Fri, 17 Jul 1998 11:49:30 +0200 (CEST) + Message-Id: <199807170949.LAA18099@lion.plab.ku.dk> + Subject: [PATCH 5.005b1] perlcall.pod SAVETMPS/FREETMPS bracket + Branch: perl + ! pod/perlcall.pod +____________________________________________________________________________ +[ 1557] By: gsar on 1998/07/19 06:40:33 + Log: From: "Art Green" + Date: Thu, 16 Jul 1998 21:37:05 -0500 + Message-ID: <86256644.000E61D4.00@FDLTest1.mercmarine.com> + Subject: [PATCH]:_75 - Update hints/aix.sh for c_r library + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 1556] By: gsar on 1998/07/19 06:38:17 + Log: update README.threads + From: Andy Dougherty + Date: Thu, 16 Jul 1998 11:10:33 -0400 (EDT) + Message-Id: + Subject: Re: Sort of OK: 5.005-beta1 and threads on ppc-powerux-threads + Branch: perl + ! README.threads +____________________________________________________________________________ +[ 1555] By: gsar on 1998/07/19 06:36:32 + Log: From: Scott Henry + Date: 15 Jul 1998 20:23:02 -0700 + Message-ID: + Subject: [PATCH 5.005-beta1] update hints/irix_6.sh + Branch: perl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 1554] By: gsar on 1998/07/19 06:35:10 + Log: From: Spider Boardman + Date: Wed, 15 Jul 1998 16:56:48 -0400 + Message-Id: <199807152056.QAA369057@web.zk3.dec.com> + Subject: [PATCH _75] dec_osf hints still wrong + Branch: perl + ! hints/dec_osf.sh +____________________________________________________________________________ +[ 1553] By: gsar on 1998/07/19 06:33:29 + Log: tweak hpux hints in vain attempt to get cppstdin set properly + From: Andy Dougherty + Date: Wed, 15 Jul 1998 16:11:43 -0400 (EDT) + Subject: Re: HP-UX 11, perl 5.004_04, Oracle 7.3.3.4, DBI 0.93 + Message-Id: + -- + From: Andy Dougherty + Date: Thu, 16 Jul 1998 11:37:58 -0400 (EDT) + Subject: Re: Configure misses preprocessor on HP-UX + Message-Id: + Branch: perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 1552] By: gsar on 1998/07/19 06:26:24 + Log: From: Tye McQueen + Date: Wed, 15 Jul 1998 13:46:44 -0500 (CDT) + Message-Id: <199807151846.AA12653@metronet.com> + Subject: Minor debugger fix + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 1551] By: gsar on 1998/07/19 06:25:05 + Log: From: Andy Dougherty + Date: Wed, 15 Jul 1998 14:23:39 -0400 (EDT) + Message-Id: + Subject: Re: Configure s?rand support [PATCH 5.004_75] -- better patch + Branch: perl + ! INSTALL pp.c +____________________________________________________________________________ +[ 1550] By: gsar on 1998/07/19 06:23:10 + Log: minor re.pm cleanup + From: "M.J.T. Guy" + Date: Wed, 15 Jul 1998 12:41:14 +0100 + Message-Id: + Subject: Re: [PATCH 5.004_74]Don't use tainted REs in Basename.pm when building perl + Branch: perl + ! ext/re/re.pm pod/perldiag.pod +____________________________________________________________________________ +[ 1549] By: gsar on 1998/07/19 06:20:49 + Log: export additional symbols on OS/2 + From: Ilya Zakharevich + Date: Wed, 15 Jul 1998 06:13:07 -0400 (EDT) + Message-Id: <199807151013.GAA11279@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Export more symbols from Perl DLL + Branch: perl + ! os2/os2.sym +____________________________________________________________________________ +[ 1548] By: gsar on 1998/07/19 06:18:58 + Log: From: Ilya Zakharevich + Date: Wed, 15 Jul 1998 06:10:36 -0400 (EDT) + Message-Id: <199807151010.GAA11270@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Minor improvements to perlcc + Branch: perl + ! utils/perlcc.PL +____________________________________________________________________________ +[ 1547] By: gsar on 1998/07/19 06:17:22 + Log: applied slightly tweaked version of patch + From: Ilya Zakharevich + Date: Thu, 16 Jul 1998 15:49:15 -0400 (EDT) + Message-Id: <199807161949.PAA08214@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Updated patch to Test::Harness + Branch: perl + ! lib/Test/Harness.pm +____________________________________________________________________________ +[ 1546] By: gsar on 1998/07/19 06:11:03 + Log: improve 'frame' handling in debugger + From: Ilya Zakharevich + Date: Wed, 15 Jul 1998 00:52:10 -0400 (EDT) + Message-Id: <199807150452.AAA06685@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Better debugger trace + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 1545] By: gsar on 1998/07/19 06:07:51 + Log: fix and test handling of literal newlines in heredocs + From: Gisle Aas + Date: 17 Jul 1998 14:58:25 +0200 + Message-ID: + Subject: Re: [PATCH _71] CRs et al + -- + From: larry@wall.org (Larry Wall) + Date: Fri, 17 Jul 1998 09:32:35 -0700 + Message-Id: <199807171632.JAA12959@wall.org> + Subject: Re: [PATCH _71] CRs et al + Branch: perl + ! t/comp/multiline.t toke.c +____________________________________________________________________________ +[ 1544] By: gsar on 1998/07/19 06:00:12 + Log: remove possibly unwritable lib/re.pm before overwrite + From: larry@wall.org (Larry Wall) + Date: Wed, 15 Jul 1998 14:26:03 -0700 + Message-Id: <199807152126.OAA04623@wall.org> + Subject: Re: bug encountered building perl5.005beta1 + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1543] By: gsar on 1998/07/19 05:56:18 + Log: unsubmitted Changes tweak + Branch: perl + ! Changes cygwin32/ld2 +____________________________________________________________________________ +[ 1542] By: gsar on 1998/07/19 01:21:22 + Log: make failed matches return empty list in list context + Branch: perl + ! pod/perlop.pod pp_hot.c t/op/pat.t +____________________________________________________________________________ +[ 1541] By: gsar on 1998/07/18 22:27:59 + Log: remove obsolete perltrap about m//g's pos() reset behavior + Branch: perl + ! pod/perltrap.pod +____________________________________________________________________________ +[ 1540] By: nick on 1998/07/18 22:16:26 + Log: PL_ stuff passes non-threaded on Mingw32 + (Why did it compile without this fix?) + Branch: ansiperl + ! pp_sys.c +____________________________________________________________________________ +[ 1539] By: TimBunce on 1998/07/18 22:04:58 + Log: Assorted patches: + + Title: "Minor fixes to MakeMaker docs re ExtUtils::Embed" + From: Paul Johnson + Msg-ID: <19980718155847.D903@west-tip.transeda.com> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Update t/op/array.t (from 5.005 beta 1)" + Files: t/op/array.t + Branch: maint-5.004/perl + ! lib/ExtUtils/MakeMaker.pm t/op/array.t +____________________________________________________________________________ +[ 1538] By: TimBunce on 1998/07/18 21:57:50 + Log: Title: "Remove flawed '// with parens or $&' performance patch (Change 662)" + From: "M.J.T. Guy" , Tim Bunce , + larry@wall.org (Larry Wall) + Msg-ID: <19980717015308.E6244@ig.co.uk>, <199807171819.LAA13771@wall.org>, + + Files: cop.h embed.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c + pp_ctl.c pp_hot.c regexec.c scope.c + Branch: maint-5.004/perl + ! cop.h embed.h gv.c interp.sym perl.c perl.h pp.c pp_ctl.c + ! pp_hot.c proto.h regexec.c regexp.h scope.c +____________________________________________________________________________ +[ 1537] By: nick on 1998/07/18 20:56:58 + Log: PL_ scheme Builds under Minw32 - some SEGFAULT snags + Branch: ansiperl + ! doio.c mg.c perl.c pp_hot.c pp_sys.c util.c win32/perllib.c + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 1536] By: nick on 1998/07/18 20:50:26 + Log: Merge latest mainline + Branch: ansiperl + ! patchlevel.h + !> ext/Thread/Thread.xs op.h util.c +____________________________________________________________________________ +[ 1535] By: nick on 1998/07/18 16:45:29 + Log: Edited "behind my back" ... + Branch: ansiperl + ! vms/perly_c.vms +____________________________________________________________________________ +[ 1534] By: nick on 1998/07/18 16:38:27 + Log: PL_ stuff for threads + Branch: ansiperl + ! byterun.c cop.h deb.c doio.c doop.c embed.pl embedvar.h + ! ext/B/B.xs ext/Thread/Thread.xs gv.c intrpvar.h mg.c + ! miniperlmain.c op.c op.h perl.c perl.h perly.y pp.c pp.h + ! pp_ctl.c pp_hot.c pp_sys.c regexec.c run.c scope.c sv.c sv.h + ! thread.h toke.c util.c win32/perllib.c +____________________________________________________________________________ +[ 1533] By: nick on 1998/07/18 14:30:54 + Log: Builds and passes tests with -DMULTIPLICITY and -DCRIPPLED_CC + (still with PERL_GLOBAL_STRUCT) - to cover more #if branches + Branch: ansiperl + ! embed.pl intrpvar.h perl.c toke.c +____________________________________________________________________________ +[ 1532] By: nick on 1998/07/18 13:53:03 + Log: PL_ prefix to all perlvars, part1 + Builds and passes all tests at one limit i.e. -DPERL_GLOBAL_STRUCT + Branch: ansiperl + ! XSUB.h av.c bytecode.h byterun.c byterun.h cop.h deb.c doio.c + ! doop.c dump.c embed.h embed.pl embedvar.h ext/B/B.xs + ! ext/Data/Dumper/Dumper.xs ext/DynaLoader/dl_next.xs + ! ext/ODBM_File/ODBM_File.xs ext/Opcode/Opcode.xs + ! ext/POSIX/POSIX.xs ext/Socket/Socket.xs ext/attrs/attrs.xs + ! ext/re/re.xs gv.c hv.c hv.h lib/ExtUtils/typemap + ! lib/ExtUtils/xsubpp mg.c miniperlmain.c op.c perl.c perl.h + ! perly.c perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c regcomp.c + ! regcomp.h regexec.c run.c scope.c scope.h sv.c sv.h taint.c + ! thrdvar.h toke.c universal.c util.c +____________________________________________________________________________ +[ 1531] By: gsar on 1998/07/18 08:48:13 + Log: fix yet another USE_THREADS leak due to failure to free stacks + Branch: perl + ! ext/Thread/Thread.xs util.c +____________________________________________________________________________ +[ 1530] By: gsar on 1998/07/18 08:46:58 + Log: fix major bug in GIMME (introduced in 5.003_96); void contexts were + using the context of the enclosing sub! + Branch: perl + ! op.h +____________________________________________________________________________ +[ 1529] By: nick on 1998/07/18 08:18:03 + Log: Integrate post-beta tweaks to ansiperl + Branch: ansiperl + !> ObjXSub.h embed.h ext/Thread/Thread.xs global.sym gv.c mg.c + !> objpp.h op.c perl.c perl.h pp_sys.c proto.h sv.c t/op/substr.t + !> t/op/vec.t toke.c util.c +____________________________________________________________________________ +[ 1528] By: gsar on 1998/07/18 04:23:12 + Log: fix lvalue leaks stemming from failure to free LvTARG(sv) + Branch: perl + ! ObjXSub.h embed.h global.sym mg.c objpp.h perl.h proto.h sv.c + ! t/op/substr.t t/op/vec.t +____________________________________________________________________________ +[ 1527] By: gsar on 1998/07/18 02:16:40 + Log: check ferror() only if read() returned 0 + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 1526] By: gsar on 1998/07/18 02:08:01 + Log: fix another CvMUTEXP() leak + Branch: perl + ! gv.c +____________________________________________________________________________ +[ 1525] By: TimBunce on 1998/07/18 01:51:52 + Log: Assorted patches: + + Title: "Fix @a=@a=qw(...) properly" + From: Stephen McCamant + Msg-ID: <13742.49404.367751.437966@alias-2.pr.mcs.net> + Files: opcode.h + + Title: "Larry's patch to support CR LF in scripts (updated)" + From: Gisle Aas , larry@wall.org (Larry Wall) + Msg-ID: <199807120054.RAA19550@wall.org>, + Files: t/comp/multiline.t toke.c + + Title: "Change getc() docs to match behaviour. Make read() return undef on + error." + From: Gurusamy Sarathy + Msg-ID: <199807052257.SAA10004@aatma.engin.umich.edu> + Files: pod/perlfunc.pod pp_sys.c + + Title: "Update patchls utility" + Files: Porting/patchls + Branch: maint-5.004/perl + ! Porting/patchls opcode.h pod/perlfunc.pod pp_sys.c + ! t/comp/multiline.t toke.c +____________________________________________________________________________ +[ 1524] By: gsar on 1998/07/18 01:22:35 + Log: fix CvMUTEXP() leaks with -Dusethreads + Branch: perl + ! op.c toke.c +____________________________________________________________________________ +[ 1523] By: gsar on 1998/07/18 01:17:28 + Log: fix $/ init for multiple interpreters/threads + Branch: perl + ! ext/Thread/Thread.xs perl.c util.c +____________________________________________________________________________ +[ 1522] By: gsar on 1998/07/18 01:11:07 + Log: fix missing init that caused RE alternations to fail under + -Dusethreads + Branch: perl + ! util.c +____________________________________________________________________________ +[ 1521] By: TimBunce on 1998/07/16 22:23:25 + Log: Assorted patches: + + Title: "Allow $SIG{CHLD}='IGNORE' to work (reap zombies) on Solaris" + From: Albert Dvornik , Chip Salzenberg + Msg-ID: <19980708181055.A8005@perlsupport.com>, + + Files: util.c + + Title: "Document perltrap on precedence of keys/values/each" + From: Gurusamy Sarathy + Msg-ID: <199807151857.OAA04704@aatma.engin.umich.edu> + Files: pod/perltrap.pod + + Title: "perlbook.pod patch" + From: Tom Christiansen + Msg-ID: <199807140037.SAA04556@chthon.perl.com> + Files: pod/perlbook.pod + + Title: "perlmod.pod patch" + From: Tom Christiansen + Msg-ID: <199807140109.TAA04678@chthon.perl.com> + Files: pod/perlmod.pod + + Title: "Fix bug in IO::Handle->input_record_separator" + From: Robin Barker , Swen Thuemmler + + Msg-ID: <199807161400.PAA25532@tempest.cise.npl.co.uk>, + + Files: ext/IO/lib/IO/Handle.pm + + Title: "update h2ph, Math::Complex and Math::Trig (from 5.005 beta 1)" + Files: lib/Math/Complex.pm lib/Math/Trig.pm t/lib/complex.t t/lib/h2ph.t + t/lib/trig.t utils/h2ph.PL + + Title: "Update hints/irix_6.sh" + From: Scott Henry + Msg-ID: + Files: hints/irix_6.sh + + Title: "Configure misses preprocessor on HP-UX (further fix)" + From: Andy Dougherty + Msg-ID: + Files: hints/hpux.sh + + Title: "update perlbug to v1.26 (from 5.005 beta 1)" + Files: utils/perlbug.PL + Branch: maint-5.004/perl + ! ext/IO/lib/IO/Handle.pm hints/hpux.sh hints/irix_6.sh + ! lib/Math/Complex.pm lib/Math/Trig.pm pod/perlbook.pod + ! pod/perlmod.pod pod/perltrap.pod t/lib/complex.t t/lib/h2ph.t + ! t/lib/trig.t util.c utils/h2ph.PL utils/perlbug.PL +____________________________________________________________________________ +[ 1520] By: TimBunce on 1998/07/15 21:24:12 + Log: Assorted patches: + + Title: "Add stub attrs.pm" + From: Graham Barr , Gurusamy Sarathy + Msg-ID: <19980713163312.A18222@asic.sc.ti.com>, + <199807132140.RAA09583@aatma.engin.umich.edu> + Files: MANIFEST lib/attrs.pm + + Title: "Fix @a=@a=qw(...)" + From: Gurusamy Sarathy , Stephen McCamant + + Msg-ID: <13737.12300.950886.821143@alias-2.pr.mcs.net>, + <199807122351.TAA05649@aatma.engin.umich.edu> + Files: op.c opcode.pl t/op/array.t + + Title: "Fix 'PERL_DESTRUCT_LEVEL=2 ./perl -DD -e 1' loop" + From: Gisle Aas , Stephen McCamant + Msg-ID: <13739.55551.205810.338648@alias-2.pr.mcs.net>, + + Files: sv.c + + Title: "Make Power MachTen use vfork() and system malloc()" + From: Dominic Dunlop , Jarkko Hietaniemi + Msg-ID: + Files: hints/machten.sh malloc.c + + Title: "Use REG_INFTY in place of hardwired constant" + From: Dominic Dunlop + Msg-ID: + Files: regcomp.h regcomp.c regexec.c + + Title: "Minor debugger fix (history adds an extra newline)" + From: Tye McQueen + Msg-ID: <199807151846.AA12653@metronet.com> + Files: lib/perl5db.pl + + Title: "Protect Term::ReadLine against non-default $/ value" + From: Ilya Zakharevich , + kstar@chapin.edu@ig.co.uk () + Msg-ID: <19980713151749.G8596@O2.chapin.edu>, + <199807132139.RAA11270@monk.mps.ohio-state.edu> + Files: lib/Term/ReadLine.pm + + Title: "Fix HP-UX 11 build (cppstdin)" + From: Andy Dougherty + Msg-ID: + Files: Configure hints/hpux.sh + + Title: "VMS filetest operator fixup (SS$_ACCONFLICT)" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980702135255.00a6ad90@ous.edu> + Files: vms/vms.c + Branch: maint-5.004/perl + + lib/attrs.pm + ! Configure MANIFEST hints/hpux.sh hints/machten.sh + ! lib/Term/ReadLine.pm lib/perl5db.pl malloc.c op.c opcode.pl + ! regcomp.c regcomp.h regexec.c sv.c t/op/array.t vms/vms.c +____________________________________________________________________________ +[ 1519] By: nick on 1998/07/15 18:56:17 + Log: Integrate mainline at beta1 + Branch: ansiperl + +> Porting/p4d2p README.mpeix Todo-5.005 + +> ext/DynaLoader/dl_mpeix.xs ext/re/hints/mpeix.pl + +> mpeix/mpeixish.h mpeix/nm mpeix/relink perly_c.diff + +> pod/perld4.pod pod/perlport.pod t/lib/ipc_sysv.t + - Todo.5.005 lib/Bundle/CPAN.pm perly.c.diff pod/perldelta4.pod + - t/op/ipcmsg.t t/op/ipcsem.t + !> (integrate 167 files) + +---------------- +Version 5.004_75 5.005 Public Beta, Issue 1 +---------------- + +____________________________________________________________________________ +[ 1518] By: gsar on 1998/07/15 10:01:41 + Log: add stub docs for ext/B, other minor tweaks + Branch: perl + ! Changes Porting/config_H config_h.SH ext/B/B.pm + ! ext/B/B/Asmdata.pm ext/B/B/Assembler.pm ext/B/B/Bblock.pm + ! ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/CC.pm + ! ext/B/B/Debug.pm ext/B/B/Disassembler.pm ext/B/B/Showlex.pm + ! ext/B/B/Stackobj.pm ext/B/B/Terse.pm ext/B/O.pm sv.c +____________________________________________________________________________ +[ 1517] By: gsar on 1998/07/15 08:27:15 + Log: up patchlevel to 75 (Beta, Issue 1), add podpatch + From: abigail@fnx.com + Date: Wed, 15 Jul 1998 04:03:44 -0400 (EDT) + Message-ID: <19980715080344.21975.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.004_74] pod/perlop.pod + Branch: perl + ! Changes patchlevel.h pod/perlop.pod win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 1516] By: gsar on 1998/07/15 08:04:24 + Log: From: abigail@fnx.com + Date: Wed, 15 Jul 1998 03:47:56 EDT + Message-Id: <19980715074756.21868.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.004_74] pod/pod2man.PL Fix use of < inside C<> + Branch: perl + ! pod/pod2man.PL +____________________________________________________________________________ +[ 1515] By: gsar on 1998/07/15 08:02:14 + Log: From: Ilya Zakharevich + Date: Wed, 15 Jul 1998 03:49:24 EDT + Message-Id: <199807150749.DAA09177@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] Additional targets for OS/2 build + Branch: perl + ! os2/Makefile.SHs +____________________________________________________________________________ +[ 1514] By: gsar on 1998/07/15 07:58:29 + Log: rename some long file names to be 8.3 truncation-safe + Branch: perl + +> Todo-5.005 perly_c.diff pod/perld4.pod + - Todo.5.005 perly.c.diff pod/perldelta4.pod + ! MANIFEST Porting/pumpkin.pod perly.fixer +____________________________________________________________________________ +[ 1513] By: gsar on 1998/07/15 07:35:29 + Log: minor tweaks to docs on qr// + Branch: perl + ! ext/re/re.pm pod/perldelta.pod pod/perlop.pod pod/perlre.pod +____________________________________________________________________________ +[ 1512] By: gsar on 1998/07/15 07:06:02 + Log: applied patch, with tab tweak suggest by Peter Prymmer + From: Dan Sugalski + Date: Tue, 14 Jul 1998 16:41:14 -0700 + Message-Id: <3.0.5.32.19980714164114.00a3e2a0@ous.edu> + Subject: [PATCH 5.004_74]VMS build cleanups + Branch: perl + ! vms/descrip_mms.template +____________________________________________________________________________ +[ 1511] By: gsar on 1998/07/15 07:03:33 + Log: allow perlbug -ok when STDIN it not a tty + From: Hugo van der Sanden + Date: Wed, 15 Jul 1998 03:24:56 +0200 + Message-Id: + Subject: Re: [NOT OK] 5.004_74: "make ok" not ok in IRIX 6.2 + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 1510] By: gsar on 1998/07/15 06:59:43 + Log: From: "Art Green" + Date: Tue, 14 Jul 1998 20:53:48 -0500 + Message-ID: <86256642.0004D7AB.00@FDLTest1.mercmarine.com> + Subject: [PATCH]:_74 - Allow Configure to recognize _AIX41 & _POWER compiler defines + Branch: perl + ! Configure +____________________________________________________________________________ +[ 1509] By: gsar on 1998/07/15 06:57:50 + Log: typecast long vs. IV compares in pp_flip/pp_flop + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 1508] By: gsar on 1998/07/15 06:50:49 + Log: don't copy foreach itervar when no external refs exist + From: Gisle Aas + Date: 15 Jul 1998 03:35:25 +0200 + Message-ID: + Subject: Re: Testcase for 1..n closure change + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 1507] By: gsar on 1998/07/15 06:46:41 + Log: applied patch, regen headers + From: Stephen McCamant + Date: Tue, 14 Jul 1998 19:56:47 -0500 (CDT) + Message-ID: <13739.64763.792570.626015@alias-2.pr.mcs.net> + Subject: B::Deparse update for qr// and regcreset + Branch: perl + ! ext/B/B/Deparse.pm opcode.h opcode.pl +____________________________________________________________________________ +[ 1506] By: gsar on 1998/07/15 06:43:04 + Log: make pregcomp et al VIRTUAL again for PERL_OBJECT + From: "Douglas Lankshear" + Date: Tue, 14 Jul 1998 16:40:30 -0700 + Message-ID: <000301bdaf80$c93d14a0$a32fa8c0@tau.Active> + Subject: [PATCH 5.004_74] + Branch: perl + ! proto.h +____________________________________________________________________________ +[ 1505] By: gsar on 1998/07/15 06:41:43 + Log: dont use sv_dump() in -DD diagnostic + From: Gisle Aas + Date: 14 Jul 1998 23:55:36 +0200 + Message-ID: + Subject: [PATCH] Fix 'PERL_DESTRUCT_LEVEL=2 ./perl -DD -e 1' loop + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1504] By: gsar on 1998/07/15 06:39:37 + Log: add a few more thread.t tests + Branch: perl + ! t/lib/thread.t +____________________________________________________________________________ +[ 1503] By: gsar on 1998/07/15 06:31:33 + Log: fix thread.t ('join $t' ne '$t->join' !) + Branch: perl + ! t/lib/thread.t +____________________________________________________________________________ +[ 1502] By: gsar on 1998/07/15 06:26:00 + Log: From: Jarkko Hietaniemi + Date: Wed, 15 Jul 1998 01:45:57 +0300 (EET DST) + Message-Id: <199807142245.BAA09651@alpha.hut.fi> + Subject: [PATCH] 5.004_74: MPE/iX final touches + Branch: perl + ! installperl lib/File/Copy.pm +____________________________________________________________________________ +[ 1501] By: gsar on 1998/07/15 05:59:49 + Log: apply (reversed) patch + From: Peter Wolfe + Date: Tue, 14 Jul 1998 13:01:58 -0700 (PDT) + Message-Id: <199807142001.NAA26550@titan.teloseng.com> + Subject: NOT_OK: perl 5.00474 on SCO 3.2v5.0.4 + Branch: perl + ! ext/IPC/SysV/SysV.xs +____________________________________________________________________________ +[ 1500] By: gsar on 1998/07/15 05:57:39 + Log: From: Andy Dougherty + Date: Tue, 14 Jul 1998 14:14:59 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_74] Config_74-01 + Branch: perl + ! Configure MANIFEST Porting/Glossary Porting/config.sh + ! Porting/config_H Porting/pumpkin.pod config_h.SH + ! vms/subconfigure.com win32/config.bc win32/config.gc + ! win32/config.vc +____________________________________________________________________________ +[ 1499] By: gsar on 1998/07/15 05:48:38 + Log: From: Jarkko Hietaniemi + Date: Tue, 14 Jul 1998 21:35:02 +0300 (EET DST) + Message-Id: <199807141835.VAA09030@alpha.hut.fi> + Subject: [PATCH] 5.004_74: trig.t: math inaccuracy fudge for unicos + Branch: perl + ! t/lib/trig.t +____________________________________________________________________________ +[ 1498] By: gsar on 1998/07/15 05:47:33 + Log: -w, strict clean perldoc (via PM) + From: Robin Barker + Date: Tue, 14 Jul 98 17:22:01 BST + Message-Id: <18695.9807141622@tempest.cise.npl.co.uk> + Subject: [PATCH 5.004_74] perldoc.PL + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1497] By: gsar on 1998/07/15 05:35:54 + Log: add comment about cpprun etc., to hints/hpux.sh + Branch: perl + ! hints/hpux.sh +____________________________________________________________________________ +[ 1496] By: gsar on 1998/07/15 05:15:16 + Log: fix warning from CGI::Carp + Branch: perl + ! lib/CGI/Carp.pm +____________________________________________________________________________ +[ 1495] By: gsar on 1998/07/14 23:47:18 + Log: fix off-by-one in win32 registry handling + From: "Douglas Lankshear" + Date: Tue, 14 Jul 1998 07:39:06 -0700 + Message-ID: <000401bdaf35$27489e80$a32fa8c0@tau.Active> + Subject: [PATCH 5.004_73] + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 1494] By: gsar on 1998/07/14 23:45:58 + Log: doc patches from Gisle Aas + Date: 14 Jul 1998 16:18:31 +0200 + Message-ID: + Subject: [PATCH] substr/splice changes for perldelta.pod + -- + Date: 14 Jul 1998 20:31:27 +0200 + Message-ID: + Subject: [PATCH] Duplicate description of use integer % + Branch: perl + ! pod/perldelta.pod pod/perlop.pod +____________________________________________________________________________ +[ 1493] By: gsar on 1998/07/14 23:39:31 + Log: File/Spec.pm needs trailing newline + Branch: perl + ! lib/File/Spec.pm +____________________________________________________________________________ +[ 1492] By: gsar on 1998/07/14 21:43:03 + Log: unsubmitted _74 tweaks + Branch: perl + ! Changes mpeix/nm mpeix/relink pod/perldelta.pod + ! pod/perldiag.pod + +---------------- +Version 5.004_74 +---------------- + +____________________________________________________________________________ +[ 1491] By: gsar on 1998/07/14 08:48:28 + Log: up patchlevel to 74; introduce distinct archname for PERL_OBJECT + Branch: perl + ! Changes patchlevel.h pod/perlhist.pod win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 1490] By: gsar on 1998/07/14 08:31:13 + Log: From: Gisle Aas + Date: 14 Jul 1998 10:20:34 +0200 + Message-Id: + Subject: [PATCH] Make -DP work (and readable) + Branch: perl + ! run.c +____________________________________________________________________________ +[ 1489] By: gsar on 1998/07/14 08:23:46 + Log: fix function parameter autovivification for pseudohashes + Branch: perl + ! mg.c t/op/avhv.t +____________________________________________________________________________ +[ 1488] By: gsar on 1998/07/14 07:34:45 + Log: merge changes#1423,1465 from maintbranch; checkin two missed files + from earlier changes#1461,1478 + Branch: perl + ! pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod pp_sys.c + ! t/TEST t/lib/thread.t t/op/local.t t/op/pat.t t/op/regexp.t + ! t/op/substr.t t/op/vec.t +____________________________________________________________________________ +[ 1487] By: gsar on 1998/07/14 07:04:54 + Log: tweak t/lib/thread.t + Branch: perl + ! t/lib/thread.t +____________________________________________________________________________ +[ 1486] By: gsar on 1998/07/14 06:38:15 + Log: applied patch, slightly tweaked + From: Dan Sugalski + Date: Mon, 13 Jul 1998 11:52:27 -0700 + Message-Id: <3.0.5.32.19980713115227.00a73970@ous.edu> + Subject: [PATCH 5.004_73]Get re module working on VMS + Branch: perl + ! ext/re/Makefile.PL perl.h proto.h +____________________________________________________________________________ +[ 1485] By: gsar on 1998/07/14 06:32:58 + Log: add Porting/p4d2p + Branch: perl + + Porting/p4d2p + ! MANIFEST +____________________________________________________________________________ +[ 1484] By: gsar on 1998/07/14 06:08:20 + Log: doc patches from Tom Christiansen (via PM) + Date: Mon, 13 Jul 1998 19:09:09 -0600 + Message-Id: <199807140109.TAA04678@chthon.perl.com> + Subject: perlmod.pod patch + -- + Date: Mon, 13 Jul 1998 18:37:07 -0600 + Message-Id: <199807140037.SAA04556@chthon.perl.com> + Subject: perlbook.pod patch + Branch: perl + ! pod/perlbook.pod pod/perlmod.pod +____________________________________________________________________________ +[ 1483] By: gsar on 1998/07/14 06:04:25 + Log: OS/2 update + From: Ilya Zakharevich + Message-Id: <199807132336.TAA12967@monk.mps.ohio-state.edu> + Date: Mon, 13 Jul 1998 19:36:05 -0400 (EDT) + Subject: [PATCH 5.004_72] OS/2 system() and friends additions + Branch: perl + ! README.os2 hints/os2.sh os2/Changes os2/os2.c t/op/magic.t +____________________________________________________________________________ +[ 1482] By: gsar on 1998/07/14 06:01:12 + Log: more VMS patches from Dan Sugalski + Date: Mon, 13 Jul 1998 16:37:49 -0700 + Message-Id: <3.0.5.32.19980713163749.00af1c40@ous.edu> + Subject: [PATCH 5.004_73]t/io/iprefix.t patch for VMS + -- + Date: Mon, 13 Jul 1998 15:51:09 -0700 + Message-Id: <3.0.5.32.19980713155109.00a52c30@ous.edu> + Subject: [PATCH5.004_73]Tweak t/lib/cgi-html.t to work on VMS + Branch: perl + ! t/io/iprefix.t t/lib/cgi-html.t +____________________________________________________________________________ +[ 1481] By: gsar on 1998/07/14 05:57:36 + Log: From: Dan Sugalski + Date: Mon, 13 Jul 1998 15:41:53 -0700 + Message-Id: <3.0.5.32.19980713154153.00a87be0@ous.edu> + Subject: [PATCH 5.004_73]Fix t/base/rs.t test failures on VMS + Branch: perl + ! t/base/rs.t +____________________________________________________________________________ +[ 1480] By: gsar on 1998/07/14 05:56:14 + Log: From: Dan Sugalski + Message-Id: <3.0.5.32.19980713150427.00b2a540@ous.edu> + Date: Mon, 13 Jul 1998 15:04:27 -0700 + Subject: [PATCH 5.004_73]Thread tweak for VMS.C + Branch: perl + ! vms/vms.c +____________________________________________________________________________ +[ 1479] By: gsar on 1998/07/14 05:55:13 + Log: From: Laszlo Molnar + Date: Mon, 13 Jul 1998 23:13:43 +0200 + Message-ID: <19980713231343.A178@cdata.tvnet.hu> + Subject: [PATCH _72] Configure problem on dos-djgpp + Branch: perl + ! Configure +____________________________________________________________________________ +[ 1478] By: gsar on 1998/07/14 05:53:08 + Log: add files and tweaks needed for MPE/iX port (via PM) + From: Jarkko Hietaniemi + Date: Tue, 14 Jul 1998 00:07:30 +0300 (EET DST) + Message-Id: <199807132107.AAA20603@alpha.hut.fi> + Subject: MPE/iX patches for _73 + Branch: perl + + README.mpeix ext/DynaLoader/dl_mpeix.xs ext/re/hints/mpeix.pl + + mpeix/mpeixish.h mpeix/nm mpeix/relink + ! MANIFEST ext/Socket/Socket.xs hints/mpeix.sh installperl + ! lib/File/Copy.pm perl.c perl.h pod/perldelta.pod +____________________________________________________________________________ +[ 1477] By: gsar on 1998/07/14 04:23:28 + Log: added suggested patch (via PM), tweaked to implicitly specify -DDEBUGGING + From: Andy Dougherty + Date: Mon, 13 Jul 1998 16:50:55 -0400 (EDT) + Message-Id: + Subject: Re: _70 and Devel::RE + Branch: perl + ! ext/re/Makefile.PL ext/re/re.xs regcomp.c regexec.c +____________________________________________________________________________ +[ 1476] By: gsar on 1998/07/14 04:06:25 + Log: minor Configure nits + From: Jarkko Hietaniemi + Date: Mon, 13 Jul 1998 23:25:27 +0300 (EET DST) + Message-Id: <199807132025.XAA10771@alpha.hut.fi> + Subject: Configure patches for MVS (and one x2p/Makefile.SH) + Branch: perl + ! Configure x2p/Makefile.SH +____________________________________________________________________________ +[ 1475] By: gsar on 1998/07/14 03:59:56 + Log: From: Dan Sugalski + Date: Mon, 13 Jul 1998 12:54:19 -0700 + Message-Id: <3.0.5.32.19980713125419.009e0100@ous.edu> + Subject: [PATCH 5.004_73] Fixes to the VMS configuration system + Branch: perl + ! vms/munchconfig.c vms/subconfigure.com +____________________________________________________________________________ +[ 1474] By: gsar on 1998/07/14 03:58:13 + Log: make Term::Readline::get_line() independent of caller's $/ + From: kstar@chapin.edu + Date: Mon, 13 Jul 1998 15:17:49 -0400 + Message-ID: <19980713151749.G8596@O2.chapin.edu> + Subject: [PATCH] Was: CPAN.pm still fails + Branch: perl + ! lib/Term/ReadLine.pm +____________________________________________________________________________ +[ 1473] By: gsar on 1998/07/14 03:55:29 + Log: fix $trnl interpolation in here-docs (via PM) + From: Andy Dougherty + Date: Mon, 13 Jul 1998 15:49:00 -0400 (EDT) + Message-Id: + Subject: Re: [PATCH] 5.004_73: Re: Configure/trnl craziness + Branch: perl + ! Configure +____________________________________________________________________________ +[ 1472] By: gsar on 1998/07/14 03:50:18 + Log: From: Dominic Dunlop + Date: Mon, 13 Jul 1998 15:55:09 +0100 (WET DST) + Message-Id: <199807131455.PAA23621@ppp52.vo.lu> + Subject: Not OK: perl 5.00473 on powerpc-machten 4.1 [PATCH 5.004_73] + Branch: perl + ! hints/machten.sh +____________________________________________________________________________ +[ 1471] By: gsar on 1998/07/14 03:49:07 + Log: From: Dan Sugalski + Message-Id: <3.0.5.32.19980713123005.00b6be50@ous.edu> + Date: Mon, 13 Jul 1998 12:30:05 -0700 + Subject: [PATCH 5.004_73] Add Data::Dumper and re modules to VMS config stuff + Branch: perl + ! configure.com vms/descrip_mms.template +____________________________________________________________________________ +[ 1470] By: gsar on 1998/07/14 03:40:14 + Log: consistently refer to functions as C + From: abigail@fnx.com + Date: Mon, 13 Jul 1998 03:04:24 -0400 (EDT) + Message-ID: <19980713070424.19841.qmail@betelgeuse.wayne.fnx.com> + Subject: Re: [PATCH 5.004_71] pod/perlfunc.pod + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1469] By: gsar on 1998/07/14 03:35:06 + Log: From: Tom Hughes + Date: 13 Jul 1998 09:34:16 +0100 + Message-ID: + Subject: [PATCH 5.004_72] Fix d_Gconvert definition in hints/svr4.sh + Branch: perl + ! hints/svr4.sh +____________________________________________________________________________ +[ 1468] By: gsar on 1998/07/14 03:34:03 + Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig) + Date: 13 Jul 1998 11:16:27 +0200 + Message-ID: + Subject: Parallel Makefiles + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 1467] By: gsar on 1998/07/14 03:31:39 + Log: From: Ilya Zakharevich + Date: Mon, 13 Jul 1998 00:12:19 -0400 (EDT) + Message-Id: <199807130412.AAA27128@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_72] t/io/pipe.t - completely broken? + Branch: perl + ! t/io/pipe.t +____________________________________________________________________________ +[ 1466] By: gsar on 1998/07/14 03:29:25 + Log: minor tweaks to perldelta and README.win32 + Branch: perl + ! Changes README.win32 pod/perldelta.pod +____________________________________________________________________________ +[ 1465] By: TimBunce on 1998/07/13 21:33:45 + Log: Assorted patches: + + Title: "Fix string substitution returncode problem" + From: Dominic Dunlop , Gurusamy Sarathy + Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>, + + Files: pp_hot.c + + Title: "umask EXPR is fatal only if (EXPR & 0700) > 0" + From: Gurusamy Sarathy + Msg-ID: <199807111656.MAA03310@aatma.engin.umich.edu> + Files: pod/perldiag.pod pp_sys.c + + Title: "Remove reference to qsort from perlfunc.pod" + From: Gurusamy Sarathy + Msg-ID: <199807111923.PAA05124@aatma.engin.umich.edu> + Files: pod/perlfunc.pod + + Title: "Deprecate AvFILL in favor of av_len()" + From: Gurusamy Sarathy + Msg-ID: <199807111945.PAA05489@aatma.engin.umich.edu> + Files: pod/perlguts.pod + + Title: "Further clarify effects of using quotes with m operator" + From: Gurusamy Sarathy + Msg-ID: <199806201921.PAA03829@aatma.engin.umich.edu> + Files: pod/perlop.pod + + Title: "Add PERL_DESTRUCT_LEVEL=2 to test suite" + From: Tim Bunce + Files: t/TEST t/op/local.t t/op/pat.t t/op/regexp.t t/op/substr.t t/op/vec.t + Branch: maint-5.004/perl + ! pod/perldiag.pod pod/perlfunc.pod pod/perlguts.pod + ! pod/perlop.pod pp_hot.c pp_sys.c t/TEST t/op/local.t + ! t/op/pat.t t/op/regexp.t t/op/substr.t t/op/vec.t toke.c + +---------------- +Version 5.004_73 +---------------- + +____________________________________________________________________________ +[ 1464] By: gsar on 1998/07/13 04:41:07 + Log: up patchlevel to 73, update Changes &c. + Branch: perl + ! Changes patchlevel.h pod/perlhist.pod t/op/array.t + ! win32/Makefile win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1463] By: gsar on 1998/07/13 02:58:51 + Log: avoid empty rm -f in MM_Unix.pm + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 1462] By: gsar on 1998/07/13 02:54:52 + Log: update perldelta + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 1461] By: gsar on 1998/07/13 02:44:30 + Log: added patch, tweaked PERL_OBJECT things + From: Graham Barr + Date: Sun, 12 Jul 1998 19:57:47 CDT + Message-Id: <19980712195747.C493@pobox.com> + Subject: [ PATCH perl5.004_72] patch to add qr// + Branch: perl + ! dump.c embed.h ext/Opcode/Opcode.pm global.sym globals.c + ! keywords.h keywords.pl op.c op.h opcode.h opcode.pl + ! pod/perlfunc.pod pp.c pp_hot.c pp_proto.h proto.h regcomp.c + ! regexp.h sv.c t/op/pat.t toke.c +____________________________________________________________________________ +[ 1460] By: gsar on 1998/07/13 01:25:07 + Log: add a few more PURIFY guards + Branch: perl + ! av.c sv.c +____________________________________________________________________________ +[ 1459] By: gsar on 1998/07/12 23:38:31 + Log: add tests for change#1458 and then some + Branch: perl + ! t/op/array.t +____________________________________________________________________________ +[ 1458] By: gsar on 1998/07/12 22:42:47 + Log: apply patch for smarter AASSIGN_COMMON detection; regen headers + From: Stephen McCamant + Date: Sun, 12 Jul 1998 17:17:00 CDT + Message-Id: <13737.12300.950886.821143@alias-2.pr.mcs.net> + Subject: [PATCH] @a=@a=qw(1) not working, both 5.004_04 and 5.004_71 + Branch: perl + ! op.c opcode.h opcode.pl +____________________________________________________________________________ +[ 1457] By: gsar on 1998/07/12 22:06:05 + Log: small tweaks from Jarkko Hietaniemi + Branch: perl + ! Configure Makefile.SH ext/Socket/Socket.xs perl.c +____________________________________________________________________________ +[ 1456] By: gsar on 1998/07/12 21:56:39 + Log: From: Doug MacEachern + Date: Sun, 12 Jul 1998 14:29:29 -0400 + Message-Id: <199807121829.OAA00525@postman.opengroup.org> + Subject: [PATCH 5.004_72] Embed.pm support for PERL_OBJECT + Branch: perl + ! lib/ExtUtils/Embed.pm +____________________________________________________________________________ +[ 1455] By: gsar on 1998/07/12 21:54:02 + Log: applied installperl patch, corrected other little nits + From: andreas.koenig@kulturbox.de (Andreas J. Koenig) + Date: 12 Jul 1998 16:27:21 +0200 + Message-ID: + Subject: [5.004_72] installperl tweak + Branch: perl + ! Changes Configure README.win32 installperl win32/makefile.mk +____________________________________________________________________________ +[ 1454] By: gsar on 1998/07/12 10:14:24 + Log: update MANIFEST, Changes + Branch: perl + - lib/Bundle/CPAN.pm + ! Changes MANIFEST + +---------------- +Version 5.004_72 +---------------- + +____________________________________________________________________________ +[ 1453] By: gsar on 1998/07/12 10:04:33 + Log: merge changes 1424, 1428 from maintbranch + Branch: perl + ! Porting/makerel ext/re/re.pm lib/Sys/Syslog.pm +____________________________________________________________________________ +[ 1452] By: gsar on 1998/07/12 09:46:40 + Log: patchlevel up to 72, update Changes, minor tweaks to win32/config* + and README.win32 + Branch: perl + ! Changes README.win32 patchlevel.h win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 1451] By: gsar on 1998/07/12 07:01:26 + Log: generic Configure mods and HAS_GROUP additions to help MiNT/MPEix/MVS + From: Jarkko Hietaniemi + Date: Sat, 11 Jul 1998 17:51:07 +0300 (EET DST) + Message-Id: <199807111451.RAA27010@alpha.hut.fi> + Subject: M3 "generic" parts + Branch: perl + ! Configure Makefile.SH config_h.SH ext/POSIX/POSIX.xs + ! ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm + ! makedepend.SH mv-if-diff perl.h plan9/plan9ish.h pp_sys.c + ! unixish.h vms/subconfigure.com vms/vmsish.h win32/config_H.bc + ! win32/config_H.gc x2p/Makefile.SH +____________________________________________________________________________ +[ 1450] By: gsar on 1998/07/12 06:38:27 + Log: various tweaks for PERL_OBJECT build & test + Branch: perl + ! globals.c iperlsys.h win32/GenCAPI.pl win32/Makefile + ! win32/makefile.mk win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 1449] By: gsar on 1998/07/12 06:29:23 + Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig) + Date: 12 Jul 1998 08:22:16 +0200 + Message-Id: + Subject: [5.004_71] Patch: let CPAN.pm work with threaded perl + Branch: perl + ! lib/CPAN.pm lib/SelfLoader.pm +____________________________________________________________________________ +[ 1448] By: gsar on 1998/07/12 05:10:50 + Log: make RE engine threadsafe; -Dusethreads builds, tests on Solaris, + and runs regexes in 1000s of threads without crashing; also fixed + statcache not being thread-local + Branch: perl + ! embed.h embedvar.h ext/Thread/Thread.xs ext/re/re.xs + ! intrpvar.h op.c perl.c pp_ctl.c regcomp.c regexec.c sv.c + ! t/lib/thread.t thrdvar.h util.c +____________________________________________________________________________ +[ 1447] By: gsar on 1998/07/12 02:40:45 + Log: From: Hugo van der Sanden + Date: Sun, 12 Jul 1998 03:23:04 +0200 + Message-Id: + Subject: Re: perlbug doesn't check that save succeeded + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 1446] By: gsar on 1998/07/12 02:39:24 + Log: be generous about CRs + From: larry@wall.org (Larry Wall) + Date: Sat, 11 Jul 1998 17:54:21 PDT + Message-Id: <199807120054.RAA19550@wall.org> + Subject: [PATCH _71] CRs et al + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 1445] By: gsar on 1998/07/12 02:11:16 + Log: fix pp_caller() to fully traverse stacklevels + Branch: perl + ! objpp.h pp_ctl.c proto.h t/op/runlevel.t +____________________________________________________________________________ +[ 1444] By: gsar on 1998/07/11 23:43:37 + Log: add patch, along with all the missing bits, and doc tweaks + From: Ilya Zakharevich + Date: Thu, 9 Jul 1998 18:47:25 -0400 (EDT) + Message-Id: <199807092247.SAA06314@monk.mps.ohio-state.edu> + Subject: Re: [PATCH 5.004_71] Secure RE update + Branch: perl + ! ObjXSub.h embed.h embedvar.h ext/Opcode/Opcode.pm ext/re/re.pm + ! global.sym globals.c interp.sym intrpvar.h op.c opcode.h + ! opcode.pl pp_ctl.c pp_proto.h regcomp.c sv.c t/op/misc.t + ! t/op/pat.t t/op/subst.t +____________________________________________________________________________ +[ 1443] By: gsar on 1998/07/11 23:08:14 + Log: tweak to get BSDI to build IPC/SysV + From: Jarkko Hietaniemi + Date: 11 Jul 1998 16:26:44 +0300 + Message-ID: + Subject: Re: NOT OK: perl5.004_71 on BSDI 3.1 + Branch: perl + ! ext/IPC/SysV/SysV.xs +____________________________________________________________________________ +[ 1442] By: gsar on 1998/07/11 23:03:39 + Log: fix closures in optimized C (only the tests are in this + change, the pp_hot.c fix accidentally went in change#1441) + Branch: perl + ! t/op/closure.t +____________________________________________________________________________ +[ 1441] By: gsar on 1998/07/11 22:35:40 + Log: From: Ilya Zakharevich + Date: Sat, 11 Jul 1998 18:21:21 -0400 (EDT) + Message-Id: <199807112221.SAA03221@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_71] Update os2's OS2::Process + Branch: perl + ! os2/OS2/Process/Makefile.PL os2/OS2/Process/Process.pm + ! os2/OS2/Process/Process.xs pp_hot.c +____________________________________________________________________________ +[ 1440] By: gsar on 1998/07/11 19:41:59 + Log: From: andreas.koenig@kulturbox.de (Andreas J. Koenig) + Date: 11 Jul 1998 17:00:21 +0200 + Message-ID: + Subject: [perl5.004_71] Patch: change MakeMaker default compress --> gzip + Branch: perl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1439] By: gsar on 1998/07/11 19:36:58 + Log: export newRV_noinc on win32, deprecate AvFILL in favor of av_len() + Branch: perl + ! pod/perlguts.pod win32/makedef.pl +____________________________________________________________________________ +[ 1438] By: gsar on 1998/07/11 19:14:21 + Log: applied patch for perlfunc tweaks, removed reference to system qsort() + From: abigail@fnx.com + Date: Sat, 11 Jul 1998 04:20:54 -0400 (EDT) + Message-ID: <19980711082054.2184.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.004_71] pod/perlfunc.pod + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1437] By: gsar on 1998/07/11 19:05:00 + Log: From: abigail@fnx.com + Date: Sat, 11 Jul 1998 04:09:57 -0400 (EDT) + Message-ID: <19980711080957.2106.qmail@betelgeuse.wayne.fnx.com> + Subject: [PATCH 5.004_71] pod/pod2man.PL + Branch: perl + ! pod/pod2man.PL +____________________________________________________________________________ +[ 1436] By: gsar on 1998/07/11 18:58:03 + Log: more complete version of change#1421 + From: Stephen McCamant + Date: Fri, 10 Jul 1998 23:46:46 -0500 (CDT) + Message-ID: <13734.58994.735473.859218@alias-2.pr.mcs.net> + Subject: [PATCH] Re: B::Deparse for(1..100000) + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1435] By: gsar on 1998/07/11 18:54:42 + Log: win32 fixes for VC 6.0 nits + Branch: perl + ! ext/Data/Dumper/Dumper.xs win32/Makefile win32/makefile.mk + ! win32/win32.h +____________________________________________________________________________ +[ 1434] By: gsar on 1998/07/11 18:45:32 + Log: s/AVHV/pseudo-hash/ (via PM) + From: Gisle Aas + Date: 11 Jul 1998 00:16:53 +0200 + Message-ID: + Subject: [PATCH] trivial fields.pm doc patch + Branch: perl + ! lib/fields.pm +____________________________________________________________________________ +[ 1433] By: gsar on 1998/07/11 18:43:11 + Log: From: Laszlo Molnar + Date: Fri, 10 Jul 1998 23:12:11 +0200 + Message-ID: <19980710231211.A161@cdata.tvnet.hu> + Subject: [PATCH _71] dos-djgpp update + Branch: perl + ! Configure djgpp/config.over djgpp/djgppsed.sh djgpp/fixpmain +____________________________________________________________________________ +[ 1432] By: gsar on 1998/07/11 18:41:00 + Log: applied patch, reformatted long lines in places + From: Dominic Dunlop + Date: Fri, 10 Jul 1998 23:11:30 +0000 + Message-Id: + Subject: [PATCH 5.004_71] Re: Document "count exceeded" regular expression + warning + Branch: perl + ! pod/perldiag.pod regexec.c +____________________________________________________________________________ +[ 1431] By: gsar on 1998/07/11 18:29:18 + Log: From: "John L. Allen" + Date: Fri, 10 Jul 1998 13:57:01 -0400 (EDT) + Message-ID: + Subject: [PATCH]: _71 & _04 - Make AIX hints preserve ccflags as per docs + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 1430] By: TimBunce on 1998/07/11 18:15:09 + Log: Title: "Fix string substitution returncode problem" + From: Dominic Dunlop , Gurusamy Sarathy + Msg-ID: <199805271236.IAA28213@aatma.engin.umich.edu>, + + Files: pp_hot.c + Branch: maint-5.004/perl + ! pp_hot.c +____________________________________________________________________________ +[ 1429] By: gsar on 1998/07/11 18:07:52 + Log: applied patch, tweaked doc and code that does labels/indentation + From: Ilya Zakharevich + Date: Thu, 9 Jul 1998 21:39:40 -0400 (EDT) + Message-Id: <199807100139.VAA08617@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_71] perldebug.pod and RE + Branch: perl + ! pod/perldebug.pod regcomp.c regexec.c +____________________________________________________________________________ +[ 1428] By: TimBunce on 1998/07/11 17:45:56 + Log: Assorted patches: + + Title: "makerel now reads local patch list from patchlevel.h" + Files: patchlevel.h Porting/makerel + + Title: "pod/pod2man.PL" + From: abigail@fnx.com + Msg-ID: <19980711080957.2106.qmail@betelgeuse.wayne.fnx.com> + Files: pod/pod2man.PL + + Title: "Clarify taint example in re.pm" + From: Tom Phoenix + Msg-ID: + Files: lib/re.pm + + Title: "Anohter ptags improvement" + From: Ilya Zakharevich + Msg-ID: <199807070059.UAA28815@monk.mps.ohio-state.edu> + Files: emacs/ptags + + Title: "_71 & _04 - Make AIX hints preserve ccflags as per docs" + From: "John L. Allen" + Msg-ID: + Files: hints/aix.sh + Branch: maint-5.004/perl + ! Porting/makerel emacs/ptags hints/aix.sh lib/re.pm + ! patchlevel.h pod/pod2man.PL +____________________________________________________________________________ +[ 1427] By: gsar on 1998/07/11 17:04:47 + Log: make Liblist return consistently backslashed paths + Branch: perl + ! lib/ExtUtils/Liblist.pm +____________________________________________________________________________ +[ 1426] By: gsar on 1998/07/11 16:53:56 + Log: don't 'touch a2p.c', it might readonly (via PM) + From: Robin Barker + Date: Fri, 10 Jul 98 17:19:54 BST + Message-Id: <20430.9807101619@tempest.cise.npl.co.uk> + Branch: perl + ! x2p/Makefile.SH +____________________________________________________________________________ +[ 1425] By: TimBunce on 1998/07/11 16:42:26 + Log: Title: "Add newCONSTSUB (from 5.005_70)" + Files: embed.h proto.h global.sym op.c + Branch: maint-5.004/perl + ! embed.h global.sym op.c proto.h +____________________________________________________________________________ +[ 1424] By: TimBunce on 1998/07/11 16:20:21 + Log: Title: "Assorted fixes for Sys::Syslog.pm" + From: "M.J.T. Guy" , Sean Robinson + , Tim.Bunce@ig.co.uk + Msg-ID: <01IXGLISWJ7Q0001B6@sc.maricopa.edu>, + <199805270939.KAA08453@toad.ig.co.uk>, + + Files: lib/Sys/Syslog.pm + Branch: maint-5.004/perl + ! lib/Sys/Syslog.pm +____________________________________________________________________________ +[ 1423] By: TimBunce on 1998/07/11 15:53:37 + Log: Assorted patches: + + Title: "umask: die if EXPR & 0700 else return undef" + From: Chip Salzenberg , Jarkko Hietaniemi , + Jarkko Hietaniemi , Malcolm Beattie + , Tim.Bunce@ig.co.uk (Tim Bunce), + kstar@chapin.ed, kstar@chapin.edu@ig.co.uk () + Msg-ID: <199805291520.QAA01615@sable.ox.ac.uk>, + <199805291549.SAA01439@alpha.hut.fi>, + <199805291608.RAA29283@toad.ig.co.uk>, + <19980530105129.A24006@O2.chapin.edu>, + <19980608133037.A8793@perlsupport.com> + Files: pod/perldiag.pod pod/perlfunc.pod pp_sys.c + + Title: "File name DynaLoader.pm.PL is 8.3 unfriendly" + From: Laszlo Molnar + Msg-ID: <19980610005417.G162@cdata.tvnet.hu> + Files: MANIFEST ext/DynaLoader/Makefile.PL + Branch: maint-5.004/perl + +> ext/DynaLoader/DynaLoader_pm.PL + - ext/DynaLoader/DynaLoader.pm.PL + ! MANIFEST ext/DynaLoader/Makefile.PL pod/perldiag.pod + ! pod/perlfunc.pod pp_sys.c +____________________________________________________________________________ +[ 1421] By: gsar on 1998/07/11 02:54:02 + Log: From: Gisle Aas + Subject: [PATCH] B::Deparse for(1..100000) + Date: 10 Jul 1998 14:04:44 +0200 + Message-ID: + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1420] By: gsar on 1998/07/11 02:28:18 + Log: add 'clean' target for ext/re + Branch: perl + ! ext/re/Makefile.PL +____________________________________________________________________________ +[ 1419] By: gsar on 1998/07/11 02:20:32 + Log: From: Tom Hughes + Date: 10 Jul 1998 10:25:18 +0100 + Message-ID: + Subject: [5.004_71] Patch: svr4 hints updates for Unixware + Branch: perl + ! hints/svr4.sh +____________________________________________________________________________ +[ 1418] By: gsar on 1998/07/11 02:19:12 + Log: move op/ipc{msg,sem}.t into lib/ipc_sysv.t + From: Jarkko Hietaniemi + Date: Fri, 10 Jul 1998 13:08:08 +0300 (EET DST) + Message-Id: <199807101008.NAA10817@alpha.hut.fi> + Subject: Re: make minitest does not work out of the box - test subset + needs pruning + Branch: perl + + t/lib/ipc_sysv.t + - t/op/ipcmsg.t t/op/ipcsem.t + ! MANIFEST +____________________________________________________________________________ +[ 1417] By: gsar on 1998/07/11 02:14:16 + Log: disable CR croaking (via #define, default off) in lieu of more + complete fix + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 1416] By: gsar on 1998/07/11 02:06:11 + Log: added patch, made linking with setargv a build option + From: "Douglas Lankshear" + Date: Thu, 9 Jul 1998 09:51:42 -0700 + Message-ID: <000101bdab59$d9602dc0$a32fa8c0@tau.Active> + Subject: [PATCH 5.004_71] + Branch: perl + ! perl.c pp_sys.c win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1415] By: gsar on 1998/07/11 01:47:19 + Log: From: Tom Hughes + Date: 10 Jul 1998 09:01:12 +0100 + Message-ID: + Subject: [5.004_71] Patch: Fix perl_exp.SH for Unixware + Branch: perl + ! perl_exp.SH +____________________________________________________________________________ +[ 1414] By: gsar on 1998/07/11 01:45:45 + Log: make lib/re.pm a prereq for minitest + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1413] By: gsar on 1998/07/11 01:40:56 + Log: add patch (via PM) + From: Stephen McCamant + Date: Fri, 10 Jul 1998 01:14:11 -0500 (CDT) + Message-ID: <13733.45251.47363.431138@alias-2.pr.mcs.net> + Subject: Big B::Deparse update + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1412] By: gsar on 1998/07/11 00:25:17 + Log: add perlport.pod v1.23 from Chris Nandor + Branch: perl + + pod/perlport.pod + ! pod/perl.pod +____________________________________________________________________________ +[ 1411] By: gsar on 1998/07/10 21:53:06 + Log: make binmode(STDIN) not whine + From: Dan Sugalski + Date: Thu, 09 Jul 1998 16:51:27 -0700 + Message-Id: <3.0.5.32.19980709165127.00a692e0@ous.edu> + Subject: [PATCH 5.004_70] Fix up binmode() for VMS + Branch: perl + ! vms/vms.c +____________________________________________________________________________ +[ 1410] By: gsar on 1998/07/10 21:50:57 + Log: CPAN-1.39 update + From: koenig@kulturbox.de (Andreas J. Koenig) + Date: 10 Jul 1998 00:45:36 +0200 + Message-ID: + Subject: Re: perl5.004_71 hit the stands this morn + Branch: perl + ! MANIFEST lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm +____________________________________________________________________________ +[ 1409] By: gsar on 1998/07/10 21:45:10 + Log: manually apply patch with conflicts + From: Dan Sugalski + Date: Thu, 09 Jul 1998 12:08:33 -0700 + Message-Id: <3.0.5.32.19980709120833.009eb100@ous.edu> + Subject: [PATCH 5.004_70] Updated duble-quotes in config.h/config.pm patch + Branch: perl + ! configpm +____________________________________________________________________________ +[ 1408] By: gsar on 1998/07/10 21:36:54 + Log: From: Andy Dougherty + Date: Thu, 9 Jul 1998 11:58:30 -0400 (EDT) + Message-Id: + Subject: Re: perldelta.pod [PATCH] + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 1407] By: gsar on 1998/07/10 21:35:13 + Log: From: Andy Dougherty + Date: Thu, 9 Jul 1998 11:26:03 -0400 (EDT) + Subject: [PATCH 5.004_71] Allow static build of IPC::SysV + Message-Id: + Branch: perl + ! ext/IPC/SysV/Makefile.PL +____________________________________________________________________________ +[ 1406] By: gsar on 1998/07/10 21:33:30 + Log: manually apply patch with conflicts + From: kstar@chapin.edu + Message-ID: <19980709093621.B7857@O2.chapin.edu> + Date: Thu, 9 Jul 1998 09:36:21 -0400 + Subject: Re: [PATCH] 5.004_70 installperl and docs + Branch: perl + ! installperl +____________________________________________________________________________ +[ 1405] By: gsar on 1998/07/10 21:28:29 + Log: misc tweaks to docs and qsortsv() warning + Branch: perl + ! Changes pod/perldelta.pod pod/perlsub.pod pp_ctl.c +____________________________________________________________________________ +[ 1404] By: gsar on 1998/07/10 21:23:53 + Log: add more correct version of change#1350 (as yet untested) + From: joshua.pritikin@db.com + Date: Thu, 9 Jul 1998 09:22:46 -0400 + Message-Id: + Subject: Re: [PATCH _70] cache missing methods + Branch: perl + ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h +____________________________________________________________________________ +[ 1403] By: gsar on 1998/07/10 20:46:12 + Log: add win32_rename() that does what docs say + Branch: perl + ! win32/GenCAPI.pl win32/makedef.pl win32/perlhost.h + ! win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 1402] By: gsar on 1998/07/10 20:19:18 + Log: inet_aton() should do DNS lookup only if arg isn't a dotted-quad + (suggested by Philippe.Simonet@swisscom.com) + Branch: perl + ! ext/Socket/Socket.xs +____________________________________________________________________________ +[ 1401] By: gsar on 1998/07/10 03:24:45 + Log: undo change#1379 (order of tests *is* significant) + Branch: perl + ! t/lib/posix.t +____________________________________________________________________________ +[ 1400] By: nick on 1998/07/09 17:43:14 + Log: Integrate mainline (_071-ish) + Branch: ansiperl + +> ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm + +> ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Makefile.PL + +> ext/Data/Dumper/Todo ext/IPC/SysV/ChangeLog + +> ext/IPC/SysV/MANIFEST ext/IPC/SysV/Makefile.PL + +> ext/IPC/SysV/Msg.pm ext/IPC/SysV/README + +> ext/IPC/SysV/Semaphore.pm ext/IPC/SysV/SysV.pm + +> ext/IPC/SysV/SysV.xs ext/IPC/SysV/t/msg.t ext/IPC/SysV/t/sem.t + +> ext/re/Makefile.PL ext/re/re.pm ext/re/re.xs pp_proto.h + +> t/io/iprefix.t t/lib/dumper-ovl.t t/lib/dumper.t + !> (integrate 145 files) + +---------------- +Version 5.004_71 +---------------- + +____________________________________________________________________________ +[ 1399] By: gsar on 1998/07/09 12:15:12 + Log: update Changes, perlhist.pod, beginnings of perldelta.pod + Branch: perl + ! Changes pod/perldelta.pod pod/perlhist.pod +____________________________________________________________________________ +[ 1397] By: gsar on 1998/07/09 08:35:39 + Log: merge changes from maintbranch (1354, and relevant part of 1356); all + maintenance changes upto 1356 merged + Branch: perl + ! pod/perldiag.pod pp_hot.c t/op/misc.t +____________________________________________________________________________ +[ 1396] By: gsar on 1998/07/09 08:02:52 + Log: add Data-Dumper, up patchlevel to 71, various misc tweaks to + make all configs build on Solaris and win32 + Branch: perl + + ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm + + ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Makefile.PL + + ext/Data/Dumper/Todo t/lib/dumper-ovl.t t/lib/dumper.t + ! MANIFEST Todo patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1395] By: gsar on 1998/07/09 05:39:48 + Log: From: Stephen McCamant + Date: Wed, 08 Jul 1998 23:16:49 CDT + Message-Id: <13732.16626.904108.608743@alias-2.pr.mcs.net> + Subject: [PATCH] UNOP opclass test in B.xs + Branch: perl + ! ext/B/B.xs +____________________________________________________________________________ +[ 1394] By: gsar on 1998/07/09 05:37:48 + Log: get it building again on win32 + Branch: perl + ! bytecode.h embed.h ext/re/Makefile.PL global.sym intrpvar.h + ! op.c opcode.pl perl.h pp.c pp_ctl.c pp_hot.c pp_proto.h + ! pp_sys.c proto.h win32/Makefile win32/makedef.pl + ! win32/makefile.mk +____________________________________________________________________________ +[ 1393] By: gsar on 1998/07/09 05:20:31 + Log: applied patch from Ilya, tweaked some to get clean static build of + the ext/re stuff (untested on win32) + Branch: perl + ! regcomp.c regexec.c +____________________________________________________________________________ +[ 1392] By: gsar on 1998/07/09 03:56:45 + Log: fix installperl typo + From: kstar@chapin.edu + Date: Wed, 08 Jul 1998 23:51:57 EDT + Message-Id: <19980708235157.D1380@O2.chapin.edu> + Subject: Re: [PATCH] 5.004_70 installperl and docs + Branch: perl + ! installperl +____________________________________________________________________________ +[ 1391] By: gsar on 1998/07/09 01:48:16 + Log: From: Chip Salzenberg + Date: Wed, 8 Jul 1998 18:10:55 -0400 + Message-ID: <19980708181055.A8005@perlsupport.com> + Subject: [PATCH _70] Allow $SIG{CHLD}='IGNORE' to work on Solaris + Branch: perl + ! util.c +____________________________________________________________________________ +[ 1390] By: gsar on 1998/07/09 01:45:16 + Log: added patch, tweaked per Ilya's suggestion + From: "M.J.T. Guy" + Date: Wed, 8 Jul 1998 13:34:42 +0100 + Message-Id: + Subject: [PATCH] perl5db.pl complains about non-integer condition + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 1389] By: gsar on 1998/07/09 01:42:13 + Log: reenable misaligned memory checks, cast to UV & check alignment + From: Dominic Dunlop + Date: Wed, 8 Jul 1998 11:21:48 +0000 + Message-Id: + Subject: Re: [PATCH 5.00469] corrupt malloc ptr on NeXT + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1388] By: gsar on 1998/07/09 01:36:22 + Log: From: Andy Dougherty + Date: Wed, 8 Jul 1998 13:32:07 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_70] more on finding metaconfig units. + Branch: perl + ! Porting/pumpkin.pod +____________________________________________________________________________ +[ 1387] By: gsar on 1998/07/09 01:35:23 + Log: From: Andy Dougherty + Date: Wed, 8 Jul 1998 13:29:34 -0400 (EDT) + Message-Id: + Subject: Configure indentation patch + Branch: perl + ! Configure +____________________________________________________________________________ +[ 1386] By: gsar on 1998/07/09 01:33:31 + Log: don't try to hardlink perldiag.pod; that is no longer not needed + From: Andy Dougherty + Date: Wed, 8 Jul 1998 12:18:32 -0400 (EDT) + Message-Id: + Subject: Re: pelr installation attempts hard links between file systems + Branch: perl + ! installperl +____________________________________________________________________________ +[ 1385] By: gsar on 1998/07/09 01:28:05 + Log: win32/makefile.mk =~ s|gcc -pipe|gcc| + Branch: perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 1384] By: gsar on 1998/07/09 01:26:19 + Log: make t/TEST run 'perl $switches ./foo/test.t' everywhere + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 1383] By: gsar on 1998/07/09 01:06:47 + Log: manually apply patch with a dependency on unapplied patch + From: Ilya Zakharevich + Date: Wed, 8 Jul 1998 07:03:51 -0400 (EDT) + Message-Id: <199807081103.HAA25145@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_70] make quoted RE embeddable + Branch: perl + ! sv.c t/op/pat.t +____________________________________________________________________________ +[ 1382] By: gsar on 1998/07/09 01:02:23 + Log: change order of libs for extensions + From: Laszlo Molnar + Date: Tue, 7 Jul 1998 23:48:05 +0200 + Message-ID: <19980707234805.C180@cdata.tvnet.hu> + Subject: [PATCH _70] linking problem with modules + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 1381] By: gsar on 1998/07/09 00:56:12 + Log: patch for more flexible initialization of xsub parameters + From: Tye McQueen + Date: Mon, 6 Jul 1998 19:04:27 -0500 (CDT) + Message-Id: <199807070004.AA16454@metronet.com> + Subject: Enhanced arg inits for xsubpp + Branch: perl + ! lib/ExtUtils/xsubpp pod/perlxs.pod +____________________________________________________________________________ +[ 1380] By: gsar on 1998/07/09 00:44:01 + Log: From: Tye McQueen + Date: Mon, 6 Jul 1998 17:34:54 -0500 (CDT) + Message-Id: <16619-17073@lyris.activestate.com> + Subject: New pl2bat.pl + Branch: perl + ! win32/bin/pl2bat.pl +____________________________________________________________________________ +[ 1379] By: gsar on 1998/07/09 00:30:58 + Log: remove ordering dependency in posix.t + Branch: perl + ! t/lib/posix.t +____________________________________________________________________________ +[ 1378] By: gsar on 1998/07/08 20:17:43 + Log: make -i'*suffix' work too + Branch: perl + ! doio.c +____________________________________________________________________________ +[ 1377] By: gsar on 1998/07/08 08:56:28 + Log: regen headers; result builds & tests on Solaris again (threaded) + Branch: perl + ! embedvar.h +____________________________________________________________________________ +[ 1376] By: gsar on 1998/07/08 08:55:03 + Log: change#1350 breaks things, back it out + Branch: perl + ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h +____________________________________________________________________________ +[ 1375] By: gsar on 1998/07/08 07:47:00 + Log: From: Ilya Zakharevich + Date: Wed, 8 Jul 1998 01:30:15 -0400 (EDT) + Message-Id: <199807080530.BAA14072@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_70] Switch modifiers in RE off + Branch: perl + ! pod/perlre.pod regcomp.c t/op/re_tests +____________________________________________________________________________ +[ 1374] By: gsar on 1998/07/08 07:41:06 + Log: From: Gisle Aas + Date: 07 Jul 1998 23:08:59 +0200 + Message-ID: + Subject: [PATCH] Faster copying from SvIV/SvNVs in sv_setsv() + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1373] By: gsar on 1998/07/08 07:36:01 + Log: From: Laszlo Molnar + Date: Tue, 7 Jul 1998 23:47:50 +0200 + Message-ID: <19980707234750.A180@cdata.tvnet.hu> + Subject: [PATCH _70] dos-djgpp update + Branch: perl + ! djgpp/config.over djgpp/djgppsed.sh +____________________________________________________________________________ +[ 1372] By: gsar on 1998/07/08 07:12:47 + Log: add extension to support SysV IPC + From: Jarkko Hietaniemi + Date: Tue, 7 Jul 1998 02:32:53 +0300 (EET DST) + Message-Id: <199807062332.CAA25792@alpha.hut.fi> + Subject: [PATCH] 5.004_70: IPC::SysV + Branch: perl + + ext/IPC/SysV/ChangeLog ext/IPC/SysV/MANIFEST + + ext/IPC/SysV/Makefile.PL ext/IPC/SysV/Msg.pm + + ext/IPC/SysV/README ext/IPC/SysV/Semaphore.pm + + ext/IPC/SysV/SysV.pm ext/IPC/SysV/SysV.xs ext/IPC/SysV/t/msg.t + + ext/IPC/SysV/t/sem.t + ! Configure MANIFEST pod/perlfunc.pod pod/perlipc.pod + ! t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 1371] By: gsar on 1998/07/08 05:12:07 + Log: add patch for C + From: Ilya Zakharevich + Date: Mon, 6 Jul 1998 22:24:33 -0400 (EDT) + Message-Id: <199807070224.WAA10318@monk.mps.ohio-state.edu> + Subject: Re: _70 and Devel::RE + Branch: perl + + ext/re/Makefile.PL ext/re/re.pm ext/re/re.xs + - lib/re.pm + ! MANIFEST Makefile.SH global.sym interp.sym intrpvar.h op.c + ! perl.h pp.c pp_ctl.c pp_hot.c regcomp.c regexec.c +____________________________________________________________________________ +[ 1370] By: gsar on 1998/07/08 04:27:27 + Log: added patch to generate PPDEF(pp_foo) + From: Ilya Zakharevich + Date: Mon, 6 Jul 1998 20:43:54 -0400 (EDT) + Message-Id: <199807070043.UAA28572@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_70] Autogenerate declarations for opcodes + Branch: perl + + pp_proto.h + ! MANIFEST Makefile.SH opcode.pl proto.h +____________________________________________________________________________ +[ 1369] By: gsar on 1998/07/08 04:19:49 + Log: suggest 'make test' after make + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1368] By: gsar on 1998/07/08 03:58:19 + Log: added patch for -i'foo*bar', made code somewhat simpler, tweaked doc + From: Colin Kuskie + Date: Tue, 7 Jul 1998 09:44:33 -0700 (PDT) + Message-ID: + Subject: Corrected -i prefix patch + Branch: perl + + t/io/iprefix.t + ! MANIFEST doio.c pod/perlrun.pod +____________________________________________________________________________ +[ 1366] By: gsar on 1998/07/08 02:28:30 + Log: From: Gisle Aas + Date: 07 Jul 1998 17:48:36 +0200 + Message-ID: + Subject: [PATCH] Remove some rendundant SvOOK_on tests + Branch: perl + ! sv.c sv.h +____________________________________________________________________________ +[ 1365] By: gsar on 1998/07/08 02:25:17 + Log: applied patch to clarify m//g + From: "M.J.T. Guy" + Date: Tue, 7 Jul 1998 15:59:03 +0100 + Message-Id: + Subject: [PATCH] Re: m//g in perlop.pod + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 1364] By: gsar on 1998/07/08 02:13:07 + Log: From: "M.J.T. Guy" + Subject: [PATCH] 5.004_70 bug in perlfaq.pod + Message-Id: + Date: Tue, 7 Jul 1998 11:59:41 +0100 + Branch: perl + ! pod/perlfaq.pod +____________________________________________________________________________ +[ 1363] By: gsar on 1998/07/08 02:11:11 + Log: applied tweak (via private mail) + From: Jarkko Hietaniemi + Date: Tue, 7 Jul 1998 13:27:47 +0300 (EET DST) + Message-Id: <199807071027.NAA20829@alpha.hut.fi> + Subject: tiny perllocale.pod patch for 5.004_70 + Branch: perl + ! pod/perllocale.pod +____________________________________________________________________________ +[ 1362] By: gsar on 1998/07/08 02:07:48 + Log: applied patch, various tweaks to pander to pod2man tantrums + From: Ilya Zakharevich + Date: Mon, 6 Jul 1998 22:47:30 -0400 (EDT) + Message-Id: <199807070247.WAA10677@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_70] CONFIGPM + Branch: perl + ! Porting/Glossary configpm +____________________________________________________________________________ +[ 1361] By: gsar on 1998/07/07 22:13:11 + Log: From: Stephen McCamant + Date: Mon, 6 Jul 1998 21:22:17 -0500 (CDT) + Message-ID: <13729.33816.311236.995647@alias-2.pr.mcs.net> + Subject: Re: Inconsistent arithmetics on refs + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1360] By: gsar on 1998/07/07 22:11:11 + Log: From: Ilya Zakharevich + Date: Mon, 6 Jul 1998 20:59:10 -0400 (EDT) + Message-Id: <199807070059.UAA28815@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_70] Anohter ptags improvement + Branch: perl + ! emacs/ptags +____________________________________________________________________________ +[ 1359] By: gsar on 1998/07/07 22:08:48 + Log: fix accidental RE-de-optimization + From: larry@wall.org (Larry Wall) + Date: Mon, 6 Jul 1998 17:49:31 -0700 + Message-Id: <199807070049.RAA23475@wall.org> + Subject: Re: before you deluge us with patches + -- + From: Ilya Zakharevich + Date: Tue, 7 Jul 1998 03:10:56 -0400 (EDT) + Message-Id: <199807070710.DAA25399@monk.mps.ohio-state.edu> + Subject: Re: before you deluge us with patches + Branch: perl + ! pp_hot.c regexec.c +____________________________________________________________________________ +[ 1358] By: gsar on 1998/07/07 21:36:29 + Log: From: Gisle Aas + Subject: [PATCH] Evaluation of AVHVs in scalar context + Date: 06 Jul 1998 21:41:14 +0200 + Message-ID: + Branch: perl + ! pp_hot.c t/op/avhv.t +____________________________________________________________________________ +[ 1357] By: gsar on 1998/07/07 21:29:46 + Log: doc tweaks suggested by Abigail, M.J.T. Guy, and Larry Wall + Branch: perl + ! lib/Math/Trig.pm lib/fields.pm thread.sym +____________________________________________________________________________ +[ 1356] By: TimBunce on 1998/07/07 17:19:42 + Log: Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Add Test.pm (from perl 5.004_70)" + Files: MANIFEST lib/Test.pm + + ------ EXTENSIONS ------ + + Title: "Add CR LF CRLF to Socket.pm" + From: Chris Nandor + Msg-ID: + Files: ext/Socket/Socket.pm + + ------ LIBRARY ------ + + Title: "AutoSplit upgrade (AutoSplit 1.0302 from 5.004_70)" + Files: lib/AutoSplit.pm + + Title: "Upgrade base.pm (from perl 5.004_70)" + Files: lib/base.pm + + Title: "Add File::Spec modules (from 5.004_70)" + Files: lib/File/Spec.pm lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + lib/File/Spec/Win32.pm + + ------ TESTS ------ + + Title: "fixup test for method call on undefined value" + Files: t/op/misc.t + + ------ UTILITIES ------ + + Title: "perlbug upgrade (from 5.004_70)" + Files: utils/perlbug.PL + + Title: "Upgrade perldoc (from 5.004_70)" + Files: utils/perldoc.PL + Branch: maint-5.004/perl + + lib/File/Spec.pm lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + + lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + + lib/File/Spec/Win32.pm lib/Test.pm + ! MANIFEST ext/Socket/Socket.pm lib/AutoSplit.pm lib/base.pm + ! t/op/misc.t utils/perlbug.PL utils/perldoc.PL +____________________________________________________________________________ +[ 1355] By: TimBunce on 1998/07/07 14:39:51 + Log: Title: "Fix memory leak in Safe module" + From: Gurusamy Sarathy + Msg-ID: <199806290544.BAA18463@aatma.engin.umich.edu> + Files: ext/Opcode/Opcode.xs ext/Opcode/Safe.pm + Branch: maint-5.004/perl + ! ext/Opcode/Opcode.xs ext/Opcode/Safe.pm +____________________________________________________________________________ +[ 1354] By: TimBunce on 1998/07/07 14:35:25 + Log: Title: "Better error message for $undef->method call" + From: Tim Bunce , Graham Barr , + joshua.pritikin@db.com + Msg-ID: <19980615171027.U4120@asic.sc.ti.com>, + Files: pod/perldiag.pod pp_hot.c + Branch: maint-5.004/perl + ! pod/perldiag.pod pp_hot.c +____________________________________________________________________________ +[ 1353] By: gsar on 1998/07/06 23:33:38 + Log: From: Andy Dougherty + Date: Mon, 6 Jul 1998 16:59:06 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_70] Update metaconfig info + Branch: perl + ! Porting/pumpkin.pod +____________________________________________________________________________ +[ 1352] By: gsar on 1998/07/06 23:30:54 + Log: From: Andy Dougherty + Date: Mon, 6 Jul 1998 13:14:37 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_70] Config_70-01: Remove default "/share" + Branch: perl + ! Configure INSTALL Policy_sh.SH Porting/Glossary + ! Porting/config.sh Porting/config_H +____________________________________________________________________________ +[ 1351] By: gsar on 1998/07/06 23:24:47 + Log: try harder to run non-executable tests + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 1350] By: gsar on 1998/07/06 23:12:17 + Log: add patch to improve method caching, regen headers + From: joshua.pritikin@db.com + Date: Mon, 6 Jul 1998 09:19:29 -0400 + Message-Id: + Subject: [PATCH _70] cache missing methods + Branch: perl + ! embedvar.h gv.c interp.sym intrpvar.h perlvars.h +____________________________________________________________________________ +[ 1349] By: TimBunce on 1998/07/06 23:03:16 + Log: Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Configure: Workaround bash CDPATH oddity" + From: Andy Dougherty + Msg-ID: + Files: Configure + + Title: "Don't suppress display of Makefile recipes that invoke perl" + From: Gurusamy Sarathy + Msg-ID: <199806252213.SAA08545@aatma.engin.umich.edu> + Files: Makefile.SH + + ------ CORE LANGUAGE ------ + + Title: "one more^Wless quad unpack bug" + From: Jarkko Hietaniemi + Msg-ID: <199806301132.OAA27353@alpha.hut.fi> + Files: pp.c + + Title: "minor fixups to bring maint closer to devel for patching" + From: Gurusamy Sarathy + Msg-ID: <199805200046.UAA19284@aatma.engin.umich.edu> + Files: pod/perldiag.pod deb.c dump.c t/op/ref.t t/op/split.t taint.c util.c + + Title: "-Pw switches used together report bogus error" + From: Gurusamy Sarathy + Msg-ID: <199806252331.TAA10160@aatma.engin.umich.edu> + Files: perl.c + + Title: "Add doc and perl home page info to -v output" + From: Tom Christiansen + Msg-ID: <199802172229.PAA29309@jhereg.perl.com> + Files: perl.c + + Title: "Fix C<@a = (%a = 1)> bizarreness" + From: Gurusamy Sarathy , Tom Christiansen + + Msg-ID: <199807012026.OAA31507@jhereg.perl.com>, + <199807012339.TAA26024@aatma.engin.umich.edu> + Files: pp_hot.c + + Title: "make find_script() return saved string, reenable missing + diagnostics" + From: Gurusamy Sarathy + Msg-ID: <199806262224.SAA00422@aatma.engin.umich.edu> + Files: perl.c util.c + + Title: "minor e_script optimization" + From: Gurusamy Sarathy + Msg-ID: <199807060704.DAA25988@aatma.engin.umich.edu> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "Insecure $ENV{} message out of step with perldiag" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perldiag.pod pod/perlsec.pod + + Title: "documenting close without arguments" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: "pod for scalar .. op" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlop.pod + + ------ EXTENSIONS ------ + + Title: "Fcntl: add few constants, enhance maintainability" + From: Jarkko Hietaniemi + Msg-ID: <199806221558.SAA18626@alpha.hut.fi> + Files: ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + + ------ LIBRARY ------ + + Title: "Fix undef warnings in Text::Parsewords" + From: Jarkko Hietaniemi + Msg-ID: <199806300842.LAA26409@alpha.hut.fi> + Files: lib/Text/ParseWords.pm + + Title: "Add Symbol::delete_package()" + From: Gurusamy Sarathy + Msg-ID: <199807060702.DAA25976@aatma.engin.umich.edu> + Files: pod/perlembed.pod lib/Symbol.pm + Branch: maint-5.004/perl + ! Configure Makefile.SH deb.c dump.c ext/Fcntl/Fcntl.pm + ! ext/Fcntl/Fcntl.xs lib/Symbol.pm lib/Text/ParseWords.pm perl.c + ! pod/perldiag.pod pod/perlembed.pod pod/perlfunc.pod + ! pod/perlop.pod pod/perlsec.pod pp.c pp_hot.c t/op/ref.t + ! t/op/split.t taint.c util.c +____________________________________________________________________________ +[ 1348] By: gsar on 1998/07/06 22:55:56 + Log: remove #! line from Errno_pm.PL + Branch: perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 1347] By: gsar on 1998/07/06 22:51:34 + Log: added patch to fix Cwd.pm warnings, fixed a couple more places + From: Gisle Aas + Date: 06 Jul 1998 13:08:53 +0200 + Message-ID: + Subject: [PATCH] 5.004_70 Cwd.pm now give warnings + Branch: perl + ! lib/Cwd.pm +____________________________________________________________________________ +[ 1346] By: gsar on 1998/07/06 22:20:29 + Log: much simpler fix to typecheck read/sysread/recv, as suggested by + Stephen McCamant + Branch: perl + ! op.c +____________________________________________________________________________ +[ 1345] By: gsar on 1998/07/06 21:58:52 + Log: undo ck_sysread() changes#1319,1337 in preparation for a much + simpler fix + Branch: perl + ! ObjXSub.h embed.h global.sym globals.c objpp.h op.c opcode.h + ! opcode.pl proto.h +____________________________________________________________________________ +[ 1344] By: TimBunce on 1998/07/06 21:51:05 + Log: Title: "Fix for broken goto &xsub" + From: Albert Dvornik , + Msg-ID: + Files: MANIFEST pp_ctl.c t/op/goto_xs.t + Branch: maint-5.004/perl + + t/op/goto_xs.t + ! MANIFEST pp_ctl.c +____________________________________________________________________________ +[ 1343] By: TimBunce on 1998/07/06 21:40:14 + Log: Title: "Undo sub stub optimization and add comments on GV_FOO constants" + From: Gurusamy Sarathy + Msg-ID: <199807050841.EAA25114@aatma.engin.umich.edu> + Files: gv.h gv.c op.c toke.c + Branch: maint-5.004/perl + ! gv.c gv.h op.c toke.c +____________________________________________________________________________ +[ 1342] By: gsar on 1998/07/06 20:57:06 + Log: From: Gisle Aas + Message-Id: + Date: 06 Jul 1998 21:52:12 +0200 + Subject: Keepers of the Patch Pumpkin + Branch: perl + ! Changes +____________________________________________________________________________ +[ 1341] By: gsar on 1998/07/06 20:43:35 + Log: remove dup entry in perldiag + Branch: perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 1340] By: gsar on 1998/07/06 20:31:44 + Log: more reasonable diagnostic on keyword vs. sub ambiguity + Branch: perl + ! pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 1339] By: gsar on 1998/07/06 19:23:06 + Log: rename s/\bSI_/PERLSI_/ to avoid collisions with sysinfo headers + Branch: perl + ! av.c cop.h gv.c mg.c op.c perl.c pp_ctl.c pp_sys.c scope.c + ! sv.c toke.c util.c +____________________________________________________________________________ +[ 1338] By: gsar on 1998/07/06 18:45:35 + Log: per Larry suggestion, toss change#1327 and fix the documentation + to match behavior instead + Branch: perl + ! pod/perlfunc.pod pp_sys.c +____________________________________________________________________________ +[ 1337] By: gsar on 1998/07/06 17:15:26 + Log: allow read(FH,threadsv,...) + Branch: perl + ! op.c + +---------------- +Version 5.004_70 +---------------- + +____________________________________________________________________________ +[ 1336] By: gsar on 1998/07/06 09:06:33 + Log: 5.004_70 tweaks + Branch: perl + ! Changes win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1335] By: gsar on 1998/07/06 07:05:37 + Log: update Changes + Branch: perl + ! Changes pod/perldiag.pod +____________________________________________________________________________ +[ 1334] By: gsar on 1998/07/06 06:41:17 + Log: allow eval-groups in patterns only if they C + Branch: perl + ! lib/re.pm perl.h pod/perldiag.pod pod/perlre.pod regcomp.c + ! t/op/misc.t t/op/pat.t t/op/regexp.t t/op/subst.t +____________________________________________________________________________ +[ 1333] By: gsar on 1998/07/06 03:22:52 + Log: From: Hans Mulder + Date: Mon, 6 Jul 98 02:11:32 +0200 + Message-Id: <9807060021.AA29027@icgned.icgroup.nl> + Subject: [PATCH 5.00469] corrupt malloc ptr on NeXT + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1332] By: gsar on 1998/07/06 03:18:34 + Log: added Errno-1.09 from CPAN + Branch: perl + ! ext/Errno/ChangeLog ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 1331] By: gsar on 1998/07/06 02:59:09 + Log: fix small memleak on -e, don't try to find_script() when e_script + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 1330] By: gsar on 1998/07/06 00:40:24 + Log: add Symbol::delete_package() + Branch: perl + ! lib/Symbol.pm pod/perlembed.pod +____________________________________________________________________________ +[ 1329] By: gsar on 1998/07/05 23:05:40 + Log: patch to remove assumptions about offset of IV being == sizeof(XPV) + From: Stephen McCamant + Date: Sun, 5 Jul 1998 17:36:14 -0500 (CDT) + Message-ID: <13727.63831.95324.696098@alias-2.pr.mcs.net> + Subject: [PATCH] alignment in X[IN]V allocation + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1328] By: gsar on 1998/07/05 22:47:57 + Log: make read() return undef on errors as documented, and clarify docs + Branch: perl + ! pod/perlfunc.pod pp_sys.c +____________________________________________________________________________ +[ 1327] By: gsar on 1998/07/05 22:11:21 + Log: fix getc() to return empty string instead of undef on eof, as it was + documented to behave; still returns undef on error + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 1326] By: gsar on 1998/07/05 21:53:30 + Log: patch whitespace-mutiliated; applied manually + From: Hans Mulder + Date: Sun, 5 Jul 98 23:23:20 +0200 + Message-Id: <9807052133.AA28626@icgned.icgroup.nl> + Subject: [PATCH 5.004_69] building Errno.pm still fails on NeXT + Branch: perl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 1325] By: gsar on 1998/07/05 21:38:39 + Log: applied patch (via private mail), modulo retrohunks in pod/perlfaq2.pod + From: Tom Christiansen + Date: Sun, 05 Jul 1998 09:15:22 -0500 + Subject: Re: docpatch + Message-Id: <199807051515.JAA03644@jhereg.perl.com> + Branch: perl + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + ! pod/perlfaq9.pod pod/perlfunc.pod pod/perlipc.pod + ! pod/perlrun.pod +____________________________________________________________________________ +[ 1324] By: gsar on 1998/07/05 21:06:56 + Log: applied patch, and undid change#1302 which it made unnecessary + From: Billy + Date: Sun, 5 Jul 1998 23:05:52 +0930 (CST) + Subject: [PATCH] utils/h2ph.PL and t/lib/h2ph.t + Message-ID: + Branch: perl + ! t/lib/h2ph.t utils/h2ph.PL +____________________________________________________________________________ +[ 1323] By: gsar on 1998/07/05 20:56:39 + Log: fix t/lib/fields.t's @INC so make test runs + Branch: perl + ! t/lib/fields.t +____________________________________________________________________________ +[ 1322] By: gsar on 1998/07/05 20:26:43 + Log: add comments on GV_FOO constants, s/8/GV_ADDINEVAL/ + Branch: perl + ! gv.c gv.h toke.c +____________________________________________________________________________ +[ 1321] By: gsar on 1998/07/05 07:41:50 + Log: sundry win32 config tweaks + Branch: perl + ! Todo.5.005 t/op/stat.t win32/Makefile win32/config.bc + ! win32/config.gc win32/config.vc win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/config_h.PL + ! win32/config_sh.PL win32/makefile.mk +____________________________________________________________________________ +[ 1320] By: gsar on 1998/07/05 06:30:35 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ +[ 1319] By: gsar on 1998/07/05 06:27:37 + Log: add ck_sysread() for better sysread/read/recv sanity + Branch: perl + ! ObjXSub.h embed.h global.sym globals.c objpp.h op.c opcode.h + ! opcode.pl proto.h +____________________________________________________________________________ +[ 1318] By: gsar on 1998/07/05 04:34:05 + Log: From: Stephen McCamant + Date: Sat, 4 Jul 1998 23:24:47 -0500 (CDT) + Subject: [PATCH] Document B::Deparse, add pp_threadsv + Message-ID: <13726.65230.19324.216849@alias-2.pr.mcs.net> + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1317] By: gsar on 1998/07/05 04:15:25 + Log: added patch with tweak to doc + From: Chip Salzenberg + Message-ID: <19980704205136.A16319@perlsupport.com> + Date: Sat, 4 Jul 1998 20:51:36 -0400 + Subject: [PATCH _69] Take 2: Warn on C + Branch: perl + ! ext/IO/lib/IO/Handle.pm pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 1316] By: gsar on 1998/07/05 03:56:22 + Log: Porting/Glossary goes podly into Config.pm + Branch: perl + ! Porting/Glossary configpm +____________________________________________________________________________ +[ 1315] By: gsar on 1998/07/05 02:50:18 + Log: add suggested tool as an example in ExtUtils::Packlist + From: Alan Burlison + Message-Id: <199807031028.LAA10456@sale-wts> + Date: Fri, 3 Jul 1998 11:28:03 +0100 (BST) + Subject: Re: [make install] another horror story + Branch: perl + ! lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm +____________________________________________________________________________ +[ 1314] By: gsar on 1998/07/05 02:28:04 + Log: avoid race condition (storing ptr to SV before incrementing its + REFCNT) and warning in newRV() + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1313] By: gsar on 1998/07/05 02:06:40 + Log: applied suggested fix for xhv_array sizing, with portability tweaks + From: Gisle Aas + Subject: Re: [PATCH] Re: perl5.004_69 core dump + Date: 04 Jul 1998 10:20:35 +0200 + Message-ID: + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 1312] By: gsar on 1998/07/05 01:36:45 + Log: From: Gisle Aas + Subject: [PATCH] hv_max may be a few too many + Date: 04 Jul 1998 09:28:46 +0200 + Message-ID: + Branch: perl + ! doop.c +____________________________________________________________________________ +[ 1311] By: gsar on 1998/07/05 00:35:27 + Log: patchlevel up to 5.004_70, various tweaks + * fix taint problems due to maintbranch regression + * PERL_OBJECT now builds again + * deal with C++ strong-typing problems in hv.c + * fix mismatch in "reserved word" diagnostic + Branch: perl + ! av.c hv.c objpp.h patchlevel.h pp_ctl.c pp_hot.c proto.h + ! regexec.c regexp.h toke.c win32/perlhost.h win32/win32.c +____________________________________________________________________________ +[ 1310] By: TimBunce on 1998/07/04 11:35:25 + Log: Remove old RE //t flag from scan_subst(). + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 1309] By: gsar on 1998/07/04 08:32:53 + Log: various small tweaks (still fails a few taint tests in {taint,locale}.t) + Branch: perl + ! Todo.5.005 lib/re.pm sv.c t/lib/fields.t +____________________________________________________________________________ +[ 1307] By: gsar on 1998/07/04 07:00:14 + Log: fix C, add tests + Branch: perl + ! pp_hot.c t/op/local.t +____________________________________________________________________________ +[ 1306] By: gsar on 1998/07/04 05:52:34 + Log: fixes for mortalization bug in xsubpp, other efficiency tweaks + From: joshua.pritikin@db.com + Date: Wed, 1 Jul 1998 10:09:43 -0400 + Message-Id: + Subject: [PATCH _69] sv_2mortal fix + Branch: perl + ! lib/ExtUtils/xsubpp perl.c pp.c pp_hot.c proto.h sv.c sv.h +____________________________________________________________________________ +[ 1305] By: gsar on 1998/07/04 05:46:42 + Log: add patch preextend global string table, tweak for 512 entries + From: Gisle Aas + Date: 04 Jul 1998 01:04:08 +0200 + Subject: Re: [PATCH] Re: perl5.004_69 core dump + Message-ID: + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 1304] By: gsar on 1998/07/04 05:40:35 + Log: simplify xhv_array sizing + From: Gisle Aas + Date: 04 Jul 1998 00:49:42 +0200 + Subject: Re: [PATCH] Re: perl5.004_69 core dump + Message-ID: + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 1303] By: gsar on 1998/07/04 05:37:29 + Log: make 4-arg win32_select() sleep more reasonably on false values + From: Blair Zajac + Message-Id: <199807020225.TAA18740@gobi.gps.caltech.edu> + Date: Wed, 1 Jul 1998 19:25:56 -0700 (PDT) + Subject: [PATCH 5.004_69] select dumps core on MSWin32-x86 + -- + Message-Id: <199807030107.SAA08595@gobi.gps.caltech.edu> + Date: Thu, 2 Jul 1998 18:07:19 -0700 (PDT) + Subject: [PATCH 5.004_69] select dumps core on MSWin32-x86 + Branch: perl + ! win32/win32sck.c +____________________________________________________________________________ +[ 1302] By: gsar on 1998/07/04 05:32:50 + Log: adjust h2ph.t for dos-specific problem + From: Laszlo Molnar + Message-ID: <19980703234525.C208@cdata.tvnet.hu> + Date: Fri, 3 Jul 1998 23:45:25 +0200 + Subject: Re: [PATCH _68] t/lib/h2ph.t problem + Branch: perl + ! t/lib/h2ph.t +____________________________________________________________________________ +[ 1301] By: gsar on 1998/07/04 05:31:04 + Log: fix CPAN.pm problem, OS2 tweaks + From: Ilya Zakharevich + Message-Id: <199807030459.AAA00097@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_68] PAtch to CPAN first-time + Date: Fri, 3 Jul 1998 00:59:35 -0400 (EDT) + Branch: perl + ! lib/CPAN/FirstTime.pm lib/ExtUtils/MM_OS2.pm + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1300] By: gsar on 1998/07/04 05:27:20 + Log: From: Ilya Zakharevich + Message-Id: <199807030102.VAA26813@monk.mps.ohio-state.edu> + Date: Thu, 2 Jul 1998 21:02:59 -0400 (EDT) + Subject: [PATCH 5.004_68] Add elc target to to makefile + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1299] By: gsar on 1998/07/04 05:25:56 + Log: newer emacs/cperl-mode.el (via private mail) + From: Ilya Zakharevich + Message-Id: <199807030104.VAA26825@monk.mps.ohio-state.edu> + Date: Thu, 2 Jul 1998 21:04:29 -0400 (EDT) + Subject: [PATCH 5.004_68] cperl-mode + Branch: perl + ! emacs/cperl-mode.el +____________________________________________________________________________ +[ 1298] By: gsar on 1998/07/04 05:22:41 + Log: From: Dominic Dunlop + Message-Id: + Date: Thu, 2 Jul 1998 22:57:26 +0000 + Subject: [PATCH 5.004_69] Make Power MachTen use vfork and perl's malloc + Branch: perl + ! hints/machten.sh malloc.c +____________________________________________________________________________ +[ 1297] By: gsar on 1998/07/04 05:20:52 + Log: allow a flags args to fbm_instr() for future needs + From: Ilya Zakharevich + Message-Id: <199807020749.DAA12379@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_68] mORE FBM_ CHANGES FOR FUTURE + Date: Thu, 2 Jul 1998 03:49:32 -0400 (EDT) + Branch: perl + ! pod/perlguts.pod pp.c pp_hot.c proto.h regexec.c util.c +____________________________________________________________________________ +[ 1296] By: gsar on 1998/07/04 05:16:15 + Log: From: Andy Dougherty + Date: Thu, 2 Jul 1998 11:50:41 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_69] INSTALL-1.39 + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 1295] By: gsar on 1998/07/04 05:15:05 + Log: Configure update + From: doughera@newton.phys.lafayette.edu (Andy Dougherty) + Date: Wed, 1 Jul 98 23:07:50 EDT + Message-Id: <9807020307.AA17848@newton.phys.lafayette.edu> + Subject: [PATCH 5.004_69] Config_69-01 + Branch: perl + ! Configure INSTALL MANIFEST Policy_sh.SH Porting/Glossary + ! Porting/config.sh Porting/config_H Porting/pumpkin.pod + ! config_h.SH win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1294] By: gsar on 1998/07/04 05:10:25 + Log: add perlbug -F switch to save message to file + From: Hugo van der Sanden + Message-Id: + Date: Wed, 1 Jul 1998 21:14:22 +0200 + Subject: Re: [PATCH 5.004_69] perlbug -fok + Branch: perl + ! Makefile.SH utils/perlbug.PL +____________________________________________________________________________ +[ 1293] By: gsar on 1998/07/04 05:06:52 + Log: catch nonexistent backrefs in REs + From: Hugo van der Sanden + Message-Id: + Date: Wed, 1 Jul 1998 20:14:05 +0200 + Subject: Re: [PATCH _66] for bad backrefs + -- + Message-Id: + Date: Wed, 1 Jul 1998 20:47:16 +0200 + Subject: Re: [PATCH _66] for bad backrefs + Branch: perl + ! regcomp.c t/op/re_tests util.c +____________________________________________________________________________ +[ 1292] By: gsar on 1998/07/04 05:02:01 + Log: fix perlcc to not rm output file, and other -w(arts) + Branch: perl + ! utils/perlcc.PL +____________________________________________________________________________ +[ 1291] By: gsar on 1998/07/04 04:30:03 + Log: ignore stash entries that are not GVs in dump.c + Branch: perl + ! dump.c +____________________________________________________________________________ +[ 1290] By: gsar on 1998/07/04 03:55:10 + Log: cleaner page headers from pod2man + Branch: perl + ! pod/pod2man.PL +____________________________________________________________________________ +[ 1288] By: gsar on 1998/07/04 03:16:39 + Log: tweaks to Getopt::Std + From: Robin Barker + Date: Tue, 30 Jun 98 14:45:49 BST + Message-Id: <14103.9806301345@tempest.cise.npl.co.uk> + Subject: [PATCH perl5.004_69] lib/Getopt/Std.pm + -- + Message-Id: <17918.9807021053@tempest.cise.npl.co.uk> + To: perl5-porters@perl.org + Subject: [PATCH perl5.004_69] second: lib/Getopt/Std.pm + Branch: perl + ! lib/Getopt/Std.pm +____________________________________________________________________________ +[ 1287] By: gsar on 1998/07/04 03:13:02 + Log: added patch, with tweaks + From: Gisle Aas + Date: 03 Jul 1998 00:50:15 +0200 + Message-ID: + Subject: [PATCH] Some AVHV documentation + Branch: perl + ! pod/perlref.pod +____________________________________________________________________________ +[ 1286] By: gsar on 1998/07/04 02:53:26 + Log: applied patch with tweaks to prose + From: Gisle Aas + Subject: [PATCH] Simplified AVHV support + Date: 30 Jun 1998 13:34:07 +0200 + Message-ID: + Branch: perl + ! ObjXSub.h av.c embed.h global.sym objpp.h pod/perldiag.pod + ! pp.c proto.h t/op/avhv.t +____________________________________________________________________________ +[ 1285] By: gsar on 1998/07/04 02:30:48 + Log: tweak doc for ".." + From: "M.J.T. Guy" + Subject: [PATCH] pod for scalar .. + Message-Id: + Date: Tue, 30 Jun 1998 12:14:50 +0100 + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 1284] By: gsar on 1998/07/04 02:28:43 + Log: fix use of uninitialized var in pp_unpack() + From: Jarkko Hietaniemi + Date: Tue, 30 Jun 1998 14:32:17 +0300 (EET DST) + Message-Id: <199806301132.OAA27353@alpha.hut.fi> + Subject: [PATCH] 5.004_69 (also for 5.004_04) one more^Wless quad bug + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 1283] By: gsar on 1998/07/04 02:26:37 + Log: From: Jarkko Hietaniemi + Date: Tue, 30 Jun 1998 11:40:22 +0300 (EET DST) + Message-Id: <199806300840.LAA04872@alpha.hut.fi> + Subject: [PATCH] 5.004_69: Parsewords.pm: avoid undefined warnings + Branch: perl + ! lib/Text/ParseWords.pm +____________________________________________________________________________ +[ 1282] By: gsar on 1998/07/04 02:24:32 + Log: VMS updates from Dan Sugalski + Message-Id: <3.0.5.32.19980629165356.00a20730@ous.edu> + Date: Mon, 29 Jun 1998 16:53:56 -0700 + Subject: [PATCH 5.004_69]README.vms doc patch + -- + Message-Id: <3.0.5.32.19980629165125.00a4e100@ous.edu> + Date: Mon, 29 Jun 1998 16:51:25 -0700 + -- + Message-Id: <3.0.5.32.19980702135357.00a5eb40@ous.edu> + Date: Thu, 02 Jul 1998 13:53:57 -0700 + Subject: [PATCH 5.004_69]VMS filetest operator fixup + Branch: perl + ! README.vms vms/descrip_mms.template vms/vms.c +____________________________________________________________________________ +[ 1281] By: gsar on 1998/07/04 02:17:48 + Log: From: Dan Sugalski + Message-Id: <3.0.5.32.19980629164625.00a4d7c0@ous.edu> + Date: Mon, 29 Jun 1998 16:46:25 -0700 + Subject: [PATCH 5.004_69]Tweaks to VMS configuration procedure + Branch: perl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 1280] By: gsar on 1998/07/04 02:16:03 + Log: don't attempt to copy directories on VMS + From: Dan Sugalski + Message-Id: <3.0.5.32.19980629163129.00a82140@ous.edu> + Date: Mon, 29 Jun 1998 16:31:29 -0700 + Subject: [PATCH 5.004_69]Tweak to installperl + Branch: perl + ! installperl +____________________________________________________________________________ +[ 1279] By: gsar on 1998/07/04 02:09:26 + Log: add 'installhtml*dir' to win32 config templates + From: "Douglas Lankshear" + Subject: [PATCH 5.004_68] For Win32 config + Date: Mon, 29 Jun 1998 09:00:13 -0700 + Message-ID: <000a01bda376$ffe8b0b0$a32fa8c0@tau.Active> + Branch: perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1278] By: gsar on 1998/07/04 02:06:23 + Log: implemented described fix for h2ph hanging on "enum" + From: Billy + Subject: Re: h2ph problem on Solaris 2.6/SPARC/Sun compiler + Message-ID: + Date: Sat, 27 Jun 1998 01:13:12 +0930 (CST) + Branch: perl + ! utils/h2ph.PL +____________________________________________________________________________ +[ 1277] By: gsar on 1998/07/04 01:51:47 + Log: merge changes#1210,1211,1270 from maintbranch + Branch: perl + + lib/re.pm + ! MANIFEST dump.c installperl lib/File/Basename.pm mg.c op.c + ! op.h perl.h pod/perlmodlib.pod pod/perlop.pod pp_ctl.c + ! pp_hot.c t/lib/basename.t t/op/taint.t toke.c +____________________________________________________________________________ +[ 1276] By: gsar on 1998/07/04 00:33:37 + Log: deprecate use of reserved word "our" (Larry's idea) + Date: Mon, 22 Jun 1998 08:55:09 -0700 + From: larry@wall.org (Larry Wall) + Message-Id: <199806221555.IAA07212@wall.org> + Subject: Re: our + Branch: perl + ! pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 1275] By: nick on 1998/07/02 18:36:59 + Log: Integrate mainline, just to keep up. + Branch: ansiperl + +> t/lib/fields.t + - lib/Math/Trig/Radial.pm + !> MANIFEST lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm + !> lib/Math/Trig.pm lib/base.pm lib/fields.pm mg.c + !> pod/perldiag.pod pod/perltrap.pod pp_hot.c scope.c scope.h + !> t/lib/trig.t t/op/array.t toke.c utils/perldoc.PL + !> win32/config.bc win32/config.gc win32/config.vc + !> win32/include/dirent.h win32/makedef.pl win32/win32.c + !> win32/win32iop.h +____________________________________________________________________________ +[ 1274] By: gsar on 1998/07/02 16:47:20 + Log: tweak win32/config.* variables + Branch: perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1273] By: gsar on 1998/07/02 16:33:53 + Log: export opendir() set of functions on win32 + Branch: perl + ! win32/include/dirent.h win32/makedef.pl win32/win32.c + ! win32/win32iop.h +____________________________________________________________________________ +[ 1272] By: gsar on 1998/07/01 23:21:49 + Log: fix C<@a = (%a = 1)> bizarreness + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 1271] By: gsar on 1998/06/30 22:49:39 + Log: document perltrap on precedence of keys/values/each + Branch: perl + ! pod/perltrap.pod +____________________________________________________________________________ +[ 1270] By: TimBunce on 1998/06/30 09:06:21 + Log: Added lib/re.pm missing from change 1210 + Branch: maint-5.004/perl + + lib/re.pm +____________________________________________________________________________ +[ 1269] By: gsar on 1998/06/30 08:20:52 + Log: From: Murray Nesbitt + Message-Id: <77180549BCE.AAA466A@mail.rdc1.bc.wave.home.com> + Date: Mon, 29 Jun 1998 14:30:59 PDT + Subject: Re: [PATCH 5.004_67] MakeMaker mods for PPD support + Branch: perl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1268] By: gsar on 1998/06/30 05:38:34 + Log: From: Robin Barker + Message-Id: <13254.9806291404@tempest.cise.npl.co.uk> + Date: Mon, 29 Jun 1998 15:04:57 -0000 + Subject: [PATCH perl5.004_69] perldoc.PL + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1267] By: gsar on 1998/06/30 05:34:06 + Log: add patch to integrate Math::Trig::Radial into Math::Trig + From: Jarkko Hietaniemi + Date: Mon, 29 Jun 1998 16:28:53 +0300 (EET DST) + Message-Id: <199806291328.QAA16916@alpha.hut.fi> + Subject: [PATCH] 5.004_68 (or 5.004_04): radial trig + Branch: perl + - lib/Math/Trig/Radial.pm + ! MANIFEST lib/Math/Trig.pm t/lib/trig.t +____________________________________________________________________________ +[ 1266] By: gsar on 1998/06/30 05:17:33 + Log: From: Gisle Aas + Message-Id: + Date: 29 Jun 1998 12:36:09 +0200 + Subject: Re: [PATCH] Simplified magic_setisa() and improved fields.pm + Branch: perl + + t/lib/fields.t + ! MANIFEST lib/base.pm lib/fields.pm mg.c pod/perldiag.pod + ! t/op/array.t +____________________________________________________________________________ +[ 1265] By: gsar on 1998/06/30 05:12:57 + Log: tweaks to overloaded constants (change#1259) + Branch: perl + ! scope.c scope.h toke.c +____________________________________________________________________________ +[ 1264] By: nick on 1998/06/29 17:38:03 + Log: Integrate mainline c. _69 to ansiperl + Branch: ansiperl + +> eg/cgi/caution.xbm eg/cgi/dna.small.gif.uu + +> eg/cgi/nph-multipart.cgi ext/Errno/ChangeLog + +> ext/Errno/Errno_pm.PL ext/Errno/Makefile.PL lib/CGI/Cookie.pm + +> lib/Math/Trig/Radial.pm perlio.h t/lib/cgi-form.t + +> t/lib/cgi-function.t t/lib/cgi-html.t t/lib/cgi-request.t + +> t/lib/errno.t t/op/goto_xs.t t/op/splice.t + !> (integrate 100 files) + +---------------- +Version 5.004_69 +---------------- + +____________________________________________________________________________ +[ 1263] By: gsar on 1998/06/29 09:17:28 + Log: update Changes and perlhist.pod + Branch: perl + ! Changes pod/perlhist.pod +____________________________________________________________________________ +[ 1262] By: gsar on 1998/06/29 08:26:36 + Log: bump patchlevel to 69, various little tweaks (tested on win32, Solaris + under several build configurations) + Branch: perl + ! Todo.5.005 op.c patchlevel.h t/lib/cgi-function.t + ! t/lib/cgi-request.t toke.c win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1261] By: gsar on 1998/06/29 06:51:10 + Log: add missing SSCHECK() to rectify faulty SSPUSH*() logic in change#1259 + Branch: perl + ! scope.h +____________________________________________________________________________ +[ 1260] By: gsar on 1998/06/29 06:46:12 + Log: Message-Id: <199806290610.IAA19443@moulon.inra.fr> + Date: Mon, 29 Jun 1998 08:10:46 +0200 + From: ts + Subject: {perlembed.pod] Re: Memory leak in Perl 5.004 and the fix + Branch: perl + ! pod/perlembed.pod +____________________________________________________________________________ +[ 1259] By: gsar on 1998/06/29 06:01:35 + Log: added patch for overloading constants, made PERL_OBJECT-aware + From: Ilya Zakharevich + Message-Id: <199806270328.XAA21088@monk.mps.ohio-state.edu> + Date: Fri, 26 Jun 1998 23:28:41 -0400 (EDT) + Branch: perl + ! ObjXSub.h embed.h embedvar.h global.sym hv.c interp.sym + ! intrpvar.h lib/Math/BigInt.pm lib/overload.pm objpp.h op.c + ! perl.c perl.h pp_ctl.c proto.h scope.c scope.h + ! t/pragma/overload.t toke.c +____________________________________________________________________________ +[ 1258] By: gsar on 1998/06/29 05:32:25 + Log: fix Socket.pm typo from change#1240 + Branch: perl + ! ext/Socket/Socket.pm +____________________________________________________________________________ +[ 1257] By: gsar on 1998/06/29 05:09:24 + Log: applied patch, tweak for threads awareness + From: Albert Dvornik + Subject: [PATCH]5.004_04-m4 (CORE) fix for broken "goto &xsub" + Date: 24 Jun 1998 19:33:09 -0400 + Message-Id: + Branch: perl + + t/op/goto_xs.t + ! MANIFEST pp_ctl.c +____________________________________________________________________________ +[ 1256] By: gsar on 1998/06/29 03:34:18 + Log: applied patch, fixed one more leak, tweaked whitespace bugs + From: Guy Decoux + (via) + Date: Fri, 26 Jun 1998 09:59:32 -0400 + From: "Chunhui Teng" + Message-Id: <199806261359.JAA02393@bmers357.nortel.ca> + Subject: Memory leak in Perl 5.004 and the fix + Branch: perl + ! ext/Opcode/Opcode.xs ext/Opcode/Safe.pm +____________________________________________________________________________ +[ 1255] By: gsar on 1998/06/29 02:50:37 + Log: From: koenig@kulturbox.de (Andreas J. Koenig) + Subject: Permissions in MakeMaker (Was: patch to MM_Unix.pm) + Date: 28 Jun 1998 23:47:07 +0200 + Message-ID: + Branch: perl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1254] By: gsar on 1998/06/28 21:35:02 + Log: From: joshua.pritikin@db.com + Date: Fri, 26 Jun 1998 09:34:34 -0400 + Message-Id: + Subject: [PATCH _68] PUSHSTACK renovation + Branch: perl + ! av.c cop.h gv.c mg.c perl.c pp_ctl.c pp_sys.c sv.c util.c +____________________________________________________________________________ +[ 1253] By: gsar on 1998/06/28 21:21:22 + Log: From: Stephen McCamant + Message-Id: + Date: Sat, 27 Jun 1998 16:38:19 -0500 (CDT) + Subject: IV changes for long long (was Re: 5.004_68 on its way to the CPAN) + Branch: perl + ! perlvars.h sv.c +____________________________________________________________________________ +[ 1252] By: gsar on 1998/06/28 21:16:34 + Log: From: Ilya Zakharevich + Message-Id: <199806272359.TAA05436@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_68] Improve warning on zero-length chunks in RE + Date: Sat, 27 Jun 1998 19:59:13 -0400 (EDT) + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 1251] By: gsar on 1998/06/28 21:14:32 + Log: add Math/Trig/Radial.pm, update MANIFEST + From: Jarkko Hietaniemi + Date: Sat, 27 Jun 1998 17:28:14 +0300 (EET DST) + Message-Id: <199806271428.RAA05307@alpha.hut.fi> + Subject: Math::Trig::Radial ? + Branch: perl + + lib/Math/Trig/Radial.pm + ! MANIFEST +____________________________________________________________________________ +[ 1250] By: gsar on 1998/06/28 21:09:48 + Log: applied patch, tweaked doc, and regen regnodes.h + From: Ilya Zakharevich + Message-Id: <199806270655.CAA29144@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_68] \z in RE + Date: Sat, 27 Jun 1998 02:55:26 -0400 (EDT) + Branch: perl + ! pod/perlre.pod regcomp.c regcomp.sym regexec.c regnodes.h + ! t/op/re_tests t/op/regexp.t toke.c +____________________________________________________________________________ +[ 1249] By: gsar on 1998/06/28 20:56:38 + Log: From: mike@bill.iac.net + Message-ID: <19980627034913.A32220@bill.minivend.com> + Date: Sat, 27 Jun 1998 03:49:13 +0000 + Subject: [ PATCH 5.004 68 ] Text::ParseWords, ^W fixed, version 3.1 + Branch: perl + ! lib/Text/ParseWords.pm t/lib/parsewords.t +____________________________________________________________________________ +[ 1248] By: gsar on 1998/06/28 20:54:43 + Log: From: Ilya Zakharevich + Message-Id: <199806270352.XAA21174@monk.mps.ohio-state.edu> + Subject: [PATCH] Fix ptags + Date: Fri, 26 Jun 1998 23:52:54 -0400 (EDT) + Branch: perl + ! emacs/ptags +____________________________________________________________________________ +[ 1247] By: gsar on 1998/06/28 20:42:54 + Log: apply patch sent via private mail + From: Stephen McCamant + Message-Id: + Date: Fri, 26 Jun 1998 21:32:23 -0500 (CDT) + Subject: Re: Enhanced B::Deparse + Branch: perl + ! ext/B/B/Deparse.pm +____________________________________________________________________________ +[ 1246] By: gsar on 1998/06/28 20:38:24 + Log: From: Ilya Zakharevich + Message-Id: <199806270109.VAA14907@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_68] pat.t tests + Date: Fri, 26 Jun 1998 21:09:02 -0400 (EDT) + Branch: perl + ! t/op/pat.t +____________________________________________________________________________ +[ 1245] By: gsar on 1998/06/28 20:36:08 + Log: From: joshua.pritikin@db.com + Date: Fri, 26 Jun 1998 10:02:32 -0400 + Message-Id: + Subject: [PATCH _68] improve recursive error messages! + Branch: perl + ! gv.c pod/perldiag.pod universal.c +____________________________________________________________________________ +[ 1244] By: gsar on 1998/06/28 20:09:02 + Log: From: Dominic Dunlop + Message-Id: + Date: Thu, 25 Jun 1998 17:46:55 +0000 + Subject: [PATCH 5.004_68]: Move REG_INFTY-dependent tests from op/regexp.t + to op/pat.t; add tests for a few more regexp parse failures etc. + Branch: perl + ! t/op/pat.t t/op/re_tests t/op/regexp.t +____________________________________________________________________________ +[ 1243] By: gsar on 1998/06/28 20:06:30 + Log: specify *.sym files needed in perl_exp.SH instead of picking up all + From: Andy Dougherty + Date: Thu, 25 Jun 1998 10:36:21 -0400 (EDT) + Subject: Re: Not OK: perl 5.00468 on aix-thread 4.1.4.0 + Message-Id: + Branch: perl + ! perl_exp.SH +____________________________________________________________________________ +[ 1242] By: gsar on 1998/06/28 20:01:28 + Log: + From: Gisle Aas + Subject: Re: [PATCH] 4-arg substr update for perl5.004_68 + Date: 25 Jun 1998 10:32:43 +0200 + Message-ID: + Branch: perl + ! op.c pod/perlfunc.pod pp.c t/op/substr.t +____________________________________________________________________________ +[ 1241] By: gsar on 1998/06/28 19:55:11 + Log: applied patch, tweaked opcode.pl for PERL_OBJECT, and regen opcode.h + From: Stephen McCamant + Message-Id: + Date: Wed, 24 Jun 1998 21:10:32 -0500 (CDT) + Subject: [PATCH REPOST] refgen in opcode.pl + Branch: perl + ! opcode.h opcode.pl +____________________________________________________________________________ +[ 1240] By: gsar on 1998/06/28 19:46:29 + Log: From: Chris Nandor + Message-Id: + Date: Wed, 24 Jun 1998 19:58:28 -0400 + Subject: [PATCH 3d try] Add CR LF CRLF to Socket.pm + Branch: perl + ! ext/Socket/Socket.pm +____________________________________________________________________________ +[ 1239] By: gsar on 1998/06/28 19:44:19 + Log: From: Gisle Aas + Subject: [PATCH] Optimize foreach (1..1000000) + Date: 24 Jun 1998 20:26:48 +0200 + Message-ID: + Branch: perl + ! Todo cop.h op.c pod/perldiag.pod pod/perlop.pod pp_ctl.c + ! pp_hot.c t/op/range.t +____________________________________________________________________________ +[ 1238] By: gsar on 1998/06/28 19:28:13 + Log: avoid creation of %^R + From: Ilya Zakharevich + Message-Id: <199806241825.OAA06346@monk.mps.ohio-state.edu> + Subject: Re: [5.004_68] What is %^R ? [PATCH?] + Date: Wed, 24 Jun 1998 14:25:06 -0400 (EDT) + Branch: perl + ! perl.c t/op/splice.t +____________________________________________________________________________ +[ 1237] By: gsar on 1998/06/28 19:23:40 + Log: From: Gisle Aas + Subject: [PATCH] Negative LENGTH argument to splice + Date: 24 Jun 1998 15:11:35 +0200 + Message-ID: + Branch: perl + + t/op/splice.t + ! MANIFEST pod/perlfunc.pod pp.c +____________________________________________________________________________ +[ 1236] By: gsar on 1998/06/28 19:18:29 + Log: From: "M.J.T. Guy" + Subject: [PATCH] Insecure $ENV{} message out of step with perldiag + Message-Id: + Date: Wed, 24 Jun 1998 13:13:02 +0100 + Branch: perl + ! pod/perldiag.pod pod/perlsec.pod +____________________________________________________________________________ +[ 1235] By: gsar on 1998/06/28 19:16:13 + Log: Complex.pm update + From: Jarkko Hietaniemi + Date: Wed, 24 Jun 1998 15:19:05 +0300 (EET DST) + Message-Id: <199806241219.PAA04061@alpha.hut.fi> + Subject: [PATCH] 5.004_68: Complex.pm, complex.t + Branch: perl + ! lib/Math/Complex.pm t/lib/complex.t +____________________________________________________________________________ +[ 1234] By: gsar on 1998/06/28 19:13:05 + Log: disable perl malloc on UNICOS for now + From: Jarkko Hietaniemi + Date: Wed, 24 Jun 1998 12:37:14 +0300 (EET DST) + Message-Id: <199806240937.MAA01669@alpha.hut.fi> + Subject: [PATCH] 5.004_68: UNICOS hints + Branch: perl + ! hints/unicos.sh +____________________________________________________________________________ +[ 1233] By: gsar on 1998/06/28 19:10:53 + Log: fixes unpack("q"...), and semctl() tests for UNICOS + From: Jarkko Hietaniemi + Date: Wed, 24 Jun 1998 11:55:09 +0300 (EET DST) + Message-Id: <199806240855.LAA16152@alpha.hut.fi> + Subject: [PATCH] 5.004_68: semctl() in UNICOS (was: pack/unpack) + Branch: perl + ! pp.c t/op/ipcsem.t t/op/pack.t +____________________________________________________________________________ +[ 1232] By: gsar on 1998/06/28 19:01:23 + Log: tweak various places for iperlsys.h awareness + Branch: perl + ! MANIFEST Makefile.SH lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_VMS.pm pod/perlapio.pod +____________________________________________________________________________ +[ 1231] By: gsar on 1998/06/28 18:37:07 + Log: add a perlio.h stub for compat (some extensions seem to #include it) + Branch: perl + + perlio.h +____________________________________________________________________________ +[ 1230] By: gsar on 1998/06/28 18:35:23 + Log: Message-ID: <19980624003701.C161@cdata.tvnet.hu> + Date: Wed, 24 Jun 1998 00:37:01 +0200 + From: Laszlo Molnar + Subject: Re: [PATCH for _66] Makefile.SH problem on dos/djgpp + Branch: perl + ! pod/pod2text.PL +____________________________________________________________________________ +[ 1229] By: gsar on 1998/06/28 18:33:42 + Log: hand apply mutiliated patch + Message-Id: <3.0.5.32.19980623114100.00ab76e0@ous.edu> + Date: Tue, 23 Jun 1998 11:41:00 -0700 + From: Dan Sugalski + Subject: [PATCH 5.004_68]Configure update for VMS + Branch: perl + ! configure.com vms/descrip_mms.template vms/subconfigure.com +____________________________________________________________________________ +[ 1228] By: gsar on 1998/06/28 17:17:35 + Log: hand apply whitespace mutiliated patch + Date: Tue, 23 Jun 98 16:38:06 BST + Message-Id: <5389.9806231538@tempest.cise.npl.co.uk> + From: Robin Barker + Subject: PATCH [perl5.004_68] perlbug.PL; was Re: Error message for Errno_pm.PL + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 1227] By: gsar on 1998/06/28 17:14:34 + Log: Date: Tue, 23 Jun 1998 08:51:00 -0700 (PDT) + From: Tom Phoenix + Subject: [PATCH] documenting close without arguments + Message-ID: + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1226] By: gsar on 1998/06/28 17:12:56 + Log: Date: Tue, 23 Jun 1998 05:37:09 -0700 (PDT) + From: Tom Phoenix + Subject: Better diags for vars.pm + Message-ID: + Branch: perl + ! lib/vars.pm +____________________________________________________________________________ +[ 1225] By: gsar on 1998/06/28 17:05:59 + Log: hand apply whitespace mutiliated perldoc.PL patches + Date: Tue, 23 Jun 98 15:49:52 BST + Message-Id: <5302.9806231449@tempest.cise.npl.co.uk> + From: Robin Barker + Subject: PATCH [5.004_68] perldoc.PL + -- + Date: Fri, 26 Jun 98 17:50:05 BST + Message-Id: <6834.9806261650@tempest.cise.npl.co.uk> + From: Robin Barker + Subject: [PATCH 5.004_68] perldoc.PL + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1224] By: gsar on 1998/06/28 16:50:59 + Log: integrate ansiperl to get makedef.pl tweak + Branch: perl + ! Porting/pumpkin.pod win32/makedef.pl +____________________________________________________________________________ +[ 1223] By: gsar on 1998/06/28 16:33:32 + Log: add CGI-2.42, its and testsuite + Branch: perl + + eg/cgi/caution.xbm eg/cgi/dna.small.gif.uu + + eg/cgi/nph-multipart.cgi lib/CGI/Cookie.pm t/lib/cgi-form.t + + t/lib/cgi-function.t t/lib/cgi-html.t t/lib/cgi-request.t + ! MANIFEST eg/cgi/RunMeFirst eg/cgi/file_upload.cgi + ! eg/cgi/index.html eg/cgi/monty.cgi eg/cgi/save_state.cgi + ! eg/cgi/wilogo.gif.uu lib/CGI.pm lib/CGI/Apache.pm + ! lib/CGI/Carp.pm lib/CGI/Fast.pm lib/CGI/Push.pm + ! lib/CGI/Switch.pm +____________________________________________________________________________ +[ 1222] By: gsar on 1998/06/28 15:28:29 + Log: enable Errno build on win32, add Errno-1.08 files to repository + Branch: perl + + ext/Errno/ChangeLog ext/Errno/Errno_pm.PL + + ext/Errno/Makefile.PL t/lib/errno.t + ! MANIFEST win32/Makefile win32/config.bc win32/config.gc + ! win32/config.vc win32/makefile.mk +____________________________________________________________________________ +[ 1221] By: gsar on 1998/06/28 14:34:06 + Log: tweak win32 config templates for cpp + Branch: perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1220] By: nick on 1998/06/26 16:46:13 + Log: Integrate mainline + Branch: ansiperl + !> Changes Makefile.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod + !> ext/POSIX/POSIX.xs perl.c pod/perlre.pod pod/perlvar.pod sv.c + !> util.c win32/win32.h +____________________________________________________________________________ +[ 1219] By: gsar on 1998/06/26 04:33:57 + Log: make find_script() return saved string, reenable missing diagnostics + Branch: perl + ! perl.c util.c +____________________________________________________________________________ +[ 1218] By: gsar on 1998/06/25 23:24:53 + Log: avoid warning with -P switch + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 1217] By: gsar on 1998/06/25 22:06:58 + Log: don't suppress display of Makefile recipes that invoke perl + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1216] By: gsar on 1998/06/25 21:32:06 + Log: tweak order of destruction so OBJECTs in GLOBs are visited after those + in RVs + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1215] By: gsar on 1998/06/25 18:56:59 + Log: mknod() is not POSIX, so remove the POSIX pieces from change#1199 + Branch: perl + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 1214] By: gsar on 1998/06/25 18:11:22 + Log: add FILE_SHARE_DELETE ifndef in win32.h + Branch: perl + ! win32/win32.h +____________________________________________________________________________ +[ 1213] By: nick on 1998/06/24 17:18:59 + Log: Correct perl malloc tweak to .def generation + Branch: ansiperl + ! win32/makedef.pl +____________________________________________________________________________ +[ 1212] By: gsar on 1998/06/24 12:40:13 + Log: check in what change#1182 didn't, and Changes + Branch: perl + ! Changes pod/perlre.pod pod/perlvar.pod +____________________________________________________________________________ +[ 1211] By: TimBunce on 1998/06/23 23:09:37 + Log: Update test count in t/lib/basename.t (see change 1210) + Branch: maint-5.004/perl + ! t/lib/basename.t +____________________________________________________________________________ +[ 1210] By: TimBunce on 1998/06/23 22:58:18 + Log: Title: "Add C pragma to propagate tainting in m// and s///" + From: Chip Salzenberg , Gurusamy Sarathy + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <19980525155222.A18445@perlsupport.com>, + <199805261143.MAA04260@toad.ig.co.uk>, + <199805261235.IAA10371@aatma.engin.umich.edu>, + Files: MANIFEST pod/perlmodlib.pod pod/perlop.pod op.h perl.h dump.c + installperl lib/re.pm lib/File/Basename.pm mg.c op.c + pp_ctl.c pp_hot.c t/lib/basename.t t/op/taint.t toke.c + Branch: maint-5.004/perl + ! MANIFEST dump.c embed.h installperl lib/File/Basename.pm mg.c + ! op.c op.h perl.h pod/perlmodlib.pod pod/perlop.pod pp_ctl.c + ! pp_hot.c t/lib/basename.t t/op/taint.t toke.c +____________________________________________________________________________ +[ 1209] By: nick on 1998/06/23 21:33:34 + Log: Perl_malloced_size() only available with perl's malloc + Branch: ansiperl + ! win32/makefile.mk +____________________________________________________________________________ +[ 1208] By: nick on 1998/06/23 18:15:23 + Log: Integrate mainline c. 5.004_68 into ansiperl, mainly + so see what has changed... + Branch: ansiperl + +> Porting/genlog iperlsys.h lib/File/Spec.pm + +> lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + +> lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + +> lib/File/Spec/Win32.pm regcomp.pl regcomp.sym regnodes.h + +> t/lib/filespec.t win32/perlhost.h + - atomic.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h + - ipstdio.h perldir.h perlenv.h perlio.h perllio.h perlmem.h + - perlproc.h perlsock.h + !> (integrate 96 files) + +---------------- +Version 5.004_68 +---------------- + +____________________________________________________________________________ +[ 1207] By: gsar on 1998/06/23 10:55:05 + Log: final touches to 5.004_68 + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 1206] By: gsar on 1998/06/23 10:50:10 + Log: more MULTIPLICITY tweaks + Branch: perl + ! objpp.h perl.c perl.h proto.h win32/GenCAPI.pl win32/config.bc + ! win32/config.gc win32/config.vc win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 1205] By: gsar on 1998/06/23 09:03:46 + Log: partial MULTIPLICITY cleanup + Branch: perl + ! embedvar.h interp.sym intrpvar.h perl.c perlvars.h proto.h + ! thrdvar.h +____________________________________________________________________________ +[ 1204] By: gsar on 1998/06/23 09:00:48 + Log: tweak MANIFEST, add Dev_t to POSIX/typemap + Branch: perl + ! MANIFEST Porting/makerel README.win32 ext/POSIX/typemap +____________________________________________________________________________ +[ 1203] By: gsar on 1998/06/23 07:08:02 + Log: bump patchlevel to 68, Porting/makerel tweaks + Branch: perl + ! Porting/makerel patchlevel.h win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1202] By: gsar on 1998/06/23 06:16:19 + Log: remove atomic.h pending resolution of licensing issues, + EMULATE_ATOMIC_REFCOUNTS everywhere + Branch: perl + - atomic.h + ! MANIFEST perl.h sv.h +____________________________________________________________________________ +[ 1201] By: gsar on 1998/06/23 06:06:23 + Log: applied patch, regen headers + From: Ilya Zakharevich + Message-Id: <199806220819.EAA03295@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Malloc size feedback + Date: Mon, 22 Jun 1998 04:19:45 -0400 (EDT) + Branch: perl + ! ObjXSub.h av.c embed.h global.sym hv.c malloc.c objpp.h perl.c + ! pp_sys.c proto.h sv.c toke.c +____________________________________________________________________________ +[ 1200] By: gsar on 1998/06/23 05:59:09 + Log: Message-Id: + Date: Mon, 22 Jun 1998 21:19:43 -0500 (CDT) + From: Stephen McCamant + Subject: [PATCH] Inheritance of B:: classes + Branch: perl + ! ext/B/B.pm +____________________________________________________________________________ +[ 1199] By: gsar on 1998/06/23 05:57:58 + Log: applied patch, moved #define mkfifo ... from perl.h to POSIX.xs + Date: Tue, 23 Jun 1998 00:01:02 +0300 (EET DST) + Message-Id: <199806222101.AAA16456@alpha.hut.fi> + Subject: [PATCH] _67: somebody said POSIX::mknod? + From: Jarkko Hietaniemi + Branch: perl + ! Configure config_h.SH ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod + ! ext/POSIX/POSIX.xs perl.h +____________________________________________________________________________ +[ 1198] By: gsar on 1998/06/23 05:48:56 + Log: Date: Mon, 22 Jun 1998 14:10:46 -0600 (MDT) + From: Daniel Grisinger + Subject: PATCH [5.004_67] perldoc.PL + Message-ID: + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1197] By: gsar on 1998/06/23 05:47:24 + Log: Message-Id: <3.0.5.32.19980622092918.00aa46e0@ous.edu> + Date: Mon, 22 Jun 1998 09:29:18 -0700 + From: Dan Sugalski + Subject: [PATCH 5.004_67] Autosplit's not qite case-insensitive enough on VMS + Branch: perl + ! lib/AutoSplit.pm +____________________________________________________________________________ +[ 1196] By: gsar on 1998/06/23 05:45:19 + Log: Date: Mon, 22 Jun 1998 18:58:55 +0300 (EET DST) + Message-Id: <199806221558.SAA18626@alpha.hut.fi> + Subject: [PATCH] 5.004_67: Fcntl: add few constants, enhance maintainability + From: Jarkko Hietaniemi + Branch: perl + ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs +____________________________________________________________________________ +[ 1195] By: gsar on 1998/06/23 05:43:32 + Log: Message-Id: + Date: Mon, 22 Jun 1998 15:22:24 +0000 + From: Dominic Dunlop + Subject: [PATCH 5.004_67] Amend tests/regexp.t for variable REG_INFTY; + update machten.sh to vary REG_INFTY + Branch: perl + ! hints/machten.sh t/op/re_tests t/op/regexp.t +____________________________________________________________________________ +[ 1194] By: gsar on 1998/06/23 05:38:36 + Log: filter out array subscripts when generating symbols for AIX + Date: Mon, 22 Jun 1998 12:14:31 +0300 (EET DST) + Message-Id: <199806220914.MAA13631@alpha.hut.fi> + Subject: [PATCH] 5.004_67: perl.exp bug, AIX unhappy + From: Jarkko Hietaniemi + Branch: perl + ! perl_exp.SH +____________________________________________________________________________ +[ 1193] By: gsar on 1998/06/23 05:32:52 + Log: updated hints file to cope with buggy sigsetjmp() on Solaris-x86 + Message-Id: <199806221102.NAA12106@alanya.m.isar.de> + Date: Mon, 22 Jun 1998 13:02:45 +0200 (MET DST) + From: Lupe Christoph + Subject: Re: Perl 5.004_67: Death is on vacation - miniperl can't die + Branch: perl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 1192] By: gsar on 1998/06/23 05:27:13 + Log: add detailed changelogs and 'genlog'--the script which generates them + Branch: perl + + Porting/genlog + ! Changes INSTALL +____________________________________________________________________________ +[ 1191] By: gsar on 1998/06/22 15:56:27 + Log: tweak win32 makefiles for PERL_OBJECT build + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1190] By: gsar on 1998/06/22 04:06:02 + Log: backout change#1178 as it was dependent on an unapplied patch, + fix filespec.t to know its @INC + Branch: perl + ! sv.c t/lib/filespec.t +____________________________________________________________________________ +[ 1189] By: gsar on 1998/06/22 03:47:43 + Log: eliminate use of tokenbuf in util.c + Branch: perl + ! util.c +____________________________________________________________________________ +[ 1188] By: gsar on 1998/06/22 01:53:59 + Log: add patch that generates regnodes.h via regcomp.pl + From: Ilya Zakharevich + Message-Id: <199806212038.QAA29797@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] regcomp.h regnodes cleanup + Date: Sun, 21 Jun 1998 16:38:21 -0400 (EDT) + Branch: perl + + regcomp.pl regcomp.sym regnodes.h + ! MANIFEST Makefile.SH regcomp.h +____________________________________________________________________________ +[ 1187] By: gsar on 1998/06/22 01:42:21 + Log: From: Ilya Zakharevich + Message-Id: <199806210145.VAA21629@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Avoid temporaries on recursion + Date: Sat, 20 Jun 1998 21:45:03 -0400 (EDT) + Branch: perl + ! pp_ctl.c pp_hot.c +____________________________________________________________________________ +[ 1186] By: gsar on 1998/06/22 01:14:14 + Log: merge relevant portions from maintbranch change#1155 + Branch: perl + ! lib/Math/BigFloat.pm op.c pod/perlfunc.pod pod/perlop.pod + ! pod/perlrun.pod pp_hot.c +____________________________________________________________________________ +[ 1185] By: gsar on 1998/06/22 00:59:28 + Log: From: Ilya Zakharevich + Message-Id: <199806210827.EAA26322@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Zero-length matching bug + Date: Sun, 21 Jun 1998 04:27:16 -0400 (EDT) + Branch: perl + ! regexec.c t/op/pat.t +____________________________________________________________________________ +[ 1184] By: gsar on 1998/06/22 00:57:27 + Log: fix alignment issues in malloc.c on 64-bit platforms (via private mail) + From: Ilya Zakharevich + Message-Id: <199806170844.EAA24584@monk.mps.ohio-state.edu> + Subject: Re: _67 not okay + Date: Wed, 17 Jun 1998 04:44:26 -0400 (EDT) + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1183] By: gsar on 1998/06/22 00:53:37 + Log: From: Ilya Zakharevich + Message-Id: <199806210727.DAA24072@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Test study/re/ + Date: Sun, 21 Jun 1998 03:27:13 -0400 (EDT) + Branch: perl + ! t/op/pat.t +____________________________________________________________________________ +[ 1182] By: gsar on 1998/06/21 21:25:07 + Log: From: Ilya Zakharevich + Message-Id: <199806210430.AAA21818@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] $^R documented + Date: Sun, 21 Jun 1998 00:30:48 -0400 (EDT) + Branch: perl + ! pod/perlre.pod pod/perlvar.pod +____________________________________________________________________________ +[ 1181] By: gsar on 1998/06/21 21:23:41 + Log: From: Ilya Zakharevich + Message-Id: <199806210111.VAA17752@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Re docs + Date: Sat, 20 Jun 1998 21:11:37 -0400 (EDT) + Branch: perl + ! pod/perlop.pod pod/perlre.pod +____________________________________________________________________________ +[ 1180] By: gsar on 1998/06/21 21:22:16 + Log: adapted contents of message into comments in malloc.c and INSTALL + From: Ilya Zakharevich + Message-Id: <199806162240.SAA23597@monk.mps.ohio-state.edu> + Subject: [5.004_67] malloc.c -Defines + Date: Tue, 16 Jun 1998 18:40:41 -0400 (EDT) + Branch: perl + ! INSTALL malloc.c +____________________________________________________________________________ +[ 1179] By: gsar on 1998/06/21 07:26:35 + Log: applied patch, with edits to the prose + From: Ilya Zakharevich + Message-Id: <199806201936.PAA17499@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Error variables compared + Date: Sat, 20 Jun 1998 15:36:14 -0400 (EDT) + Branch: perl + ! pod/perlvar.pod +____________________________________________________________________________ +[ 1178] By: gsar on 1998/06/21 07:07:16 + Log: From: Ilya Zakharevich + Message-Id: <199806200104.VAA11343@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] print study /re/ broken + Date: Fri, 19 Jun 1998 21:04:54 -0400 (EDT) + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 1177] By: gsar on 1998/06/21 07:06:10 + Log: applied patch, tweaked wording + From: Ilya Zakharevich + Message-Id: <199806200838.EAA13992@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Documentation patch for malloc + Date: Sat, 20 Jun 1998 04:38:07 -0400 (EDT) + Branch: perl + ! malloc.c pod/perldiag.pod +____________________________________________________________________________ +[ 1176] By: gsar on 1998/06/21 07:00:30 + Log: From: Ilya Zakharevich + Message-Id: <199806200829.EAA13974@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Cosmetic malloc patch + Date: Sat, 20 Jun 1998 04:29:00 -0400 (EDT) + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1175] By: gsar on 1998/06/21 06:58:37 + Log: Message-Id: <3.0.5.32.19980619160057.032e7480@ous.edu> + Date: Fri, 19 Jun 1998 16:00:57 -0700 + From: Dan Sugalski + Subject: [PATCH 5.004_67] fixup patches for VMS + Branch: perl + ! ext/SDBM_File/sdbm/Makefile.PL t/lib/filecopy.t t/op/defins.t + ! t/op/taint.t vms/test.com vms/vms.c +____________________________________________________________________________ +[ 1174] By: gsar on 1998/06/21 06:55:18 + Log: applied VMS patch from Dan Sugalski + Date: Fri, 19 Jun 1998 15:36:34 -0700 + From: SYSTEM@cedar.osshe.edu + Message-Id: <980619153634.2063ee12@cedar.osshe.edu> + Subject: [PATCH 5.004_67] Enhancements to the VMS configuration procedures + Branch: perl + ! configure.com lib/ExtUtils/MM_VMS.pm perl.h + ! vms/descrip_mms.template vms/gen_shrfls.pl + ! vms/subconfigure.com +____________________________________________________________________________ +[ 1173] By: gsar on 1998/06/21 06:51:38 + Log: applied patch, modified logic to avoid reentering lexer at compile-time + Message-ID: <19980619113104.S9711@asic.sc.ti.com> + Date: Fri, 19 Jun 1998 11:31:04 -0500 + From: Graham Barr + Subject: Re: [PATCH perl5.004_67] Add Errno in ext/ + Branch: perl + ! Configure MANIFEST Makefile.SH ext/util/make_ext gv.c + ! lib/English.pm +____________________________________________________________________________ +[ 1172] By: gsar on 1998/06/21 06:27:57 + Log: applied patch, along with many changes: + - ipfoo.h headers have been coalesced along with perlfoo.h into + iperlsys.h + - win32/cp*.h have been combined in perlhost.h + - CPerlObj::PerlParse() takes an extra xsinit arg + - tweaks to get dl_win32.xs compiling again w/ PERL_OBJECT + From: "Douglas Lankshear" + Message-Id: <000001bd9b8c$0417fe90$a32fa8c0@tau.Active> + Subject: RE: [PATCH 5.004_67] Fixes for broken MS compiler + Date: Fri, 19 Jun 1998 10:59:50 -0700 + Branch: perl + + iperlsys.h win32/perlhost.h + - ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h ipstdio.h + - perldir.h perlenv.h perlio.h perllio.h perlmem.h perlproc.h + - perlsock.h + ! MANIFEST mg.h op.h perl.h perlio.c proto.h util.c + ! win32/Makefile win32/dl_win32.xs win32/makefile.mk + ! win32/runperl.c win32/win32.h +____________________________________________________________________________ +[ 1171] By: gsar on 1998/06/21 00:44:42 + Log: Date: Fri, 19 Jun 1998 07:55:19 -0600 (MDT) + From: Daniel Grisinger + Subject: Re: PATCH _67 (Doc) perlop.pod + Message-ID: + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 1170] By: gsar on 1998/06/21 00:43:06 + Log: a tweaked version of: + From: "Douglas Lankshear" + Subject: [PATCH 5.004_67] Win32 using PerlCRT.dll + Date: Wed, 17 Jun 1998 20:25:51 -0700 + Message-ID: <001b01bd9a68$cb752410$a32fa8c0@tau.Active> + Branch: perl + ! lib/ExtUtils/MM_Win32.pm win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1169] By: gsar on 1998/06/21 00:10:18 + Log: added patch, regen headers + From: Ilya Zakharevich + Message-Id: <199806190227.WAA07371@monk.mps.ohio-state.edu> + Subject: Re: Ilya's patches + Date: Thu, 18 Jun 1998 22:27:31 -0400 (EDT) + Branch: perl + ! ObjXSub.h embedvar.h interp.sym intrpvar.h toke.c +____________________________________________________________________________ +[ 1168] By: gsar on 1998/06/21 00:05:01 + Log: Date: Thu, 18 Jun 1998 23:37:32 -0700 (PDT) + From: Tom Phoenix + Subject: [PATCH] docs creating files via open + Message-ID: + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 1167] By: gsar on 1998/06/21 00:03:34 + Log: From: Ilya Zakharevich + Message-Id: <199806172151.RAA28441@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_67] Better version of malloc improver + Date: Wed, 17 Jun 1998 17:51:54 -0400 (EDT) + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1166] By: gsar on 1998/06/20 23:59:23 + Log: enhance perlre.pod to say C<)> can't appear in a (?#...) comment + Branch: perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 1165] By: gsar on 1998/06/20 23:47:09 + Log: added patch, tweaked missed files, excised comment that doesn't really + belong in the sources + From: joshua.pritikin@db.com + Date: Mon, 15 Jun 1998 10:03:37 -0400 + Message-Id: + Subject: [PATCH 5.004_57] tied hash slice & do_kv cleanup + Branch: perl + ! ObjXSub.h av.c doop.c embed.h global.sym objpp.h pp.c proto.h + ! t/op/avhv.t +____________________________________________________________________________ +[ 1164] By: gsar on 1998/06/20 23:29:09 + Log: add File-Spec-0.6 from CPAN + Branch: perl + + lib/File/Spec.pm lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + + lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + + lib/File/Spec/Win32.pm t/lib/filespec.t + ! MANIFEST +____________________________________________________________________________ +[ 1163] By: gsar on 1998/06/20 23:15:41 + Log: tweaks to allow both mingw32{gcc-2.8.1,egcs-1.0.2} build and test + Branch: perl + ! ext/POSIX/POSIX.xs win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1162] By: gsar on 1998/06/20 21:48:32 + Log: manual integration of all outstanding ansi branch stuff into mainline + Branch: perl + ! ext/POSIX/POSIX.xs lib/ExtUtils/MM_Win32.pm t/op/ipcsem.t + ! win32/config.gc win32/dl_win32.xs win32/makefile.mk + ! win32/win32.h +____________________________________________________________________________ +[ 1161] By: gsar on 1998/06/20 21:12:01 + Log: undo goofed change 1157 (backed out the fix instead of keeping it) + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1160] By: nick on 1998/06/20 21:05:51 + Log: Patches to build with EGCS-1.0.2 Mingw32 port. + Branch: ansiperl + ! ext/POSIX/POSIX.xs win32/config.gc win32/config_H.gc + ! win32/dl_win32.xs win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 1159] By: gsar on 1998/06/20 02:51:35 + Log: cleanup installation of utilities on win32 + Branch: perl + ! installperl pod/Makefile win32/Makefile win32/makefile.mk + ! win32/pod.mak +____________________________________________________________________________ +[ 1158] By: gsar on 1998/06/20 02:50:35 + Log: intuit @INC pathnames from exe location only if dll location + is unknown (ensures that multiple executables will coexist) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 1157] By: gsar on 1998/06/20 02:48:34 + Log: make perldoc ignore null files (it tried to open() them) + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1156] By: gsar on 1998/06/19 21:18:47 + Log: fix perldoc to ignore unfound null filenames + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 1155] By: TimBunce on 1998/06/19 18:47:57 + Log: Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "Clarify varargs issues in INSTALL docs" + From: Andy Dougherty + Msg-ID: + Files: INSTALL + + ------ CORE LANGUAGE ------ + + Title: "Further fixes for updated SysV IPC support" + From: Jarkko Hietaniemi + Msg-ID: <199805211644.TAA15139@alpha.hut.fi> + Files: Configure perl.h doio.c + + Title: "Fixed SEGV caused by bug in pp_hot.c:pp_sassign()" + From: Andrew Bettison + Msg-ID: + Files: pp_hot.c + + Title: "Invalidate method cache on C" + From: Chip Salzenberg + Msg-ID: <19980604134731.D24343@perlsupport.com> + Files: scope.c t/op/method.t + + Title: "fix uninitialized cv variable in op.c" + From: joshua.pritikin@db.com + Msg-ID: + Files: op.c + + Title: "fix for undef as last arg to setsockopt" + From: Graham Barr + Msg-ID: <19980603112219.B7638@asic.sc.ti.com> + Files: pp_sys.c + + Title: "Fix -i when @ARGV is empty" + From: Chip Salzenberg , Gurusamy Sarathy + , Ilya Zakharevich + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <19980606184942.A4583@perlsupport.com>, + <199806070029.UAA18709@monk.mps.ohio-state.edu>, + <199806071817.OAA28141@aatma.engin.umich.edu>, + <199806191549.QAA16376@toad.ig.co.uk> + Files: pp_hot.c + + ------ DOCUMENTATION ------ + + Title: "Discrepancy between perlop.pod and m// operator docs" + From: Tom Phoenix + Msg-ID: + Files: pod/perlop.pod + + Title: "Doc addition for perlfunc entry for system()" + From: Ilya Zakharevich , Mike Fletcher + + Msg-ID: <199806011908.PAA31069@dewdrop2.mindspring.com>, + <199806012057.QAA26830@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod + + Title: "Clarify effects of using quotes with m operator" + From: Daniel Grisinger + Msg-ID: + Files: pod/perlop.pod + + Title: "Document -i with STDIN" + From: joshua.pritikin@db.com + Msg-ID: + Files: pod/perlrun.pod + + ------ EXTENSIONS ------ + + Title: "Fix Liblist.pm to tolerate backslashen in paths" + From: Gurusamy Sarathy + Msg-ID: <199806011954.PAA10900@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + ------ LIBRARY ------ + + Title: "Typo fix for Math::BogFloat" + From: Mike Stok + Msg-ID: + Files: lib/Math/BigFloat.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Add docs about types of diff to Porting/patching.pod" + From: Gurusamy Sarathy + Msg-ID: <199806090105.VAA20005@aatma.engin.umich.edu> + Files: Porting/patching.pod + + Title: "Set dont_use_nlink for PowerMAX OS 4.2" + From: Tom Horsley + Msg-ID: <199806161354.NAA21316@cleo.ssd.hcsc.com> + Files: hints/powerux.sh + + Title: "Assorted improvements to hints/solaris_2.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/solaris_2.sh + Branch: maint-5.004/perl + ! Configure INSTALL Porting/patching.pod doio.c hints/powerux.sh + ! hints/solaris_2.sh lib/ExtUtils/Liblist.pm + ! lib/Math/BigFloat.pm op.c perl.h pod/perlfunc.pod + ! pod/perlop.pod pod/perlrun.pod pp_hot.c pp_sys.c scope.c + ! t/op/method.t +____________________________________________________________________________ +[ 1154] By: gsar on 1998/06/19 17:22:23 + Log: update repository copy of Asmdata.pm after `perl bytecode.pl` + Branch: perl + ! ext/B/B/Asmdata.pm regcomp.c +____________________________________________________________________________ +[ 1153] By: nick on 1998/06/19 17:21:21 + Log: Use libxxx.a for -lxxx with GCC + Branch: ansiperl + ! lib/ExtUtils/MM_Win32.pm win32/config.gc win32/config_H.gc + ! win32/makefile.mk +____________________________________________________________________________ +[ 1152] By: TimBunce on 1998/06/19 17:08:18 + Log: Title: Tom's jumbo doc patch + From: Tom Christiansen + Msg-Id: <199806140419.WAA20549@chthon.perl.com> + Files: pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod + pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod + pod/perlipc.pod pod/perllocale.pod pod/perllol.pod + pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod + pod/perlop.pod pod/perlre.pod pod/perlref.pod + pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod + pod/perlsyn.pod pod/perltie.pod pod/perltoot.pod + pod/perlvar.pod + Branch: maint-5.004/perl + ! pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + ! pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod + ! pod/perlipc.pod pod/perllocale.pod pod/perllol.pod + ! pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod + ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlsec.pod pod/perlsub.pod pod/perlsyn.pod + ! pod/perltie.pod pod/perltoot.pod pod/perlvar.pod +____________________________________________________________________________ +[ 1151] By: nick on 1998/06/19 15:38:28 + Log: Resolve latest + Branch: ansiperl + !> av.c embed.h embedvar.h ext/Socket/Socket.xs global.sym + !> hints/powerux.sh mg.c perl.h pod/perlsub.pod pp_ctl.c proto.h + !> sv.c t/TEST +____________________________________________________________________________ +[ 1150] By: gsar on 1998/06/18 20:43:07 + Log: Date: Tue, 16 Jun 1998 13:54:17 GMT + Message-Id: <199806161354.NAA21316@cleo.ssd.hcsc.com> + From: Tom Horsley + Subject: [PATCH] perl5.004 hints file (maint and dev paths) + Branch: perl + ! hints/powerux.sh +____________________________________________________________________________ +[ 1149] By: gsar on 1998/06/18 20:41:30 + Log: hand apply whitespace-mutiliated patch + From: joshua.pritikin@db.com + Date: Mon, 15 Jun 1998 09:21:36 -0400 + Message-Id: + Subject: [PATCH 5.004_67] SvREADONLY for av_clear + Branch: perl + ! av.c +____________________________________________________________________________ +[ 1148] By: gsar on 1998/06/18 20:33:59 + Log: hand apply whitespace-mutiliated and reversed patch + Date: Tue, 16 Jun 1998 16:31:40 -0400 + From: Les Peters + Message-Id: <199806162031.QAA08202@ds9> + Subject: [PATCH 5.004_67] Socket.xs tweak for IRIX 6.3 + Branch: perl + ! ext/Socket/Socket.xs +____________________________________________________________________________ +[ 1147] By: gsar on 1998/06/18 20:26:59 + Log: close child pipe in t/TEST, other cosmetic tweaks + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 1146] By: gsar on 1998/06/18 19:37:41 + Log: back out problematic change#1105, tweak perlsub.pod + Branch: perl + ! embed.h embedvar.h global.sym mg.c perl.h pod/perlsub.pod + ! pp_ctl.c proto.h sv.c +____________________________________________________________________________ +[ 1145] By: nick on 1998/06/18 19:31:07 + Log: Integrate and resolve -at mainline to ansiperl prior to Ming32 hacking + Branch: ansiperl + +> configure.com ext/DB_File/dbinfo + +> ext/DynaLoader/DynaLoader_pm.PL t/base/rs.t + +> t/op/regexp_noamp.t vms/descrip_mms.template vms/munchconfig.c + +> vms/subconfigure.com + - ext/DynaLoader/DynaLoader.pm.PL vms/config.vms vms/descrip.mms + - vms/fndvers.com + !> (integrate 499 files) +____________________________________________________________________________ +[ 1144] By: gsar on 1998/06/18 16:35:11 + Log: fix spurious cxstack_max init that trampled memory + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 1143] By: gsar on 1998/06/18 16:33:01 + Log: fix memory leaks and uninitialized memory accesses found by Purify + Branch: perl + ! doio.c perl.c regexec.c sv.c +____________________________________________________________________________ +[ 1142] By: gsar on 1998/06/18 16:28:48 + Log: fix off-by-one that trampled memory in re_croak2() + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 1141] By: gsar on 1998/06/18 16:26:59 + Log: fix AutoLoader to do the right thing when there are relative paths + in @INC + Branch: perl + ! lib/AutoLoader.pm +____________________________________________________________________________ +[ 1140] By: gsar on 1998/06/18 16:22:47 + Log: fix Makefile.SH typo + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1139] By: gsar on 1998/06/17 18:06:16 + Log: 5.004_67 niggles + Branch: perl + ! Makefile.SH op.c + +---------------- +Version 5.004_67 +---------------- + +____________________________________________________________________________ +[ 1138] By: gsar on 1998/06/15 10:09:27 + Log: up patchlevel.h to 67, other small tweaks + Branch: perl + ! patchlevel.h pod/perlhist.pod pod/perltoc.pod vms/perly_c.vms + ! win32/Makefile win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1137] By: gsar on 1998/06/15 09:08:57 + Log: tweaks to get PERL_OBJECT building again; passes tests + Branch: perl + ! ObjXSub.h objpp.h proto.h +____________________________________________________________________________ +[ 1136] By: gsar on 1998/06/15 08:51:54 + Log: back out previous change (it breaks PERL_OBJECT) + Branch: perl + ! ObjXSub.h cc_runtime.h embed.h embedvar.h global.sym + ! interp.sym intrpvar.h objpp.h perl.c perl.h pod/perldiag.pod + ! pod/perlguts.pod pp_ctl.c proto.h scope.c scope.h util.c +____________________________________________________________________________ +[ 1135] By: gsar on 1998/06/15 05:32:01 + Log: added patch, fixed typo, reworked documentation + Message-Id: + Date: Sun, 14 Jun 1998 14:03:15 EDT + From: joshua.pritikin@db.com + Subject: [PATCH 5.004_66] JMPENV! + Branch: perl + ! ObjXSub.h cc_runtime.h embed.h embedvar.h global.sym + ! interp.sym intrpvar.h objpp.h perl.c perl.h pod/perldiag.pod + ! pod/perlguts.pod pp_ctl.c proto.h scope.c scope.h util.c +____________________________________________________________________________ +[ 1134] By: gsar on 1998/06/15 04:07:18 + Log: various win32 odds and ends + - added support for waitpid(), open2/open3, and a bugfix for kill() + from Ronald Schmidt + - tweak testsuite mods of above + - regenerate win32/config_H.?c + - change kill() to win32_kill() and export it + - coalesce common code in win32.c + - add PerlProc_waitpid() and export win32_waitpid() + result builds and passes on the three win32 compilers + Branch: perl + ! ipproc.h lib/IPC/Open3.pm perlproc.h t/lib/open2.t + ! t/lib/open3.t util.c win32/config.bc win32/config.gc + ! win32/config.vc win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makedef.pl win32/runperl.c + ! win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 1133] By: gsar on 1998/06/15 01:39:13 + Log: newer Getopt/Long.pm from public distribution cited in: + Message-Id: + Date: 14 Jun 1998 15:15:28 +0200 + From: Johan Vromans + Subject: Getopt::Long version 2.17 released + Branch: perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 1132] By: gsar on 1998/06/15 01:37:12 + Log: documentation update from tchrist + Message-Id: <199806140419.WAA20549@chthon.perl.com> + Date: Sat, 13 Jun 1998 22:19:32 MDT + From: Tom Christiansen + Subject: doc patches + Branch: perl + ! pod/perl.pod pod/perlbook.pod pod/perldata.pod pod/perldsc.pod + ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod + ! pod/perlfaq9.pod pod/perlform.pod pod/perlfunc.pod + ! pod/perlipc.pod pod/perllocale.pod pod/perllol.pod + ! pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod + ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlsec.pod pod/perlsub.pod pod/perlsyn.pod + ! pod/perltie.pod pod/perltoot.pod pod/perlvar.pod +____________________________________________________________________________ +[ 1131] By: gsar on 1998/06/14 19:33:36 + Log: Message-ID: + From: Roderick Schertler + Subject: [PATCH] Re: Exceptions in IPC::Open2 + Date: 12 Jun 1998 13:24:15 -0400 + Branch: perl + ! lib/IPC/Open3.pm +____________________________________________________________________________ +[ 1130] By: gsar on 1998/06/14 19:32:25 + Log: fixup MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 1129] By: gsar on 1998/06/14 18:51:53 + Log: various win32 fixes + - fixes that silence VC noises about dup exports, non-default libs, and + unsupported *.def file directives + - s/inplace/inplace_label/ malloc.c + - update Config{usemymalloc} based on d_mymalloc + - export Perl_*Vars + - fix makefiles to not build miniperl.exe twice, and to make it properly + when defaults are changed + Branch: perl + ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/Mksymlists.pm malloc.c + ! win32/Makefile win32/config_sh.PL win32/makedef.pl + ! win32/makefile.mk win32/perllib.c win32/win32.h +____________________________________________________________________________ +[ 1128] By: gsar on 1998/06/14 01:38:39 + Log: remove unused global `scrgv' + Branch: perl + ! ObjXSub.h cygwin32/cw32imp.h embedvar.h perlvars.h +____________________________________________________________________________ +[ 1127] By: nick on 1998/06/13 08:39:07 + Log: Move specialsv_list to embed.sym, regen embed*.h + Branch: win32/perl + ! embed.h embedvar.h global.sym interp.sym +____________________________________________________________________________ +[ 1126] By: gsar on 1998/06/12 07:23:06 + Log: From: jan.dubois@ibm.net (Jan Dubois) + Subject: Re: execv in toke.c [PATCH]: win32 wrapper for _66 + Date: Thu, 11 Jun 1998 21:13:31 +0200 + Message-ID: <35842ac5.7883075@smtp1.ibm.net> + Branch: perl + ! win32/makedef.pl win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 1125] By: gsar on 1998/06/12 07:21:29 + Log: added patch, undo earlier workaround + From: jan.dubois@ibm.net (Jan Dubois) + Subject: Re: Why does saferealloc(NULL,size) croak? [PATCH] against _66 + Date: Thu, 11 Jun 1998 20:28:36 +0200 + Message-ID: <35831f69.4975644@smtp1.ibm.net> + Branch: perl + ! perl.c util.c +____________________________________________________________________________ +[ 1124] By: gsar on 1998/06/12 07:16:12 + Log: hand-applied patch with wrapped lines + From: "Douglas Lankshear" + Subject: [PATCH 5.004_66] Win32::Reg... bloat in Win32 + Date: Thu, 11 Jun 1998 11:06:33 -0700 + Message-ID: <000101bd9563$aae0c4c0$a32fa8c0@tau.Active> + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 1123] By: gsar on 1998/06/12 07:07:25 + Log: Date: Thu, 11 Jun 1998 12:40:05 -0400 (EDT) + From: Andy Dougherty + Subject: [PATCH 5.004_66] Config_66-01-02.diff + Message-Id: + Branch: perl + ! Configure +____________________________________________________________________________ +[ 1122] By: gsar on 1998/06/12 07:06:02 + Log: Message-Id: + Date: Thu, 11 Jun 1998 12:27:15 -0400 (EDT) + From: Andy Dougherty + Subject: Re: [PATCH for _66] Makefile.SH problem on dos/djgpp + Branch: perl + ! pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL + ! pod/pod2man.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL + ! utils/perlbug.PL utils/perlcc.PL utils/perldoc.PL + ! utils/pl2pm.PL utils/splain.PL x2p/find2perl.PL x2p/s2p.PL +____________________________________________________________________________ +[ 1121] By: gsar on 1998/06/12 07:01:20 + Log: a tweaked version of: + Message-Id: + Date: Fri, 12 Jun 1998 01:26:53 +0200 + From: Hugo van der Sanden + Subject: Re: Misparsing s///x + Branch: perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 1120] By: gsar on 1998/06/12 06:51:08 + Log: applied patch, with indentation tweaks + From: Ilya Zakharevich + Message-Id: <199806110803.EAA09149@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_66] Remove REG_ALIGN junk + Date: Thu, 11 Jun 1998 04:03:58 -0400 (EDT) + Branch: perl + ! regcomp.c regcomp.h regexec.c +____________________________________________________________________________ +[ 1119] By: gsar on 1998/06/11 17:42:07 + Log: make REG_INFTY default to something saner when sizeof(short) > 2 + Message-Id: + Date: Thu, 11 Jun 1998 11:50:07 EDT + From: Andy Dougherty + Subject: Re: [PATCH for tests] Regexp fails on long string + Branch: perl + ! regcomp.h +____________________________________________________________________________ +[ 1118] By: gsar on 1998/06/11 07:09:06 + Log: regen embedvar.h + Branch: perl + ! embedvar.h +____________________________________________________________________________ +[ 1117] By: gsar on 1998/06/11 06:45:52 + Log: From: Ilya Zakharevich + Message-Id: <199806100751.DAA05441@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_66] Bugs with (?{}), $^R and many-to-many subst + Date: Wed, 10 Jun 1998 03:51:47 -0400 (EDT) + Branch: perl + ! interp.sym intrpvar.h op.c op.h perl.c regcomp.c regcomp.h + ! regexec.c regexp.h t/op/pat.t t/op/subst.t +____________________________________________________________________________ +[ 1116] By: gsar on 1998/06/11 06:35:54 + Log: misc win32 fixes + From: "Douglas Lankshear" + Subject: [PATCH 5.004_66] + Date: Wed, 10 Jun 1998 11:28:27 -0700 + Message-ID: <001a01bd949d$8fd18050$a32fa8c0@tau.Active> + Branch: perl + ! ObjXSub.h perl.c win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1115] By: gsar on 1998/06/11 06:33:21 + Log: Message-ID: <19980610005325.D162@cdata.tvnet.hu> + Date: Wed, 10 Jun 1998 00:53:25 +0200 + From: Laszlo Molnar + Subject: [PATCH for _66] Makefile.SH problem on dos/djgpp + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 1114] By: gsar on 1998/06/11 06:31:34 + Log: back out change#1111 and add alternative patch: + From: Ilya Zakharevich + Message-Id: <199806101538.LAA07293@monk.mps.ohio-state.edu> + Subject: Re: PATCH for study/foo/ + Date: Wed, 10 Jun 1998 11:38:58 -0400 (EDT) + Branch: perl + ! pp.c sv.c +____________________________________________________________________________ +[ 1113] By: gsar on 1998/06/11 02:59:23 + Log: fix outdated bytecode.pl + Branch: perl + ! bytecode.h bytecode.pl byterun.c byterun.h +____________________________________________________________________________ +[ 1112] By: gsar on 1998/06/10 07:56:06 + Log: Added patch, regenerated perly.c and perly.c.diff + Message-Id: + Date: Sun, 31 May 1998 12:56:14 -0500 (CDT) + From: Stephen McCamant + Subject: [PATCH] too many RV2GVs in *foo{THING} + Branch: perl + ! perly.c perly.c.diff perly.y t/op/gv.t +____________________________________________________________________________ +[ 1111] By: gsar on 1998/06/10 07:40:30 + Log: From: Ilya Zakharevich + Message-Id: <199806100309.XAA04974@monk.mps.ohio-state.edu> + Subject: Re: PATCH for study/foo/ + Date: Tue, 9 Jun 1998 23:09:55 -0400 (EDT) + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 1110] By: gsar on 1998/06/10 07:37:04 + Log: From: Ilya Zakharevich + Message-Id: <199806100219.WAA04865@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_66] -DL and PERL_DEBUG_MSTATS unravelled + Date: Tue, 9 Jun 1998 22:19:02 -0400 (EDT) + Branch: perl + ! pod/perldebug.pod +____________________________________________________________________________ +[ 1109] By: gsar on 1998/06/10 07:35:29 + Log: From: Ilya Zakharevich + Message-Id: <199806100302.XAA04958@monk.mps.ohio-state.edu> + Subject: Re: [PATCH 5.004_66] REG_INFTY patch corrected + Date: Tue, 9 Jun 1998 23:02:52 -0400 (EDT) + Branch: perl + ! regcomp.h +____________________________________________________________________________ +[ 1108] By: gsar on 1998/06/10 07:31:25 + Log: Added patch, tweaked other places affected by name change + Message-ID: <19980610005417.G162@cdata.tvnet.hu> + Date: Wed, 10 Jun 1998 00:54:17 +0200 + From: Laszlo Molnar + Subject: [PATCH] file name DynaLoader.pm.PL is 8.3 unfriendly + Branch: perl + +> ext/DynaLoader/DynaLoader_pm.PL + - ext/DynaLoader/DynaLoader.pm.PL + ! MANIFEST ext/DynaLoader/Makefile.PL win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 1107] By: gsar on 1998/06/10 07:24:20 + Log: Message-ID: <19980610005342.E162@cdata.tvnet.hu> + Date: Wed, 10 Jun 1998 00:53:42 +0200 + From: Laszlo Molnar + Subject: [PATCH for _66] new version of README.dos + Branch: perl + ! README.dos +____________________________________________________________________________ +[ 1106] By: gsar on 1998/06/10 07:22:31 + Log: Message-ID: <19980610005404.F162@cdata.tvnet.hu> + Date: Wed, 10 Jun 1998 00:54:04 +0200 + From: Laszlo Molnar + Subject: [PATCH for _66] op/taint.t problem on dos/djgpp + Branch: perl + ! t/op/taint.t +____________________________________________________________________________ +[ 1105] By: gsar on 1998/06/10 07:21:21 + Log: Applied patch, followed by tweaks to *.sym and `perl embed.pl` + From: Ilya Zakharevich + Message-Id: <199806090216.WAA02041@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_66] Resend of RE cache patch (modified) + Date: Mon, 8 Jun 1998 22:16:56 -0400 (EDT) + Branch: perl + ! embed.h embedvar.h global.sym intrpvar.h mg.c perl.h + ! perlvars.h pp_ctl.c proto.h sv.c +____________________________________________________________________________ +[ 1104] By: gsar on 1998/06/10 07:06:01 + Log: From: Ilya Zakharevich + Message-Id: <199806090210.WAA02027@monk.mps.ohio-state.edu> + Subject: Lost chunk of RE jumbo patch + Date: Mon, 8 Jun 1998 22:10:52 -0400 (EDT) + Branch: perl + + t/op/regexp_noamp.t +____________________________________________________________________________ +[ 1103] By: gsar on 1998/06/10 07:04:20 + Log: From: Ilya Zakharevich + Message-Id: <199806090207.WAA02015@monk.mps.ohio-state.edu> + Subject: [PATCH 5.004_66] Combined OS/2 support + Date: Mon, 8 Jun 1998 22:07:48 -0400 (EDT) + Branch: perl + ! os2/Changes os2/diff.configure os2/os2.c +____________________________________________________________________________ +[ 1102] By: gsar on 1998/06/10 07:00:08 + Log: Message-Id: <199803140103.UAA04839@monk.mps.ohio-state.edu> + Date: Fri, 13 Mar 1998 20:03:52 EST + From: Ilya Zakharevich + Subject: [PATCH 5.004_62 5_004_04m1] pod2html again + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 1101] By: gsar on 1998/06/10 06:55:20 + Log: From: Ilya Zakharevich + Subject: Re: 5.004_65 uninitialized variable regexec.c (2) + Date: Thu, 28 May 1998 01:28:54 -0400 (EDT) + Branch: perl + ! regexec.c +____________________________________________________________________________ +[ 1100] By: gsar on 1998/06/10 06:52:50 + Log: updated MANIFEST for previous change + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 1099] By: gsar on 1998/06/10 06:51:08 + Log: Mangled patch, needed hand-tweaks, along with binmode for rs.t: + Message-Id: <3.0.5.32.19980605110840.009e12b0@ous.edu> + Date: Fri, 05 Jun 1998 11:08:40 -0700 + From: Dan Sugalski + Subject: Re: [PATCH 5.004_66]Add record read capability to <> + Branch: perl + + t/base/rs.t + ! perl.h pod/perlvar.pod sv.c +____________________________________________________________________________ +[ 1098] By: gsar on 1998/06/10 06:36:59 + Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Message-Id: <9806042022.AA10418@claudius.bfsec.bt.co.uk> + Subject: [PATCH fror 5.004_66] DB_File-1.60 + Date: Thu, 4 Jun 1998 21:22:35 +0100 (BST) + Branch: perl + + ext/DB_File/dbinfo + ! MANIFEST ext/DB_File/Changes ext/DB_File/DB_File.pm + ! ext/DB_File/DB_File.xs ext/DB_File/typemap t/lib/db-btree.t + ! t/lib/db-hash.t t/lib/db-recno.t +____________________________________________________________________________ +[ 1097] By: gsar on 1998/06/10 06:33:16 + Log: Message-ID: <19980604134731.D24343@perlsupport.com> + Date: Thu, 4 Jun 1998 13:47:31 -0400 + From: Chip Salzenberg + Subject: [PATCH] Invalidate method cache on C + Branch: perl + ! scope.c t/op/method.t +____________________________________________________________________________ +[ 1096] By: gsar on 1998/06/10 06:30:51 + Log: From: Norton Allen + Message-Id: <199806031908.PAA04183@bottesini.harvard.edu> + Subject: [PATCH] _66 MM_Unix.pm for QNX + Date: Wed, 3 Jun 1998 15:08:33 -0400 (edt) + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 1095] By: gsar on 1998/06/10 06:29:21 + Log: From: Norton Allen + Message-Id: <199806031909.PAA04358@bottesini.harvard.edu> + Subject: [PATCH] _66 proto.h + Date: Wed, 3 Jun 1998 15:09:14 -0400 (edt) + Branch: perl + ! proto.h +____________________________________________________________________________ +[ 1094] By: gsar on 1998/06/10 06:26:39 + Log: Applied relevant parts of: + From: Paul Johnson + Date: Wed, 3 Jun 1998 19:07:55 +0100 (BST) + Message-Id: <199806031807.TAA04100@west-tip.transeda.com> + Subject: [PATCH] Enhancing xsubpp's support for C++ + Branch: perl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 1093] By: gsar on 1998/06/10 06:22:54 + Log: Message-ID: <19980603112219.B7638@asic.sc.ti.com> + Date: Wed, 3 Jun 1998 11:22:19 -0500 + From: Graham Barr + Subject: [PATCH perl5.004_04-m4] fix for undef as last arg to setsockopt + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 1092] By: gsar on 1998/06/10 06:20:44 + Log: Message-Id: <199806030919.KAA03527@sale-wts> + Date: Wed, 3 Jun 1998 10:20:06 +0100 (BST) + From: Alan Burlison + Subject: [PATCH 5.004_66] ExtUtils::Installed.pm and ExtUtils::Packlist.pm + Branch: perl + ! lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm +____________________________________________________________________________ +[ 1091] By: gsar on 1998/06/10 06:18:42 + Log: Message-Id: <3.0.5.32.19980601122229.00a58420@ous.edu> + Date: Mon, 01 Jun 1998 12:22:29 -0700 + From: SYSTEM@cedar.osshe.edu (by way of Dan Sugalski ) + Subject: [PATCH 5.004_66] proto.h change to make byterun() visible to VMS + Branch: perl + ! proto.h +____________________________________________________________________________ +[ 1090] By: gsar on 1998/06/10 06:14:24 + Log: A tweaked version of: + Date: Mon, 1 Jun 1998 12:05:47 -0700 + From: SYSTEM@cedar.osshe.edu + Message-Id: <980601120547.20617d54@cedar.osshe.edu> + Subject: [PATCH 5.004_66] Fix problem with SDBM makefile on VMS + Branch: perl + ! ext/SDBM_File/sdbm/Makefile.PL +____________________________________________________________________________ +[ 1089] By: gsar on 1998/06/10 05:58:00 + Log: Message-Id: + Date: Fri, 29 May 1998 23:52:26 -0500 (CDT) + From: Stephen McCamant + Subject: [PATCH] Re: Uninitialised error from -M() + Branch: perl + ! op.c t/op/stat.t +____________________________________________________________________________ +[ 1088] By: gsar on 1998/06/10 05:55:24 + Log: Date: Sat, 30 May 1998 08:07:01 -0400 + From: lvirden@cas.org (Larry Virden) + Message-Id: <199805301207.IAA08856@cas.org> + Subject: PATCH for pod and warning notice + Branch: perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 1087] By: gsar on 1998/06/10 05:52:05 + Log: From: Andy Dougherty + Date: Mon, 8 Jun 1998 14:45:36 -0400 (EDT) + Message-Id: + Subject: [PATCH 5.004_66] Config_66-01 + Branch: perl + ! Configure MANIFEST Porting/Glossary Porting/config.sh + ! Porting/config_H config_h.SH +____________________________________________________________________________ +[ 1086] By: gsar on 1998/06/10 05:46:38 + Log: Message-Id: <3.0.5.32.19980608161314.00a0a880@ous.edu> + Date: Mon, 08 Jun 1998 16:13:14 -0700 + From: Dan Sugalski + Subject: [PATCH 5.004_66] Documentation patch for Semaphore.pm + Branch: perl + ! ext/Thread/Thread/Semaphore.pm +____________________________________________________________________________ +[ 1085] By: gsar on 1998/06/10 05:44:44 + Log: Message-Id: <3.0.5.32.19980608161002.00a64a70@ous.edu> + Date: Mon, 08 Jun 1998 16:10:02 -0700 + From: Dan Sugalski + Subject: [PATCH 5.004_66]Doc & feature patch for Thread::Queue + Branch: perl + - vms/descrip.mms + ! ext/Thread/Thread/Queue.pm +____________________________________________________________________________ +[ 1084] By: gsar on 1998/06/10 05:38:11 + Log: Message-Id: <3.0.5.32.19980608153828.00a81ea0@ous.edu> + Date: Mon, 08 Jun 1998 15:38:28 -0700 + From: Dan Sugalski + Subject: [PATCH POINTER 5.004_66]A configuration system for VMS perl + Branch: perl + + configure.com vms/descrip_mms.template vms/munchconfig.c + + vms/subconfigure.com + - vms/config.vms vms/fndvers.com + ! MANIFEST README.vms lib/ExtUtils/MM_VMS.pm +____________________________________________________________________________ +[ 1083] By: gsar on 1998/06/10 05:07:04 + Log: xsubpp enhancements ($CPAN/authors/id/ILYAZ/patches/diff_xsubpp_65), a + variant of: + Message-Id: <199712131231.HAA04125@monk.mps.ohio-state.edu> + Date: Sat, 13 Dec 1997 07:31:02 EST + From: Ilya Zakharevich + Subject: 5.004_55: xsubpp: new keywords INTERFACE C_ARGS + Branch: perl + ! XSUB.h lib/ExtUtils/xsubpp pod/perlxs.pod +____________________________________________________________________________ +[ 1082] By: gsar on 1998/06/10 04:52:26 + Log: add newer malloc.c from Ilya Zakharevich + (from $CPAN/authors/id/ILYAZ/patches/diff_malloc_65) + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 1081] By: gsar on 1998/06/10 03:45:10 + Log: reverse integrate contents of win32 branch into mainline + Branch: perl + !> (integrate 44 files) +____________________________________________________________________________ +[ 1080] By: gsar on 1998/06/09 17:37:55 + Log: `p4 integrate -b ASPerl && p4 resolve -at` + Branch: asperl + !> (integrate 43 files) +____________________________________________________________________________ +[ 1079] By: gsar on 1998/06/09 00:59:06 + Log: add examples of diff(1) usage + Branch: win32/perl + ! Porting/patching.pod +____________________________________________________________________________ +[ 1078] By: gsar on 1998/06/09 00:52:23 + Log: undo change#1077 + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 1077] By: gsar on 1998/06/06 16:47:32 + Log: make sv_setsv() treat freed SVs like SVt_NULL + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 1076] By: gsar on 1998/06/05 19:03:14 + Log: delete undiscussed AS changes for PPD (broke .packlist + mechanism) + Branch: win32/perl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 1075] By: gsar on 1998/06/05 18:18:44 + Log: add AS patch#26 (rename THIS to PERL_OBJEC_THIS to avoid clash + with the xsubpp-generated symbol) + Branch: win32/perl + ! ObjXSub.h perl.c perl.h pp_ctl.c pp_hot.c toke.c + ! win32/dl_win32.xs +____________________________________________________________________________ +[ 1074] By: gsar on 1998/06/04 22:45:18 + Log: add AS patch#25 (allow B build with -DPERL_OBJECT) + Branch: win32/perl + ! ObjXSub.h byterun.h embed.h embedvar.h ext/B/B.xs intrpvar.h + ! objpp.h proto.h util.c win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1073] By: nick on 1998/06/04 17:18:14 + Log: resolve -at win32 branch into ansiperl + Branch: ansiperl + +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h + +> ipsock.h ipstdio.h objpp.h t/lib/h2ph.h t/lib/h2ph.pht + +> t/lib/h2ph.t win32/GenCAPI.pl + !> (integrate 127 files) +____________________________________________________________________________ +[ 1072] By: gsar on 1998/06/04 01:49:24 + Log: document CORE::GLOBAL:: and global overriding, fix up + File::DosGlob, testsuited and all + Branch: win32/perl + ! lib/File/DosGlob.pm pod/perlsub.pod t/lib/dosglob.t +____________________________________________________________________________ +[ 1071] By: gsar on 1998/06/03 22:12:55 + Log: add AS patch#24, remove one other instance of error_no + that was missed (patch#23 was intentionally skipped) + Branch: win32/perl + ! embedvar.h globals.c perlvars.h win32/makedef.pl + ! win32/runperl.c +____________________________________________________________________________ +[ 1070] By: gsar on 1998/06/01 19:42:06 + Log: fix Liblist.pm to tolerate backslashen in paths + Branch: win32/perl + ! lib/ExtUtils/Liblist.pm +____________________________________________________________________________ +[ 1069] By: gsar on 1998/06/01 07:43:02 + Log: @INC construction on win32 cleaned up + - perl.dll location based paths should be much more reliable now + - registry stuff unchanged + - Config.pm now has all the installfoolib entries for MakeMaker et al + Branch: win32/perl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/config_sh.PL win32/makefile.mk + ! win32/runperl.c win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 1068] By: gsar on 1998/05/31 21:52:18 + Log: semctl tweak + Message-Id: <199805312127.QAA06750@gbarr.connect.net> + Date: Sun, 31 May 1998 16:27:33 CDT + From: Graham Barr + Subject: Not OK: perl 5.00466 on i586-linux-thread 2.0.31 + Branch: win32/perl + ! doio.c +____________________________________________________________________________ +[ 1067] By: gsar on 1998/05/31 21:07:44 + Log: minimal fix to enable compiling with -DMULTIPLICITY + (non-threadsafe regcomp.c globals need revisiting) + Branch: win32/perl + ! ObjXSub.h embedvar.h interp.sym intrpvar.h regcomp.c + ! win32/GenCAPI.pl win32/makedef.pl +____________________________________________________________________________ +[ 1066] By: gsar on 1998/05/30 21:35:37 + Log: integrate mainline changes (ASPerl branch is identical to + win32 branch as of this change) + Branch: asperl + !> MANIFEST Todo.5.005 embed.h ext/POSIX/POSIX.xs global.sym + !> lib/ExtUtils/Mksymlists.pm pod/perldelta.pod pp_sys.c + !> t/op/ipcmsg.t t/op/ipcsem.t win32/Makefile win32/config.bc + !> win32/config.gc win32/config.vc win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 1065] By: gsar on 1998/05/30 21:13:06 + Log: change#1060 was inexplicably missing some of the "ensure + AS stuff does no harm" fixes + Branch: win32/perl + ! embed.h global.sym win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1064] By: gsar on 1998/05/30 21:10:27 + Log: integrate mainline to pick up trivial changes + Branch: win32/perl + !> MANIFEST pp_sys.c + +---------------- +Version 5.004_66 +---------------- + +____________________________________________________________________________ +[ 1063] By: mbeattie on 1998/05/29 15:19:55 + Log: Remove duplicate win32/TEST line from MANIFEST. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 1062] By: mbeattie on 1998/05/29 15:18:33 + Log: Add missing ";" to pp_umask (spotted by Jarkko Hietaniemi). + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 1061] By: mbeattie on 1998/05/29 12:02:17 + Log: Integrate from win32 branch into mainline (this now pulls in the + asperl stuff). + Branch: perl + +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h + +> ipsock.h ipstdio.h objpp.h t/lib/h2ph.h t/lib/h2ph.pht + +> t/lib/h2ph.t win32/GenCAPI.pl + !> (integrate 104 files) +____________________________________________________________________________ +[ 1060] By: gsar on 1998/05/29 11:05:50 + Log: reverse integrate asperl branch contents (phew!) + - various fixups to ensure AS stuff does no harm + - adjust win32/makefiles for the new directory layout (new layout + looks rather a muddle--needs rework) + - verified build & test on NT and Solaris/gcc + Branch: win32/perl + +> ObjXSub.h XSLock.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h + +> ipsock.h ipstdio.h objpp.h win32/GenCAPI.pl + ! ext/POSIX/POSIX.xs lib/ExtUtils/Mksymlists.pm win32/Makefile + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk + !> (integrate 77 files) +____________________________________________________________________________ +[ 1059] By: gsar on 1998/05/29 08:33:56 + Log: asperl branch verified to build w/o PERL_OBJECT on Solaris and NT + Branch: asperl + ! util.c +____________________________________________________________________________ +[ 1058] By: gsar on 1998/05/29 08:31:09 + Log: type xtext for *.t that were missing it + Branch: asperl + ! t/lib/thread.t t/op/nothread.t +____________________________________________________________________________ +[ 1057] By: gsar on 1998/05/29 08:28:46 + Log: stray t/op/ipc*.t fixups + Branch: win32/perl + ! t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 1056] By: gsar on 1998/05/29 07:41:49 + Log: fixups to make it build and pass tests under both compilers + Branch: asperl + ! ObjXSub.h objpp.h proto.h +____________________________________________________________________________ +[ 1055] By: gsar on 1998/05/29 07:22:51 + Log: integrate mainline changes + Branch: asperl + +> t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t + !> (integrate 69 files) + Branch: win32/perl + ! Todo.5.005 pod/perldelta.pod +____________________________________________________________________________ +[ 1054] By: gsar on 1998/05/29 05:04:03 + Log: add a txt_compare() routine to t/h2ph.t for DOSISH sanity + Branch: win32/perl + ! t/lib/h2ph.t +____________________________________________________________________________ +[ 1053] By: gsar on 1998/05/29 05:01:54 + Log: misc changes + - remove code that works around lack of I_STDARG (we're a happy ANSI family) + - leave dump_foo() stubs when not -DDEBUGGING for consistent symbol exports + Branch: win32/perl + ! deb.c dump.c ext/DynaLoader/dlutils.c ext/POSIX/POSIX.xs + ! perl.h perlio.c proto.h regcomp.c run.c scope.c sv.c util.c + ! x2p/util.c x2p/util.h +____________________________________________________________________________ +[ 1052] By: gsar on 1998/05/29 02:31:44 + Log: merge changes#1014,1038 from maintbranch + Branch: win32/perl + + t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t + ! MANIFEST Makefile.SH doio.c ext/POSIX/POSIX.xs gv.c + ! lib/Benchmark.pm lib/ExtUtils/MM_Unix.pm pod/perldebug.pod + ! pod/perldiag.pod pod/perlfunc.pod pod/perlop.pod + ! pod/perlre.pod pod/perltie.pod pod/perltrap.pod sv.c + ! t/io/pipe.t utils/h2ph.PL +____________________________________________________________________________ +[ 1051] By: gsar on 1998/05/29 01:38:51 + Log: regenerate win32/config_H.?c + Branch: win32/perl + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 1050] By: gsar on 1998/05/29 01:32:41 + Log: integrate mainline + Branch: win32/perl + ! win32/Makefile win32/makefile.mk + !> Configure INSTALL MANIFEST Porting/Glossary Porting/config.sh + !> Porting/config_H Porting/patching.pod config_h.SH doio.c + !> ext/POSIX/hints/sunos_4.pl hints/bsdos.sh hints/openbsd.sh + !> hints/solaris_2.sh hints/sunos_4_1.sh hints/svr4.sh + !> lib/FileHandle.pm patchlevel.h perl.h plan9/config.plan9 + !> vms/config.vms win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1049] By: gsar on 1998/05/29 00:57:05 + Log: fix various shenanigans with C, BC and VC builds now pass + all tests + Branch: asperl + ! globals.c win32/Makefile win32/makefile.mk win32/runperl.c + ! win32/win32.h win32/win32iop.h +____________________________________________________________________________ +[ 1048] By: mbeattie on 1998/05/28 18:07:24 + Log: Integrated win32 branch into mainline. The changes to t/op/ipc*.t + in change 1043 clashed badly with changes made in the win32 + branch. I did an accept on the win32 branch version for now. + Branch: perl + +> t/op/die.t + !> (integrate 52 files) +____________________________________________________________________________ +[ 1047] By: mbeattie on 1998/05/28 17:59:18 + Log: From: Andy Dougherty + Subject: [PATCH 5.004_65] Config_65-02-03.diff: SunOS and Solaris hints + Date: Thu, 28 May 1998 13:27:25 -0400 (EDT) + Subject: [PATCH 5.004_65] Config_65-03-04.diff: semctl probing + Date: Thu, 28 May 1998 13:28:21 -0400 (EDT) + Branch: perl + ! Configure MANIFEST Porting/Glossary Porting/config.sh + ! Porting/config_H config_h.SH doio.c ext/POSIX/hints/sunos_4.pl + ! hints/solaris_2.sh hints/sunos_4_1.sh perl.h vms/config.vms + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1046] By: mbeattie on 1998/05/28 17:55:48 + Log: Back out change 1043 since Andy's forthcoming Config patch + includes a modified version. + Branch: perl + ! Configure config_h.SH doio.c perl.h +____________________________________________________________________________ +[ 1045] By: mbeattie on 1998/05/28 17:52:40 + Log: Bump patchlevel.h to 66. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 1044] By: mbeattie on 1998/05/28 17:51:49 + Log: From: Daniel Grisinger + Subject: [PATCH] _04m2 perlfunc.pod (fwd) + Date: Fri, 15 May 1998 16:18:26 -0600 (MDT) + (above minus the t/system.t test pending checking) + Subject: [PATCH] 5.004[04|65] FileHandle.pm + Date: Wed, 20 May 1998 19:50:50 -0600 (MDT) + Subject: [PATCH] _65 and _04 patching.pod + Date: Thu, 21 May 1998 16:33:03 -0600 (MDT) + Branch: perl + ! Porting/patching.pod lib/FileHandle.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 1043] By: mbeattie on 1998/05/28 17:42:21 + Log: This change really is: + Subject: [PATCH] 5.004_65: the infamous semctl() + Date: Sun, 24 May 1998 16:13:21 +0300 (EET DST) + From: Jarkko Hietaniemi + + Change 1041 claimed to be this patch but was really: + Subject: [PATCH] 5.004_65: t/op/ipc*.t + Date: Sat, 16 May 1998 00:52:39 +0300 (EET DST) + From: Jarkko Hietaniemi + Branch: perl + ! Configure config_h.SH doio.c perl.h +____________________________________________________________________________ +[ 1042] By: mbeattie on 1998/05/28 17:36:57 + Log: From: Andy Dougherty + Subject: [PATCH 5.004_65] Config_65-01: lchown() detection. + Date: Thu, 28 May 1998 13:25:21 -0400 (EDT) + Subject: [PATCH 5.004_65] Config_65-01-02.diff: INSTALL and hints fixes + Date: Thu, 28 May 1998 13:26:18 -0400 (EDT) + Branch: perl + ! Configure INSTALL Porting/Glossary Porting/config.sh + ! Porting/config_H config_h.SH doio.c hints/bsdos.sh + ! hints/openbsd.sh hints/svr4.sh plan9/config.plan9 + ! vms/config.vms win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 1041] By: mbeattie on 1998/05/28 17:34:26 + Log: Subject: [PATCH] 5.004_65: the infamous semctl() + Date: Sun, 24 May 1998 16:13:21 +0300 (EET DST) + From: Jarkko Hietaniemi + Branch: perl + ! t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 1040] By: gsar on 1998/05/28 02:06:47 + Log: tweaks to enable Borland build + Branch: asperl + ! win32/makefile.mk win32/win32.c +____________________________________________________________________________ +[ 1039] By: gsar on 1998/05/27 23:29:22 + Log: remove C<#define index strchr> from win32.h (unused, and the + pollution causes spurious variable name changes in extensions) + Branch: win32/perl + ! win32/win32.h +____________________________________________________________________________ +[ 1038] By: TimBunce on 1998/05/27 17:29:15 + Log: Assorted patches: + + ------ BUILD PROCESS ------ + + Title: "add utilities to make test dependencies" + From: Robin Barker + Msg-ID: <2607.9805211303@tempest.cise.npl.co.uk> + Files: Makefile.SH + + Title: "Add 'make nok' complement to 'make ok'" + From: "M.J.T. Guy" + Msg-ID: + Files: Makefile.SH + + Title: "further h2ph patches (add enum support)" + From: Billy + Msg-ID: + Files: MANIFEST t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL + + ------ CORE LANGUAGE ------ + + Title: "Fix %! error spelling and add perldiag.pod entry" + From: Graham Barr , Tim Bunce + Msg-ID: <19980524193101.A573@pobox.com> + Files: pod/perldiag.pod gv.c + + Title: "Remove obsolete Win32 uppercasing ENV code" + From: Gurusamy Sarathy + Msg-ID: <199805201510.LAA28676@aatma.engin.umich.edu> + Files: perl.c + + Title: "Don't mung $! on implicit close" + From: Chip Salzenberg + Msg-ID: <19980525113309.A15845@perlsupport.com> + Files: doio.c + + Title: "Maint trial 3 fails on SunOS 4.1.3 with Sun cc" + From: Andy Dougherty + Msg-ID: + Files: doio.c + + ------ DOCUMENTATION ------ + + Title: "doc patch: you canna return an array ( list context: || vs or)" + From: Jarkko Hietaniemi + Msg-ID: + Files: pod/perldebug.pod pod/perlfunc.pod pod/perltie.pod pod/perltrap.pod + + Title: "doc patch: @ needs escaping in m/\Q\E/ environment" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlop.pod pod/perlre.pod + + Title: "Discrepancy between perlop.pod and m// operator", "Doc fix: Only + with /g does list context get matches without parens" + From: Greg Chapman , Tom Christiansen + , Tom Phoenix + + Msg-ID: <000201bd865e$f3bf72e0$1f04400c@assigned.well.com>, + <199805231559.JAA21316@jhereg.perl.com>, + + Files: pod/perlop.pod + + Title: "Documenting last/next/redo even further" + From: "M.J.T. Guy" , Tom Phoenix + + Msg-ID: , + + Files: pod/perlfunc.pod + + Title: "Documenting last/next/redo within continue block" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: "Document stat return in scalar context" + From: Mark-Jason Dominus + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "Better LD_RUN_PATH handling on IRIX" + From: "W. Phillip Moore" + Msg-ID: <199805212206.SAA07504@zappa.morgan.com> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Dealing with in POSIX and SunOS" + From: Andy Dougherty + Msg-ID: + Files: ext/POSIX/hints/sunos_4.pl hints/sunos_4_1.sh ext/POSIX/POSIX.xs + + ------ LIBRARY ------ + + Title: "Fix FileHandle.pm example bug" + From: Daniel Grisinger + Msg-ID: + Files: lib/FileHandle.pm + + Title: "Add zero/negative $count docs for Benchmark.pm" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Benchmark.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Add test suite recommendations to Porting/patching.pod" + From: Daniel Grisinger + Msg-ID: + Files: Porting/patching.pod + + ------ TESTS ------ + + Title: "Fix looping bug in t/io/pipe.t" + From: "M.J.T. Guy" + Msg-ID: + Files: t/io/pipe.t + Branch: maint-5.004/perl + ! MANIFEST Makefile.SH Porting/patching.pod doio.c + ! ext/POSIX/POSIX.xs ext/POSIX/hints/sunos_4.pl gv.c + ! hints/sunos_4_1.sh lib/Benchmark.pm lib/ExtUtils/MM_Unix.pm + ! lib/FileHandle.pm perl.c pod/perldebug.pod pod/perldiag.pod + ! pod/perlfunc.pod pod/perlop.pod pod/perlre.pod pod/perltie.pod + ! pod/perltrap.pod t/io/pipe.t t/lib/h2ph.pht t/lib/h2ph.t + ! utils/h2ph.PL +____________________________________________________________________________ +[ 1037] By: gsar on 1998/05/27 16:18:30 + Log: add AS patch#22 (fix to make die_exit.t pass) + Branch: asperl + ! win32/runperl.c +____________________________________________________________________________ +[ 1036] By: gsar on 1998/05/27 12:50:34 + Log: add AS patch#21 (misc. fixes) + Branch: asperl + ! ObjXSub.h lib/ExtUtils/MM_Unix.pm objpp.h perl.h + ! win32/GenCAPI.pl win32/Makefile win32/makefile.mk + ! win32/win32.c win32/win32sck.c +____________________________________________________________________________ +[ 1035] By: gsar on 1998/05/26 17:26:17 + Log: more changes to satisfy non-debug VC build (C-API doesn't + build, and the testsuite still won't run) + Branch: asperl + ! ObjXSub.h deb.c dump.c ext/POSIX/POSIX.xs globals.c proto.h + ! regcomp.c run.c scope.c sv.c util.c win32/GenCAPI.pl +____________________________________________________________________________ +[ 1034] By: gsar on 1998/05/26 17:20:22 + Log: remove doubled hunk (perforce auto-integrate oddity) + Branch: win32/perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 1033] By: gsar on 1998/05/26 13:39:14 + Log: tweaks to make it build with the Borland compiler. Won't run + testsuite because @INC intuition from location of perlcore.dll seems + to be broken. Also, system() and qx// seem broken as well. + Branch: asperl + ! ObjXSub.h doio.c embedvar.h ext/POSIX/POSIX.xs interp.sym + ! intrpvar.h objpp.h perl.c perl.h perlvars.h proto.h regcomp.c + ! regexec.c toke.c +____________________________________________________________________________ +[ 1032] By: gsar on 1998/05/24 23:13:05 + Log: tweak Benchmark.pm to restore old timestr() behavior--show wall secs + Branch: win32/perl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 1031] By: gsar on 1998/05/24 05:36:44 + Log: tweak makefiles + Branch: asperl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 1030] By: gsar on 1998/05/23 18:58:23 + Log: merge changes#1016,1018 from maintbranch (1017 is n/a) + Branch: win32/perl + ! pp_sys.c t/op/die.t +____________________________________________________________________________ +[ 1029] By: gsar on 1998/05/23 18:55:13 + Log: merge change#1015 from maintbranch (must revisit 1014 later, is + incomplete) + Branch: win32/perl + ! embed.h global.sym op.c pp.c proto.h sv.c +____________________________________________________________________________ +[ 1028] By: gsar on 1998/05/23 18:25:14 + Log: merge change#1013 from maintbranch (1012 is n/a) + Branch: win32/perl + ! toke.c +____________________________________________________________________________ +[ 1027] By: gsar on 1998/05/23 18:02:21 + Log: merge change#1011 from maintbranch + Branch: win32/perl + ! perl.c pod/perldiag.pod pod/perlfunc.pod pp_ctl.c + ! utils/perlbug.PL +____________________________________________________________________________ +[ 1026] By: nick on 1998/05/23 08:45:04 + Log: Ids of msgs and sems can be zero, so change || die to a defined() test + Branch: win32/perl + ! t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 1025] By: nick on 1998/05/23 08:36:36 + Log: Resolve win32 into ansiperl + Branch: ansiperl + +> t/op/die.t + !> (integrate 42 files) +____________________________________________________________________________ +[ 1024] By: gsar on 1998/05/21 21:11:12 + Log: more mingw32 tweaks + Branch: win32/perl + ! ext/POSIX/POSIX.xs t/pragma/locale.t +____________________________________________________________________________ +[ 1023] By: gsar on 1998/05/21 19:15:02 + Log: fix problematic change#965 from maintbranch + Message-Id: <199805162145.RAA02552@monk.mps.ohio-state.edu> + Date: Sat, 16 May 1998 17:45:22 EDT + From: Ilya Zakharevich + Subject: Re: Not OK (after all) : perl 5.00404 +MAINT_TRIAL_3 on sun4-solaris 2.5 + Branch: win32/perl + ! gv.c op.c t/comp/proto.t +____________________________________________________________________________ +[ 1022] By: gsar on 1998/05/21 01:37:04 + Log: fix POSIX for mingw32 + Branch: win32/perl + ! ext/POSIX/POSIX.xs win32/config.gc win32/config_H.gc +____________________________________________________________________________ +[ 1021] By: gsar on 1998/05/20 15:02:21 + Log: remove strupr() from perl.c + Branch: win32/perl + ! perl.c +____________________________________________________________________________ +[ 1020] By: TimBunce on 1998/05/19 22:41:40 + Log: Title: "fix up descrepancy in h2ph test" + From: Tim Bunce + Files: t/lib/h2ph.pht + Branch: maint-5.004/perl + ! t/lib/h2ph.pht +____________________________________________________________________________ +[ 1019] By: TimBunce on 1998/05/19 22:17:15 + Log: Title: "add a test to check return value from successful s/// (there was none!)" + From: Gurusamy Sarathy + Msg-ID: <199805161759.NAA12995@aatma.engin.umich.edu> + Files: t/op/subst.t + + Title: "fix up descrepancy in h2ph test" + From: Tim Bunce + Files: t/lib/h2ph.t + Branch: maint-5.004/perl + ! t/lib/h2ph.t t/op/subst.t +____________________________________________________________________________ +[ 1018] By: TimBunce on 1998/05/19 21:56:32 + Log: Title: "fix mem leak and core dump from change 1016" + From: Tim Bunce + Files: pp_sys.c + Branch: maint-5.004/perl + ! pp_sys.c +____________________________________________________________________________ +[ 1017] By: TimBunce on 1998/05/19 21:26:03 + Log: Title: "qsort, Win32 "POSIX" plus other devel changes for patch-compatibility" + From: Gurusamy Sarathy + Files: MANIFEST cflags.SH pod/perlembed.pod pod/perlfunc.pod + pod/perlguts.pod pod/perlref.pod pod/perlrun.pod + pod/perlxstut.pod av.h embed.h hv.h op.h perl.h pp.h + proto.h Todo av.c cygwin32/perlgcc cygwin32/perlld deb.c + doio.c doop.c ext/ODBM_File/ODBM_File.xs + ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + gv.c hv.c interp.sym lib/AutoSplit.pm lib/Cwd.pm + lib/FindBin.pm lib/strict.pm lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Manifest.pm lib/File/Basename.pm + lib/File/Find.pm lib/File/Path.pm lib/Getopt/Long.pm + lib/Getopt/Std.pm lib/Net/Ping.pm lib/Pod/Html.pm + lib/Pod/Text.pm lib/Term/Cap.pm lib/Test/Harness.pm mg.c + op.c perl.c pod/pod2latex.PL pod/pod2man.PL pp.c pp_ctl.c + pp_hot.c pp_sys.c scope.c sv.c t/lib/posix.t + t/pragma/locale.t utils/perldoc.PL win32/win32.h toke.c + universal.c util.c win32/Makefile win32/config_H.bc + win32/config_H.vc win32/dl_win32.xs win32/makedef.pl + win32/makefile.mk win32/perlglob.c win32/runperl.c + win32/win32.c win32/win32sck.c x2p/s2p.PL + Branch: maint-5.004/perl + ! MANIFEST Todo av.c av.h cflags.SH cygwin32/perlgcc + ! cygwin32/perlld deb.c doio.c doop.c embed.h + ! ext/ODBM_File/ODBM_File.xs ext/POSIX/Makefile.PL + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs gv.c hv.c hv.h + ! interp.sym lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/Command.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/Manifest.pm lib/File/Basename.pm lib/File/Find.pm + ! lib/File/Path.pm lib/FindBin.pm lib/Getopt/Long.pm + ! lib/Getopt/Std.pm lib/Net/Ping.pm lib/Pod/Html.pm + ! lib/Pod/Text.pm lib/Term/Cap.pm lib/Test/Harness.pm + ! lib/strict.pm mg.c op.c op.h perl.c perl.h pod/perlembed.pod + ! pod/perlfunc.pod pod/perlguts.pod pod/perlref.pod + ! pod/perlrun.pod pod/perlxstut.pod pod/pod2latex.PL + ! pod/pod2man.PL pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h + ! scope.c sv.c t/lib/posix.t t/pragma/locale.t toke.c + ! universal.c util.c utils/perldoc.PL win32/Makefile + ! win32/config_H.bc win32/config_H.vc win32/dl_win32.xs + ! win32/makedef.pl win32/makefile.mk win32/perlglob.c + ! win32/runperl.c win32/win32.c win32/win32.h win32/win32sck.c + ! x2p/s2p.PL +____________________________________________________________________________ +[ 1016] By: TimBunce on 1998/05/19 20:37:42 + Log: Title: "eval { die $obj }; die; calls $obj->PROPAGATE" + From: Graham Barr + Msg-ID: <3561D147.7F3E0C88@ti.com> + Files: pp_sys.c t/op/die.t + Branch: maint-5.004/perl + ! pp_sys.c t/op/die.t +____________________________________________________________________________ +[ 1015] By: TimBunce on 1998/05/19 20:07:01 + Log: Title: "loosen const sub re-defined warnings" + From: Doug MacEachern + Msg-ID: <355F713B.6A4C0F04@pobox.com> + Files: proto.h global.sym op.c pp.c sv.c + Branch: maint-5.004/perl + ! global.sym op.c pp.c proto.h sv.c +____________________________________________________________________________ +[ 1014] By: TimBunce on 1998/05/19 19:48:18 + Log: Title: "s/FORMLINE/FORMAT/ in sv.c" + From: Hugo van der Sanden + Msg-ID: + Files: sv.c + + Title: "Further h2ph patches (including a test suite)" + From: Billy + Msg-ID: + Files: MANIFEST t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t utils/h2ph.PL + Branch: maint-5.004/perl + + t/lib/h2ph.h t/lib/h2ph.pht t/lib/h2ph.t + ! MANIFEST sv.c utils/h2ph.PL +____________________________________________________________________________ +[ 1013] By: TimBunce on 1998/05/19 19:14:13 + Log: Title: "Remove change 673 (Allow empty BLOCK in code)" + From: Gurusamy Sarathy , Ilya Zakharevich + + Msg-ID: <199805151857.OAA29586@monk.mps.ohio-state.edu>, + <199805151931.PAA23086@aatma.engin.umich.edu>, + <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 1012] By: TimBunce on 1998/05/19 19:03:32 + Log: Title: "Further SysV sem/msg fixes and removal of non-portable tests" + From: Andy Dougherty , Jarkko Hietaniemi + + Msg-ID: <199805182028.XAA15717@alpha.hut.fi>, + + Files: MANIFEST Configure config_h.SH perl.h doio.c t/op/ipcmsg.t + t/op/ipcsem.t + Branch: maint-5.004/perl + ! Configure MANIFEST config_h.SH doio.c perl.h t/op/ipcmsg.t + ! t/op/ipcsem.t +____________________________________________________________________________ +[ 1011] By: TimBunce on 1998/05/19 17:55:38 + Log: Title: "interp.sym is missing C after -e fix" + From: jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <355d460d.7621669@smtp1.ibm.net> + Files: embed.h interp.sym + + Title: "Undo changed error message which breaks Tk" + From: Gurusamy Sarathy + Msg-ID: <199805161557.LAA08106@aatma.engin.umich.edu> + Files: pp_ctl.c + + Title: "Minor fixups to new -e script code" + From: Tim Bunce + Files: perl.c + + Title: "Remove old diags not relevant after -e fix" + From: Andy Dougherty , Gurusamy Sarathy + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199805172143.RAA07896@aatma.engin.umich.edu>, + <199805181335.OAA07008@toad.ig.co.uk>, + + Files: pod/perldiag.pod + + Title: "more examples for vec()" + From: Tom Phoenix + Msg-ID: + Files: pod/perlfunc.pod + + Title: ""make ok" (perlbug -ok) should not be interactive" + From: Hugo van der Sanden , Jarkko Hietaniemi + + Msg-ID: <199805160942.MAA20171@alpha.hut.fi>, + + Files: utils/perlbug.PL + Branch: maint-5.004/perl + ! embed.h interp.sym perl.c pod/perldiag.pod pod/perlfunc.pod + ! pp_ctl.c utils/perlbug.PL +____________________________________________________________________________ +[ 1010] By: gsar on 1998/05/18 09:40:58 + Log: integrate mainline changes (untested) + Branch: asperl + +> Porting/Contract Porting/patching.pod README.beos beos/nm.c + +> ext/DynaLoader/DynaLoader.pm.PL ext/POSIX/hints/bsdos.pl + +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl + +> ext/POSIX/hints/openbsd.pl hints/beos.sh hints/openbsd.sh + +> pod/perldelta4.pod t/op/defins.t t/op/die.t t/op/die_exit.t + +> t/op/ipcmsg.t t/op/ipcsem.t t/op/pos.t utils/perlcc.PL + - ext/DynaLoader/DynaLoader.pm + ! win32/win32.c + !> (integrate 234 files) +____________________________________________________________________________ +[ 1009] By: gsar on 1998/05/18 07:51:19 + Log: more whitespace tweaks from maintbranch + Branch: win32/perl + ! av.c perl.c pp_ctl.c pp_sys.c toke.c +____________________________________________________________________________ +[ 1008] By: gsar on 1998/05/17 22:37:20 + Log: sundry whitespace cleanups from maintbranch + Branch: win32/perl + ! Porting/Contract XSUB.h av.c gv.c mg.c perl.c +____________________________________________________________________________ +[ 1007] By: gsar on 1998/05/16 21:59:46 + Log: integrate mainline + Branch: win32/perl + !> INSTALL doio.c lib/strict.pm perl.c perl.h pod/perldebug.pod + !> t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 1006] By: gsar on 1998/05/16 21:54:23 + Log: merge changes#996,998,999 from maintbranch + Branch: win32/perl + ! Changes5.004 Porting/makerel t/base/lex.t toke.c +____________________________________________________________________________ +[ 1005] By: gsar on 1998/05/16 21:49:47 + Log: merge change#995 from maintbranch, tweak interp.sym and + run embed.pl + Branch: win32/perl + ! embedvar.h interp.sym intrpvar.h perl.c +____________________________________________________________________________ +[ 1004] By: gsar on 1998/05/16 21:27:18 + Log: merge changes#989,990,992 from maintbranch + Branch: win32/perl + + t/op/die.t + ! MANIFEST installperl pod/perldiag.pod pp_ctl.c t/op/ipcmsg.t +____________________________________________________________________________ +[ 1003] By: gsar on 1998/05/16 21:16:47 + Log: sync config*.gc with others, and verify that nothing from + change#986 needs to be merged + Branch: win32/perl + ! win32/config.gc win32/config_H.gc +____________________________________________________________________________ +[ 1002] By: gsar on 1998/05/16 21:04:04 + Log: merge change#985 from maintbranch + Branch: win32/perl + ! lib/AutoSplit.pm lib/ExtUtils/Manifest.pm pp_ctl.c pp_sys.c + ! util.c +____________________________________________________________________________ +[ 1001] By: gsar on 1998/05/16 17:53:16 + Log: add a test to check return value from successful s/// (there was none!) + Branch: win32/perl + ! t/op/subst.t +____________________________________________________________________________ +[ 1000] By: gsar on 1998/05/16 17:42:34 + Log: fix misplaced SPAGAIN that caused successful s/// to fail to + return a value on the stack + Branch: win32/perl + ! pp_hot.c +____________________________________________________________________________ +[ 999] By: TimBunce on 1998/05/15 23:04:30 + Log: Title: "Update Porting/makerel script for perforce dir structure" + From: Tim Bunce + Files: Porting/makerel + Branch: maint-5.004/perl + ! Porting/makerel +____________________________________________________________________________ +[ 998] By: TimBunce on 1998/05/15 22:49:55 + Log: Title: "Updated Changes file for trial 3" + From: Tim Bunce + Files: Changes + Branch: maint-5.004/perl + ! Changes +____________________________________________________________________________ +[ 997] By: gsar on 1998/05/15 22:21:41 + Log: merge changes#982,984 from maintbranch + Branch: win32/perl + ! gv.c lib/English.pm perl.c pod/perlfunc.pod t/io/pipe.t + ! t/op/exec.t t/op/ipcsem.t util.c utils/h2ph.PL utils/h2xs.PL +____________________________________________________________________________ +[ 996] By: TimBunce on 1998/05/15 22:19:32 + Log: Title: "Negative array subscript unrecognized in regex" + From: Mark-Jason Dominus , + h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <19980425040819.13828.qmail@plover.com>, + <199805151514.RAA04121@dorlas.elsevier.nl> + Files: t/base/lex.t toke.c + + Title: "Remove e_fp from toke.c after change 955" + From: Tim Bunce + Files: toke.c + Branch: maint-5.004/perl + ! t/base/lex.t toke.c +____________________________________________________________________________ +[ 995] By: TimBunce on 1998/05/15 22:08:32 + Log: Title: "Fix -e security hole (no longer uses temp file)" + From: Tim Bunce + Files: embed.h perl.h perl.c + Branch: maint-5.004/perl + ! embed.h perl.c perl.h +____________________________________________________________________________ +[ 994] By: gsar on 1998/05/15 22:08:17 + Log: merge change#981 from maintbranch, add XXX comment about + supporting %! for usethreads case + Branch: win32/perl + ! gv.c op.c +____________________________________________________________________________ +[ 992] By: TimBunce on 1998/05/15 22:01:32 + Log: Title: "install non-backwards compatible .pm files into archlib" + From: Tim Bunce + Files: installperl + + Title: "revert "Can't locate" message to original for maintenance" + From: Tim Bunce + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + Branch: maint-5.004/perl + ! installperl pod/perldiag.pod pp_ctl.c +____________________________________________________________________________ +[ 991] By: gsar on 1998/05/15 21:35:00 + Log: reverse integrate ansiperl (all except the + C stuff, and the duplicate hunks) + i.e. prototype fixes, perldoc.PL enhancements, and s/comment/comment_t/g + Branch: win32/perl + !> bytecode.h byterun.c cv.h ext/attrs/attrs.pm + !> ext/attrs/attrs.xs pod/perlop.pod pp_hot.c sv.c toke.c + !> utils/perldoc.PL +____________________________________________________________________________ +[ 990] By: TimBunce on 1998/05/15 16:54:18 + Log: Title: "Add tests for die $ref" + From: Graham Barr + Msg-ID: <355C6297.121B576B@ti.com> + Files: MANIFEST t/op/die.t + Branch: maint-5.004/perl + + t/op/die.t + ! MANIFEST +____________________________________________________________________________ +[ 989] By: TimBunce on 1998/05/15 16:38:19 + Log: Title: "Fix t/op/ipcmsg.t for Digital UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805151337.QAA01174@alpha.hut.fi> + Files: t/op/ipcmsg.t + Branch: maint-5.004/perl + ! t/op/ipcmsg.t +____________________________________________________________________________ +[ 988] By: mbeattie on 1998/05/15 16:28:08 + Log: Patch from Sarathy to fix up win32 integration. Patch from Jarkko + (manually applied and tweaked) to fix up SysV IPC semaphores for + Solaris and Linux (pre-glibc and glibc). Fix up t/op/ipcmsg.t and + t/op/ipcsem.t for platforms which wanted to skip test. Completely + disable ipcsem.t since it doesn't seem to work properly even when + not skipped. This is _65. + Branch: perl + ! INSTALL doio.c lib/strict.pm perl.c perl.h pod/perldebug.pod + ! t/op/ipcmsg.t t/op/ipcsem.t +____________________________________________________________________________ +[ 987] By: nick on 1998/05/15 16:03:35 + Log: Integrate win32 + Branch: ansiperl + +> Porting/Contract Porting/patching.pod README.beos beos/nm.c + +> ext/DynaLoader/DynaLoader.pm.PL ext/POSIX/hints/bsdos.pl + +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl + +> ext/POSIX/hints/openbsd.pl hints/beos.sh hints/openbsd.sh + +> pod/perldelta4.pod t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t + +> t/op/pos.t utils/perlcc.PL + - ext/DynaLoader/DynaLoader.pm + !> (integrate 208 files) +____________________________________________________________________________ +[ 986] By: TimBunce on 1998/05/15 15:28:45 + Log: Title: "Patches for BeOS port of Perl, courtesy of Tom Spindler" + From: Jarkko Hietaniemi , Tom Spindler + Msg-ID: <199805042312.CAA09025@alpha.hut.fi> + Files: MANIFEST Configure config_h.SH hints/beos.sh pod/perlfunc.pod + Porting/Glossary README.beos beos/nm.c lib/Term/ReadLine.pm + plan9/config.plan9 pp_sys.c t/io/pipe.t vms/config.vms + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc + Branch: maint-5.004/perl + + README.beos beos/nm.c hints/beos.sh + ! Configure MANIFEST Porting/Glossary config_h.SH + ! lib/Term/ReadLine.pm plan9/config.plan9 pod/perlfunc.pod + ! pp_sys.c t/io/pipe.t vms/config.vms win32/config.bc + ! win32/config.vc win32/config_H.bc win32/config_H.vc +____________________________________________________________________________ +[ 985] By: TimBunce on 1998/05/15 15:02:43 + Log: Title: "allow die $ref" + From: Graham Barr , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199805151351.OAA01985@toad.ig.co.uk>, <355C3E67.AF25B9F7@ti.com> + Files: pp_ctl.c pp_sys.c util.c + + Title: "ExtUtils::Manifest could truncate files during "make dist"" + From: "James E Jurach Jr." , + koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: <199805111048.MAA02573@arrakis.int.ein.cz>, + + Files: lib/ExtUtils/Manifest.pm + + Title: "Autosplit doesn't like upper case letters in sub names on VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980330152332.009cb130@osshe.edu> + Files: lib/AutoSplit.pm + + Title: "AutoSplit/AutoLoaded subs: give useful line numbers in warnings etc" + From: "Jesse N. Glick" , koenig@anna.mind.de (Andreas + J. Koenig), larry@wall.org (Larry Wall) + Msg-ID: <199709292015.NAA09627@wall.org>, <342FCDDF.23534195@sig.bsh.com>, + , + + Files: lib/AutoSplit.pm + Branch: maint-5.004/perl + ! lib/AutoSplit.pm lib/ExtUtils/Manifest.pm pp_ctl.c pp_sys.c + ! util.c +____________________________________________________________________________ +[ 984] By: TimBunce on 1998/05/15 14:18:52 + Log: ------ CORE LANGUAGE ------ + + Title: "Fix close pipe returning status from wrong child" + From: "M.J.T. Guy" , kstar@chapin.edu@ig.co.uk () + Msg-ID: <199805142313.TAA02684@chapin.edu>, + + Files: t/io/pipe.t util.c + + Title: "Avoid English.pm triggering load of Errno.pm" + From: Tim Bunce + Files: gv.c lib/English.pm + + ------ DOCUMENTATION ------ + + Title: "Document child exit cause a parent sleep to end early" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "BSD Platforms need STRUCT_TM_HASZONE for POSIX" + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl + + Title: "MM_VMS.pm fixes for building external library" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511160542.009dd480@ous.edu> + Files: lib/ExtUtils/MM_VMS.pm + + Title: "Appease picky DEC compiler in POSIX.xs" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511161434.009f8bb0@ous.edu> + Files: ext/POSIX/POSIX.xs + + ------ TESTS ------ + + Title: "Fix constant detection in t/op/ipcsem.t for Digit UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805121212.PAA15351@alpha.hut.fi> + Files: t/op/ipcsem.t + + Title: "Fix doc bug for system() return value" + From: Daniel Grisinger + Msg-ID: + Files: pod/perlfunc.pod t/op/exec.t + + ------ UTILITIES ------ + + Title: "Avoid possible constant autoload loop" + From: "M.J.T. Guy" , Graham Barr , Ilya + Zakharevich + Msg-ID: <199805141910.PAA26994@monk.mps.ohio-state.edu>, + <355B475A.C5AD4B90@ti.com>, + + Files: utils/h2xs.PL + + Title: "Further improvements to h2ph.PL" + From: kstar@chapin.edu + Msg-ID: <199805130241.WAA25459@chapin.edu> + Files: utils/h2ph.PL + Branch: maint-5.004/perl + + ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl + + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl + ! MANIFEST ext/POSIX/POSIX.xs gv.c lib/English.pm + ! lib/ExtUtils/MM_VMS.pm pod/perlfunc.pod t/io/pipe.t + ! t/op/exec.t t/op/ipcsem.t util.c utils/h2ph.PL utils/h2xs.PL + +---------------- +Version 5.004_64 +---------------- + +____________________________________________________________________________ +[ 983] By: mbeattie on 1998/05/15 14:04:17 + Log: Integrate win32 branch into mainline. + Branch: perl + +> Porting/patching.pod t/op/defins.t + !> (integrate 107 files) +____________________________________________________________________________ +[ 982] By: TimBunce on 1998/05/15 12:33:26 + Log: Title: "comment init_postdump_symbols issues" + From: Tim Bunce + Files: perl.c + + Title: "Improve sort docs re SUBNAME" + From: circle@azstarnet.com + Msg-ID: <199804281828.LAA22737@andromeda.azstarnet.com> + Files: pod/perlfunc.pod + Branch: maint-5.004/perl + ! perl.c pod/perlfunc.pod +____________________________________________________________________________ +[ 981] By: TimBunce on 1998/05/15 11:47:28 + Log: Title: "Add hook to tie %! to external Errno.pm module (not included)" + From: Graham Barr + Msg-ID: <355080CD.1111BC81@ti.com> + Files: gv.c + Branch: maint-5.004/perl + ! gv.c +____________________________________________________________________________ +[ 980] By: gsar on 1998/05/15 06:16:13 + Log: add doc for C<+{}> vs. C<{;}> disambiguation + Branch: win32/perl + ! pod/perlref.pod +____________________________________________________________________________ +[ 979] By: gsar on 1998/05/15 04:59:47 + Log: tweaks to win32 makefiles. This version builds and passes all + tests on Solaris/gcc, win32/[bv]c. Looks all set to go. + Branch: win32/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 978] By: gsar on 1998/05/15 02:41:58 + Log: merge changes#922,944,949,965,970 from maintbranch + Branch: win32/perl + + Porting/patching.pod t/op/defins.t + ! MANIFEST Porting/makerel ext/POSIX/POSIX.pod gv.c gv.h hv.c + ! lib/File/Find.pm op.c pod/Makefile pod/perlfunc.pod + ! pod/perlguts.pod pod/perlop.pod pod/pod2man.PL + ! t/lib/filefind.t t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t + ! utils/perlbug.PL +____________________________________________________________________________ +[ 977] By: gsar on 1998/05/15 02:15:25 + Log: merge changes#906,907,909,910 from maintbranch + Branch: win32/perl + ! MANIFEST doio.c doop.c embed.h embedvar.h global.sym + ! keywords.h lib/Carp.pm lib/File/Basename.pm mg.c opcode.h + ! perl.c perl.h pod/perldiag.pod pp.c pp_hot.c proto.h sv.c + ! util.c +____________________________________________________________________________ +[ 976] By: gsar on 1998/05/15 01:34:53 + Log: merge change#905 from maintbranch, minor fixes to get + clean build+test on Solaris + Branch: win32/perl + ! doop.c dump.c embed.h embedvar.h lib/strict.pm mg.c op.h + ! opcode.h pod/perlop.pod pod/perlre.pod pp_ctl.c pp_hot.c + ! regcomp.c sv.c t/op/taint.t toke.c +____________________________________________________________________________ +[ 975] By: gsar on 1998/05/14 23:34:26 + Log: merge change#904 from maintbranch + Branch: win32/perl + ! doop.c ext/DynaLoader/dl_aix.xs ext/IO/lib/IO/Socket.pm + ! ext/NDBM_File/NDBM_File.pm lib/strict.pm lib/subs.pm + ! lib/vars.pm op.c perl.c pod/perldiag.pod pod/perlembed.pod + ! pod/perlfunc.pod pod/perlsec.pod pp_ctl.c sv.c utils/h2ph.PL + ! vms/descrip.mms +____________________________________________________________________________ +[ 974] By: gsar on 1998/05/14 23:11:05 + Log: merge change#897 from maintbranch + Branch: win32/perl + ! Porting/Contract Todo doio.c emacs/ptags embed.h ext/IO/IO.pm + ! ext/Opcode/Opcode.pm lib/Carp.pm lib/ExtUtils/MM_Unix.pm + ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h + ! opcode.pl perl.c pod/perlapio.pod pod/perlcall.pod + ! pod/perldebug.pod pod/perldelta.pod pod/perldelta4.pod + ! pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod + ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + ! pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod + ! pod/perlfunc.pod pod/perlguts.pod pod/perlhist.pod + ! pod/perlipc.pod pod/perllocale.pod pod/perlmodlib.pod + ! pod/perlop.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL + ! pod/roffitall pp.c pp_sys.c t/TEST t/op/gv.t t/op/hashwarn.t + ! t/op/substr.t vms/vms.c win32/config.bc win32/config.vc + ! win32/config_H.bc win32/config_H.vc win32/win32.c + ! x2p/find2perl.PL +____________________________________________________________________________ +[ 973] By: gsar on 1998/05/14 22:24:26 + Log: integrate mainline + Branch: win32/perl + + Porting/Contract + +> README.beos beos/nm.c ext/POSIX/hints/bsdos.pl + +> ext/POSIX/hints/freebsd.pl ext/POSIX/hints/netbsd.pl + +> ext/POSIX/hints/openbsd.pl hints/beos.sh pod/perldelta4.pod + +> utils/perlcc.PL + ! MANIFEST Todo doio.c emacs/ptags embed.h ext/IO/IO.pm + ! ext/Opcode/Opcode.pm ext/Socket/Socket.xs hints/irix_5.sh + ! hints/netbsd.sh hv.c lib/Benchmark.pm lib/Carp.pm + ! lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm + ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h + ! opcode.pl perl.c perl.h pod/perlapio.pod pod/perlcall.pod + ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod + ! pod/perlembed.pod pod/perlfaq2.pod pod/perlfaq3.pod + ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq7.pod + ! pod/perlfaq8.pod pod/perlform.pod pod/perlfunc.pod + ! pod/perlguts.pod pod/perlhist.pod pod/perlipc.pod + ! pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod + ! pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL + ! pod/roffitall pp.c pp_hot.c pp_sys.c sv.c t/TEST t/op/gv.t + ! t/op/hashwarn.t t/op/substr.t vms/vms.c win32/config.bc + ! win32/config.vc win32/config_H.bc win32/config_H.vc + ! win32/win32.c x2p/find2perl.PL + !> (integrate 59 files) +____________________________________________________________________________ +[ 972] By: nick on 1998/05/14 18:09:01 + Log: Changes to allow compiler with gcc-2.8.1 in C++ mode, + Remove K&R style functions, avoid struct/typedef clash. + Branch: ansiperl + ! bytecode.h byterun.c sv.c toke.c +____________________________________________________________________________ +[ 971] By: TimBunce on 1998/05/14 16:52:19 + Log: + Title: "fix C (pp_refgen fumbles when G_SCALAR, no args)" + From: Gurusamy Sarathy + Msg-ID: <199805070402.AAA02858@aatma.engin.umich.edu> + Files: pp.c + Branch: maint-5.004/perl + ! pp.c +____________________________________________________________________________ +[ 970] By: TimBunce on 1998/05/14 16:18:06 + Log: + Title: "perlbug reformatted" + From: Dominic Dunlop , Hugo van der Sanden + + Msg-ID: <199805110954.LAA20367@dorlas.elsevier.nl>, + , + + Files: utils/perlbug.PL + Branch: maint-5.004/perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 969] By: mbeattie on 1998/05/14 16:15:09 + Log: Integrate win32 branch into mainline + Branch: perl + +> ext/DynaLoader/DynaLoader.pm.PL hints/openbsd.sh + +> t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/pos.t + - ext/DynaLoader/DynaLoader.pm + !> (integrate 118 files) +____________________________________________________________________________ +[ 968] By: mbeattie on 1998/05/14 16:05:57 + Log: Bump patchlevel to 65 + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 967] By: mbeattie on 1998/05/14 16:05:19 + Log: Another fixup of MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 966] By: mbeattie on 1998/05/14 16:02:20 + Log: Add missing files to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 965] By: TimBunce on 1998/05/14 16:00:11 + Log: + Title: "Sub declaration cost reduced from ~500 to ~100 bytes" + From: Ilya Zakharevich + Msg-ID: <199805050607.CAA02050@monk.mps.ohio-state.edu> + Files: gv.h gv.c op.c + Branch: maint-5.004/perl + ! gv.c gv.h op.c +____________________________________________________________________________ +[ 964] By: mbeattie on 1998/05/14 15:58:01 + Log: Subject: [PATCH] Using Getopts::* with strict vars + Date: Wed, 29 Apr 1998 22:48:16 -0700 (PDT) + From: Tom Phoenix + Branch: perl + ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/strict.pm +____________________________________________________________________________ +[ 963] By: mbeattie on 1998/05/14 15:56:53 + Log: Subject: [ PATCH 5.004_64 ] Integrated regression tests for compiler + Date: Wed, 29 Apr 1998 21:02:36 -0600 (MDT) + From: epeschko@den-mdev1 (Ed Peschko) + Branch: perl + + utils/perlcc.PL + ! MANIFEST Makefile.SH installperl lib/Test/Harness.pm + ! pod/Makefile t/TEST t/harness utils/Makefile x2p/Makefile.SH +____________________________________________________________________________ +[ 962] By: mbeattie on 1998/05/14 15:45:28 + Log: From: Dan Sugalski + Subject: [PATCH 5.004_64] Final (I hope) doc patch for Thread.pm + Date: Wed, 08 Apr 1998 17:08:48 -0700 + Subject: [PATCH 5.004_64] Revised second Thread.PM doc patch + Date: Fri, 08 May 1998 10:49:16 -0700 + Branch: perl + ! ext/Thread/Thread.pm +____________________________________________________________________________ +[ 961] By: mbeattie on 1998/05/14 15:43:39 + Log: Subject: Consolidated patch to 5.004_64 + Date: Wed, 08 Apr 1998 19:44:34 -0400 (EDT) + From: Charles Bailey + Branch: perl + ! ext/B/byteperl.c lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_VMS.pm lib/chat2.pl perl.c pod/perlsub.pod + ! vms/config.vms vms/descrip.mms vms/genconfig.pl + ! vms/perlvms.pod +____________________________________________________________________________ +[ 960] By: mbeattie on 1998/05/14 15:41:41 + Log: Subject: Re: ANNOUNCE: Perl 5.005b1t3 (a.k.a. perl5.004_64) is available + Date: 07 Apr 1998 18:31:21 +0200 + From: JVromans@Squirrel.nl (Johan Vromans) + Branch: perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 959] By: mbeattie on 1998/05/14 15:39:29 + Log: From: Jarkko Hietaniemi + Subject: Re: [PATCH] 5.004_04 or 5.004_64: Benchmark.pm: add run-for-some-time + Date: Wed, 8 Apr 1998 09:47:45 +0300 (EET DST) + Subject: [PATCH] perl 5.004_64+Config_04 + Date: Thu, 14 May 1998 12:14:07 +0300 (EET DST) + Branch: perl + ! lib/Benchmark.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 958] By: mbeattie on 1998/05/14 15:36:30 + Log: From: kstar@chapin.edu + Subject: [PATCH] hints for Irix 6 + Date: Mon, 6 Apr 1998 15:14:14 -0400 (EDT) + Subject: [PATCH 5.004_64] Threads - an easy way for dual installation + Date: Wed, 29 Apr 1998 15:39:46 -0400 (EDT) + Branch: perl + ! INSTALL hints/irix_6.sh installperl +____________________________________________________________________________ +[ 957] By: mbeattie on 1998/05/14 15:33:48 + Log: Subject: [PATCH] Install extensions with bootstrap (again) in $archlib + Date: Mon, 06 Apr 1998 21:09:24 +0200 + From: Achim Bohnet + Branch: perl + ! lib/ExtUtils/Install.pm +____________________________________________________________________________ +[ 956] By: mbeattie on 1998/05/14 15:32:39 + Log: Subject: [PATCH] Config: Irix 5 hints + Date: Mon, 6 Apr 1998 13:12:47 -0400 (EDT) + From: kstar@O2.chapin.edu + Branch: perl + ! hints/irix_5.sh +____________________________________________________________________________ +[ 955] By: mbeattie on 1998/05/14 15:31:12 + Log: Subject: PATCH: h2ph produces incorrect code + Date: Mon, 6 Apr 1998 23:52:13 +0930 (CST) + From: Billy + Branch: perl + ! utils/h2ph.PL +____________________________________________________________________________ +[ 954] By: mbeattie on 1998/05/14 15:29:27 + Log: Subject: [PATCH] perldebug.pod + Date: Mon, 6 Apr 1998 00:36:57 -0600 + From: jason stewart + Branch: perl + ! pod/perldebug.pod +____________________________________________________________________________ +[ 953] By: mbeattie on 1998/05/14 15:28:00 + Log: From: Dominic Dunlop + Subject: [PATCH 5.004_64]: hints/machten.sh: disable semctl() + Date: Wed, 6 May 1998 14:39:32 +0000 + Subject: [PATCH] Not OK: perl 5.00464 on powerpc-machten 4.1 (hashwarn @INC problem) + Date: Sat, 4 Apr 1998 19:44:34 +0000 + Branch: perl + ! hints/machten.sh t/op/hashwarn.t +____________________________________________________________________________ +[ 952] By: mbeattie on 1998/05/14 15:23:19 + Log: New pod/perldelta.pod (previous one branched in last change): + Subject: [PATCH 5.004_64] Start new perldelta + Date: Thu, 23 Apr 1998 12:12:38 -0400 (EDT) + From: Andy Dougherty + Branch: perl + + pod/perldelta.pod +____________________________________________________________________________ +[ 951] By: mbeattie on 1998/05/14 15:20:43 + Log: From: Andy Dougherty + Subject: [PATCH for 5.004_04 and 5.004_64] (Was: Obsoleted svr4.sh) + Date: Thu, 23 Apr 1998 11:10:15 -0400 (EDT) + Subject: [PATCH 5.004_64] Start new perldelta + Date: Thu, 23 Apr 1998 12:12:38 -0400 (EDT) + (above branched perldelta -> perldelta4, new perldelta will be + created/added next change) + Subject: [PATCH] BSD Platforms need STRUCT_TM_HASZONE + Date: Tue, 12 May 1998 09:58:49 -0400 (EDT) + Branch: perl + + ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl + + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl + +> pod/perldelta4.pod + - pod/perldelta.pod + ! MANIFEST hints/svr4.sh +____________________________________________________________________________ +[ 949] By: TimBunce on 1998/05/14 15:11:30 + Log: + Title: "while($x=<>) no longer warns (implicit defined added)" + From: Nick Ing-Simmons + Msg-ID: <199805051035.LAA27365@pluto.tiuk.ti.com> + Files: MANIFEST op.c t/op/defins.t + Branch: maint-5.004/perl + + t/op/defins.t + ! MANIFEST op.c +____________________________________________________________________________ +[ 948] By: mbeattie on 1998/05/14 15:09:51 + Log: From: Andy Dougherty + Subject: [PATCH for 5.004_64] Configure patch Config_64-01 + Date: Tue, 14 Apr 1998 13:04:58 -0400 (EDT) + Subject: [PATCH for 5.004_64] Configure patch Config_64-01-02.diff + Date: Fri, 17 Apr 1998 11:01:13 -0400 (EDT) + Subject: [PATCH for 5.004_64] Configure patch Config_64-02-03.diff + Date: Thu, 23 Apr 1998 15:03:20 -0400 (EDT) + Subject: [PATCH 5.004_64] Config_64-03-04.diff + Date: Wed, 13 May 1998 14:33:30 -0400 (EDT) + Branch: perl + + README.beos beos/nm.c hints/beos.sh + ! Configure INSTALL MANIFEST Makefile.SH Policy_sh.SH + ! Porting/Glossary Porting/config.sh Porting/config_H + ! Porting/pumpkin.pod Todo cflags.SH config_h.SH + ! djgpp/djgppsed.sh doop.c handy.h hints/dos_djgpp.sh + ! hints/netbsd.sh hints/solaris_2.sh hints/unicos.sh + ! hints/unicosmk.sh hv.h lib/Term/ReadLine.pm perl.h + ! plan9/config.plan9 pod/perlfunc.pod pp.c pp_sys.c sv.h + ! t/io/pipe.t thread.h vms/config.vms win32/config.bc + ! win32/config.vc win32/config_H.bc win32/config_H.vc +____________________________________________________________________________ +[ 946] By: TimBunce on 1998/05/14 15:07:06 + Log: + Title: "Fix PERL_DESTRUCT_LEVEL core dumps" + From: Gurusamy Sarathy + Msg-ID: <199805062301.TAA24599@aatma.engin.umich.edu> + Files: perl.c sv.c t/op/misc.t + Branch: maint-5.004/perl + ! perl.c sv.c t/op/misc.t +____________________________________________________________________________ +[ 945] By: mbeattie on 1998/05/14 15:00:31 + Log: Subject: Perl Social Contract + Date: 13 Apr 1998 06:16:59 -0700 + From: Russ Allbery + Branch: perl + + Porting/Contract +____________________________________________________________________________ +[ 944] By: TimBunce on 1998/05/14 14:59:37 + Log: + Title: "5.004_04-m2 Cleanup of test failures" + From: Gurusamy Sarathy + Msg-ID: <199805070416.AAA03082@aatma.engin.umich.edu> + Files: t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t + win32/config.bc win32/config.vc + Branch: maint-5.004/perl + ! t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t + ! win32/config.bc win32/config.vc +____________________________________________________________________________ +[ 943] By: mbeattie on 1998/05/14 14:58:13 + Log: From: Joshua.Pritikin@NewYork2.dmg.deuba.com + Subject: [PATCH 5.004_64] Test.pm update + Date: Sat, 4 Apr 1998 08:33:50 -0500 + Subject: [PATCH 5.004_64] modcount + comments + Date: Fri, 17 Apr 1998 16:07:35 -0400 + Branch: perl + ! lib/Test.pm op.c thrdvar.h +____________________________________________________________________________ +[ 942] By: mbeattie on 1998/05/14 14:49:43 + Log: From: Ilya Zakharevich + Subject: [PATCH 5.004_64] newSV + Date: Wed, 8 Apr 1998 03:21:03 -0400 (EDT) + Subject: [PATCH 5.004_64] Cryptic error from B::CC + Date: Sat, 11 Apr 1998 19:52:25 -0400 (EDT) + Branch: perl + ! ext/B/B/CC.pm handy.h proto.h sv.c +____________________________________________________________________________ +[ 941] By: mbeattie on 1998/05/14 14:47:29 + Log: From: Ilya Zakharevich + Subject: [PATCH 5.004_64] anydbm.t + Date: Sat, 4 Apr 1998 01:39:03 -0500 (EST) + Subject: [PATCH 5.004_64] threads on OS/2 + Date: Sat, 4 Apr 1998 01:44:29 -0500 (EST) + Subject: [PATCH 5.004_64] Better handling of Perl DLLs under OS/2 + Date: Sat, 4 Apr 1998 01:47:58 -0500 (EST) + Subject: [PATCH 5.004_64] Immediate stop in debugger + Date: Sat, 11 Apr 1998 19:50:58 -0400 (EDT) + Subject: [PATCH 5.005_64] ptags broken + Date: Sat, 11 Apr 1998 22:08:21 -0400 (EDT) + Subject: [PATCH 5.004_64] Document switch syntax via RE + Date: Sun, 12 Apr 1998 01:12:33 -0400 (EDT) + Branch: perl + ! emacs/ptags lib/ExtUtils/MM_OS2.pm lib/ExtUtils/Mksymlists.pm + ! lib/perl5db.pl os2/Changes os2/Makefile.SHs os2/os2.c + ! os2/os2thread.h pod/perlsyn.pod t/lib/anydbm.t +____________________________________________________________________________ +[ 940] By: mbeattie on 1998/05/14 14:38:44 + Log: Subject: [PATCH 5.004_64] Build Stdio and DCLSym modules as part of normal VMS perl build + Date: Fri, 03 Apr 1998 16:01:57 -0800 + From: Dan Sugalski + Branch: perl + ! vms/descrip.mms vms/ext/DCLsym/Makefile.PL + ! vms/ext/Stdio/Makefile.PL vms/ext/Stdio/Stdio.xs +____________________________________________________________________________ +[ 939] By: mbeattie on 1998/05/14 14:35:42 + Log: Subject: [PATCH 5.004_64] perl dies in perl_construct when compiled with MULTIPLICITY + Date: Fri, 03 Apr 1998 13:58:15 -0800 + From: Dan Sugalski + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 938] By: gsar on 1998/05/14 10:53:55 + Log: merge change#896 from maintbranch + Branch: win32/perl + ! doio.c ext/Socket/Socket.xs lib/Class/Struct.pm lib/Cwd.pm + ! lib/File/Find.pm lib/Math/BigInt.pm lib/lib.pm lib/strict.pm + ! op.c pod/perldiag.pod pod/perlfunc.pod pp.c pp_ctl.c sv.c + ! t/op/gv.t t/op/misc.t t/op/pack.t +____________________________________________________________________________ +[ 937] By: gsar on 1998/05/14 09:31:34 + Log: merge change#887 from maintbranch + Branch: win32/perl + + t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t + ! MANIFEST doio.c lib/File/CheckTree.pm lib/Getopt/Long.pm + ! lib/Math/BigFloat.pm lib/Text/ParseWords.pm lib/Text/Wrap.pm + ! lib/base.pm perl.c pod/perlre.pod t/lib/io_sock.t + ! t/lib/io_udp.t t/lib/parsewords.t t/lib/timelocal.t + ! t/op/stat.t toke.c utils/h2xs.PL +____________________________________________________________________________ +[ 936] By: gsar on 1998/05/14 09:06:18 + Log: merge change#886 from maintbranch + Branch: win32/perl + ! README.os2 README.vms cop.h ext/DynaLoader/dl_hpux.xs + ! ext/POSIX/POSIX.xs ext/POSIX/hints/linux.pl global.sym + ! hints/aix.sh hints/bsdos.sh hints/dec_osf.sh hints/hpux.sh + ! hints/linux.sh hints/netbsd.sh hints/os2.sh hints/svr4.sh + ! lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + ! lib/File/Basename.pm lib/File/Path.pm op.c os2/Makefile.SHs + ! os2/os2.c os2/perl2cmd.pl perl.c perl.h pod/perlguts.pod + ! pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c proto.h + ! t/lib/filecopy.t util.c utils/perldoc.PL vms/config.vms + ! vms/descrip.mms vms/ext/Filespec.pm vms/ext/filespec.t + ! vms/test.com +____________________________________________________________________________ +[ 935] By: gsar on 1998/05/14 07:00:02 + Log: merge changes#872,873 from maintbranch + Branch: win32/perl + ! Changes5.004 INSTALL lib/ExtUtils/MakeMaker.pm + ! lib/FileHandle.pm lib/Tie/Hash.pm lib/constant.pm + ! lib/integer.pm pod/perl.pod pod/perlbook.pod pod/perldsc.pod + ! pod/perlfunc.pod pod/perlguts.pod pod/perlhist.pod + ! pod/perlop.pod pod/perlre.pod pod/perlrun.pod pod/perlsec.pod + ! pod/perltrap.pod pod/perlvar.pod pod/pod2latex.PL + ! utils/perldoc.PL +____________________________________________________________________________ +[ 934] By: gsar on 1998/05/14 06:24:38 + Log: merge changes#755..759,763,764 from maintbranch + Branch: win32/perl + + hints/openbsd.sh + ! MANIFEST Porting/patchls perl.c perlsdio.h pod/perlfunc.pod + ! t/op/pos.t utils/perldoc.PL +____________________________________________________________________________ +[ 933] By: gsar on 1998/05/14 06:07:31 + Log: merge change#754 from maintbranch + Branch: win32/perl + ! perl.c +____________________________________________________________________________ +[ 932] By: gsar on 1998/05/14 06:03:50 + Log: merge changes#752,753 from maintbranch + Branch: win32/perl + + t/op/pos.t + ! README ext/GDBM_File/GDBM_File.pm + ! ext/SDBM_File/sdbm/Makefile.PL pod/perlsyn.pod +____________________________________________________________________________ +[ 931] By: gsar on 1998/05/14 05:51:19 + Log: merge change#745 from maintbranch + Branch: win32/perl + + ext/DynaLoader/DynaLoader.pm.PL + - ext/DynaLoader/DynaLoader.pm + ! MANIFEST ext/DynaLoader/Makefile.PL +____________________________________________________________________________ +[ 930] By: nick on 1998/05/13 20:39:59 + Log: resolve -at //depot/win32 into ansiperl for C++ testing. + Branch: ansiperl + ! utils/perldoc.PL + !> MANIFEST ext/Fcntl/Fcntl.pm hv.c lib/ExtUtils/Liblist.pm op.c + !> perl.c pod/perlfunc.pod pod/perlguts.pod pp.c pp_ctl.c + !> regcomp.c regcomp.h regexec.c t/op/hashwarn.t t/op/runlevel.t + !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc + !> win32/makedef.pl win32/makefile.mk +____________________________________________________________________________ +[ 929] By: gsar on 1998/05/13 10:13:36 + Log: merge change#687 from maintbranch + Branch: win32/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 928] By: gsar on 1998/05/13 10:08:13 + Log: merge change#683 from maintbranch + Branch: win32/perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 927] By: gsar on 1998/05/13 09:51:43 + Log: merge change#681 from maintbranch + Branch: win32/perl + ! ext/Fcntl/Fcntl.pm +____________________________________________________________________________ +[ 926] By: gsar on 1998/05/13 09:47:11 + Log: merge change#664 from maint branch + Branch: win32/perl + ! regcomp.c regcomp.h regexec.c +____________________________________________________________________________ +[ 925] By: gsar on 1998/05/13 08:55:28 + Log: merge missing part of change#663 from maint branch + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 924] By: gsar on 1998/05/12 18:50:04 + Log: remove x586 code gen switch (-5) for Borland, it is non-generic, + and seems to generate problematic code for PII. + Branch: win32/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 923] By: gsar on 1998/05/12 16:24:02 + Log: fix test failure + Message-Id: <199805120940.KAA01252@pluto.tiuk.ti.com> + Date: Tue, 12 May 1998 10:40:57 BST + From: Nick.Ing-Simmons@tiuk.ti.com + Subject: test buglet + Branch: win32/perl + ! t/op/hashwarn.t +____________________________________________________________________________ +[ 922] By: TimBunce on 1998/05/11 20:58:58 + Log: Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "incorrect return value for hv_iterinit" + From: Gurusamy Sarathy + Msg-ID: <199805031848.OAA20618@aatma.engin.umich.edu> + Files: pod/perlguts.pod hv.c + + ------ DOCUMENTATION ------ + + Title: "perlvar.pod buglet E" + From: Achim Bohnet + Msg-ID: <9805041415.AA22185@o09.xray.mpe.mpg.de> + Files: pod/perlvar.pod + + Title: "Improve docs for warning about code after an exec()" + From: "M.J.T. Guy" , Chaim Frenkel + + Msg-ID: , + + Files: pod/perlfunc.pod + + Title: "Remove dead code from pod2man" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/pod2man.PL + + Title: "tweak doc for C" + From: Gurusamy Sarathy + Msg-ID: <199805090017.UAA06888@aatma.engin.umich.edu> + Files: pod/perlfunc.pod + + Title: "Document integer pragma effect on % operator" + From: Gisle Aas + Msg-ID: + Files: pod/perlop.pod + + Title: "Reduce rm command line length in pod/Makefile" + From: Hugo van der Sanden + Msg-ID: <199805041423.QAA13199@dorlas.elsevier.nl> + Files: pod/Makefile + + ------ EXTENSIONS ------ + + Title: "Clarify Termios usage in POSIX.pod" + From: Rocco Caputo + Msg-ID: <199805101952.PAA12738@ns.netrus.net> + Files: ext/POSIX/POSIX.pod + + ------ LIBRARY ------ + + Title: "Fix File::Find::finddepth typo in trial 2 release" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/File/Find.pm t/lib/filefind.t + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Porting/patching.pod document" + From: Daniel Grisinger + Msg-ID: <199805030305.XAA16147@relay.pair.com> + Files: MANIFEST Porting/patching.pod + + Title: "hints/machten.sh: disable semctl(), align with devel version" + From: Dominic Dunlop + Msg-ID: + Files: hints/machten.sh + + Title: "Add VMS specifics to Porting/makerel" + From: Charles Bailey + Msg-ID: <01IWDK1LONRQ0026P0@cor.newman.upenn.edu>, + <199804271732.SAA13762@toad.ig.co.uk>, + <9804250212.AA27695@forte.com> + Files: Porting/makerel + Branch: maint-5.004/perl + + Porting/patching.pod + ! MANIFEST Porting/makerel ext/POSIX/POSIX.pod hints/machten.sh + ! hv.c lib/File/Find.pm pod/Makefile pod/perlfunc.pod + ! pod/perlguts.pod pod/perlop.pod pod/perlvar.pod pod/pod2man.PL + ! t/lib/filefind.t +____________________________________________________________________________ +[ 921] By: gsar on 1998/05/10 02:28:03 + Log: various tweaks to makefiles + Branch: win32/perl + ! win32/Makefile win32/makedef.pl win32/makefile.mk +____________________________________________________________________________ +[ 920] By: gsar on 1998/05/10 02:27:19 + Log: fix ExtUtils::Liblist mishandling paths with spaces + Branch: win32/perl + ! lib/ExtUtils/Liblist.pm +____________________________________________________________________________ +[ 919] By: gsar on 1998/05/09 17:10:15 + Log: minor cleanup + Branch: win32/perl + ! MANIFEST perl.c +____________________________________________________________________________ +[ 918] By: gsar on 1998/05/09 17:09:09 + Log: protect sortcop from C + Message-Id: <199805082333.TAA06287@aatma.engin.umich.edu> + Date: Fri, 08 May 1998 19:33:44 EDT + From: Gurusamy Sarathy + Subject: [PATCH] Re: double recursion in sort + Branch: win32/perl + ! pp_ctl.c t/op/runlevel.t +____________________________________________________________________________ +[ 917] By: gsar on 1998/05/09 17:05:55 + Log: c + Branch: win32/perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 916] By: gsar on 1998/05/07 03:40:15 + Log: fix C (pp_refgen fumbles when G_SCALAR, no args) + Branch: win32/perl + ! pp.c +____________________________________________________________________________ +[ 915] By: mbeattie on 1998/05/06 13:08:29 + Log: Speed up pp_entersub for usethreads with only 1 thread running. + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 914] By: gsar on 1998/05/03 18:44:38 + Log: make hv_iterinit() return HvKEYS() + Message-Id: <3.0.1.32.19980502162922.009e6320@www.syncad.com> + Date: Sat, 02 May 1998 16:29:22 EDT + From: "SynaptiCAD, Inc." + Subject: incorrect return value for hv_iterinit + Branch: win32/perl + ! hv.c pod/perlguts.pod +____________________________________________________________________________ +[ 913] By: TimBunce on 1998/05/01 22:38:38 + Log: Update MANIFEST for trial 2. + (Porting/Contract lib/Tie/Handle.pm t/op/tiehandle.t) + Branch: maint-5.004/perl + ! MANIFEST +____________________________________________________________________________ +[ 912] By: TimBunce on 1998/05/01 22:30:29 + Log: Add t/op/tiehandle.t as xtext to repository (see change 911) + Branch: maint-5.004/perl + + t/op/tiehandle.t +____________________________________________________________________________ +[ 911] By: TimBunce on 1998/05/01 21:35:03 + Log: + Title: "Add ERRSV, ERRHV, DEFSV and SAVE_DEFSV for XS 5.005 compatibility" + From: timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804200854.JAA01482@toad.ig.co.uk> + Files: perl.h + + Title: "Add WRITE & CLOSE to TIEHANDLE" + From: Graham Barr + Msg-ID: <34F63DC8.CA95670F@pobox.com> + Files: pod/perltie.pod lib/Tie/Handle.pm pp_sys.c t/op/tiehandle.t + Branch: maint-5.004/perl + + lib/Tie/Handle.pm + ! perl.h pod/perltie.pod pp_sys.c +____________________________________________________________________________ +[ 910] By: TimBunce on 1998/05/01 20:47:47 + Log: + Title: "Add warning for Illegal hex digit" + From: Stephen P Potter , Stephen Potter + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199804232219.SAA02267@spp.users.ds.net>, + <199804271409.PAA12819@toad.ig.co.uk>, + <199804280307.WAA12332@psasolar.psa.pencom.com> + Files: pod/perldiag.pod util.c + + Title: "perl_call_method() bug fix (corrupt op pointer)" + From: "Alterman, Eugene" + Msg-ID: <510415F72ECFD111A31700A0C9B3CCDE3098@efx98digmasa.bremer-inc.com> + Files: perl.c + + Title: "Fix printf segmentation fault" + From: Hugo van der Sanden + Msg-ID: + Files: pp_hot.c + + Title: "Document changed local($a[$i],$b{$j}) behaviour re delete/splice" + From: Charles Bailey + Msg-ID: <01IVMVIHNZ36001NKH@cor.newman.upenn.edu> + Files: pod/perlsub.pod + Branch: maint-5.004/perl + ! perl.c pod/perldiag.pod pod/perlsub.pod pp_hot.c util.c +____________________________________________________________________________ +[ 909] By: TimBunce on 1998/05/01 19:44:47 + Log: + Title: "Change Ilya's do_binmode to K&R prototype and move to doio.c" + Files: doio.c util.c + Branch: maint-5.004/perl + ! doio.c util.c +____________________________________________________________________________ +[ 908] By: gsar on 1998/05/01 19:21:02 + Log: add AS patch#20 (exposes more global constants) + Branch: asperl + ! ObjXSub.h byterun.h embed.h embedvar.h global.sym globals.c + ! interp.sym ipsock.h ipstdio.h objpp.h perlio.h perlsock.h + ! proto.h util.c win32/GenCAPI.pl win32/runperl.c +____________________________________________________________________________ +[ 907] By: TimBunce on 1998/05/01 17:50:46 + Log: + Title: "Runtime Carp verbosity without aliasing" + From: Joshua.Pritikin@NewYork2.dmg.deuba.com, Tim Bunce + Msg-ID: + Files: lib/Carp.pm + + Title: "Fix File::Basename to not untaint results (using new //t flag)" + From: Eric Hammond , Tom Phoenix + + Msg-ID: <199710070515.WAA00682@finity.citysearch.com>, + + Files: lib/File/Basename.pm + Branch: maint-5.004/perl + ! lib/Carp.pm lib/File/Basename.pm +____________________________________________________________________________ +[ 906] By: TimBunce on 1998/04/28 11:04:49 + Log: + ------ CORE LANGUAGE ------ + + Title: "5.004_04m5t1: Fix dangling references in LVs", "Fix dangling + references in LVs" + From: Spider Boardman + Msg-ID: <199804010541.AAA32615@Orb.Nashua.NH.US>, + <19980422164037.D29222@perl.org> + Files: embed.h keywords.h opcode.h perl.h proto.h doop.c global.sym mg.c + pp.c sv.c + + Title: "Fix SvGMAGIC typo in change 904" + Files: doop.c + Branch: maint-5.004/perl + ! doop.c embed.h global.sym keywords.h mg.c opcode.h perl.h pp.c + ! proto.h sv.c +____________________________________________________________________________ +[ 905] By: TimBunce on 1998/04/28 10:32:20 + Log: Regexp patches + + Title: "New regex flag //t to leave $1 etc. tainted" + From: Chip Salzenberg , Tim Bunce + Msg-ID: <19980310192640.37826@cyprus> + Files: pod/perlop.pod pod/perlre.pod op.h dump.c mg.c pp_hot.c sv.c + t/op/taint.t toke.c + + Title: "Don't accidentally untaint target of s///" + From: Chip Salzenberg + Msg-ID: <19980310151756.24767@cyprus> + Files: pp_ctl.c pp_hot.c t/op/taint.t + + Title: "Allow but ignore embedded /...(?o).../ in regexp" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804201243.OAA08244@dorlas.elsevier.nl> + Files: regcomp.c + Branch: maint-5.004/perl + ! dump.c mg.c op.h pod/perlop.pod pod/perlre.pod pp_ctl.c + ! pp_hot.c regcomp.c sv.c t/op/taint.t toke.c +____________________________________________________________________________ +[ 904] By: TimBunce on 1998/04/27 20:20:21 + Log: Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Protect join() against double reads on undef and SvGMAGICALs" + From: Chip Salzenberg , Tim Bunce + + Msg-ID: <19980424080630.D13985@perl.org> + Files: doop.c + + Title: "Better error message for require failure" + From: epeschko@den-mdev1 (Ed Peschko) + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + + Title: "fixes for various noises under PERL_DESTRUCT_LEVEL" + From: Gurusamy Sarathy + Msg-ID: <199804231926.PAA23969@aatma.engin.umich.edu> + Files: perl.c + + Title: "Fix nice_chunk memory leak" + From: Gurusamy Sarathy + Msg-ID: <199804052347.TAA15699@aatma.engin.umich.edu> + Files: sv.c + + Title: "-2.0 vs. -2 (was Number representations)" + From: Chip Salzenberg + Msg-ID: <19980309185652.11231@cyprus> + Files: op.c + + Title: "perl.c fixes for -DUNEXEC" + From: Matt Wette , Matthew R Wette + + Msg-ID: <199710152146.OAA07283@mr-ed.jpl.nasa.gov> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "perlcall is Perl from C, not C from Perl" + From: Steve A Fink + Files: pod/perlembed.pod + + Title: "Clarify require "Foo::Bar" non-bareword issue" + From: Dominique Dumont + Msg-ID: <199804231527.AA153445256@ss7serv.grenoble.hp.com> + Files: pod/perlfunc.pod + + Title: "(repost) new text for perlsec", "new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + ------ EXTENSIONS ------ + + Title: "IO::Socket->socketpair broken (typo)" + From: Olaf Titz + Msg-ID: <19980425224535.2807.qmail@bigred.inka.de> + Files: ext/IO/lib/IO/Socket.pm + + Title: "NDBM_File man page needs Fcntl" + From: "Danny R. Faught" + Msg-ID: <199707011500.IAA00601@palrel3.hp.com> + Files: ext/NDBM_File/NDBM_File.pm + + ------ LIBRARY ------ + + Title: "Documentation discrepancy: pragmatic modules" + From: "M.J.T. Guy" , h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804221525.RAA12695@dorlas.elsevier.nl>, + + Files: lib/strict.pm lib/subs.pm lib/vars.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Updated hints file for svr4" + From: Andy Dougherty + Msg-ID: + Files: hints/svr4.sh + + Title: "Pumpkin update -- shared libperl.so location" + From: Andy Dougherty + Msg-ID: + Files: Porting/pumpkin.pod + + Title: "perl compile fix for AIX 4.3" + From: Jens-Uwe Mager + Msg-ID: <199804261611.SAA34728@ans.helios.de> + Files: ext/DynaLoader/dl_aix.xs + + Title: "Dynaloader build on VMS", + From: pvhp@forte.com (Peter Prymmer), timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804271732.SAA13762@toad.ig.co.uk>, <9804250212.AA27695@forte.com> + Files: vms/descrip.mms + + ------ UTILITIES ------ + + Title: "Major update to h2ph.PL" + From: Billy + Msg-ID: + Files: utils/h2ph.PL + Branch: maint-5.004/perl + ! Porting/pumpkin.pod doop.c ext/DynaLoader/dl_aix.xs + ! ext/IO/lib/IO/Socket.pm ext/NDBM_File/NDBM_File.pm + ! hints/svr4.sh lib/strict.pm lib/subs.pm lib/vars.pm op.c + ! perl.c pod/perldiag.pod pod/perlembed.pod pod/perlfunc.pod + ! pod/perlsec.pod pp_ctl.c sv.c utils/h2ph.PL vms/descrip.mms +____________________________________________________________________________ +[ 903] By: gsar on 1998/04/25 22:27:19 + Log: add AS patch#19 (adds socket layer generation to GenCAPI.pl) + Branch: asperl + ! win32/GenCAPI.pl +____________________________________________________________________________ +[ 902] By: nick on 1998/04/25 16:35:08 + Log: Case sensitive tweak to perldoc.PL + Branch: ansiperl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 901] By: nick on 1998/04/25 15:16:54 + Log: Implement use attrs qw(locked package); + Passes all tests except posix (hangs/dies) in sigaction test after + printing "ok 9". + Branch: ansiperl + ! cv.h ext/attrs/attrs.pm ext/attrs/attrs.xs pp_hot.c +____________________________________________________________________________ +[ 900] By: nick on 1998/04/25 13:58:17 + Log: Auto-insert defined() test in while when test expression is + readline (i.e. <>), glob, readdir, or each. + Branch: ansiperl + + t/op/defins.t + ! op.c pod/perlop.pod +____________________________________________________________________________ +[ 899] By: nick on 1998/04/25 13:14:52 + Log: Resolve ansiperl against win32 branch + Branch: ansiperl + +> (branch 53 files) + - config_H + !> (integrate 227 files) +____________________________________________________________________________ +[ 898] By: gsar on 1998/04/24 17:01:05 + Log: add AS patch#18 + Branch: asperl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/xsubpp win32/GenCAPI.pl +____________________________________________________________________________ +[ 897] By: TimBunce on 1998/04/23 19:49:22 + Log: Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "fix for "Unbalanced string table refcount"" + From: Gurusamy Sarathy + Msg-ID: <199804042251.RAA25527@aatma.engin.umich.edu> + Files: sv.c + + Title: "Allow more lenient switch processing" + From: "John L. Allen" + Msg-ID: <199803251638.LAA22664@gateway.grumman.com> + Files: perl.c + + Title: "Add fourth arg to substr: substr EXPR,OFFSET,LEN,REPLACEMENT" + From: Gisle Aas + Msg-ID: + Files: pod/perlfunc.pod Todo opcode.pl pp.c t/op/substr.t + + Title: "Odd number of elements in hash list." + From: Tom Phoenix + Msg-ID: + Files: MANIFEST pod/perldiag.pod pp.c pp_hot.c t/op/hashwarn.t + + Title: "another destruct_level fix" + From: Gurusamy Sarathy + Msg-ID: <199804030105.UAA04400@aatma.engin.umich.edu> + Files: hv.c + + Title: "bidirectional pipe warning blues" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9804082151.AA20399@claudius.bfsec.bt.co.uk> + Files: doio.c + + Title: "stale pointers after realloc (MEXTEND in pp_print and pp_prtf)" + From: Malcolm Beattie + Msg-ID: <199801191107.LAA17979@sable.ox.ac.uk> + Files: pp_hot.c pp_sys.c + + Title: "unimplemented umask() should return undef not die" + From: kstar@chapin.edu (Kurt D. Starsinic) + Msg-ID: <199803120515.VAA08660@chapin.edu> + Files: pod/perlfunc.pod pp_sys.c + + Title: "warning for: bless $foo, """ + From: Joshua.Pritikin@NewYork2.dmg.deuba.com + Msg-ID: + Files: pod/perldiag.pod pp.c + + ------ DOCUMENTATION ------ + + Title: "Mention SWIG in perlxs.pod" + From: Steve A Fink + Msg-ID: + Files: pod/perlxs.pod + + Title: "fix-up of previous perlre.pod patch" + From: Ted Ashton + Msg-ID: <199803031540.KAA09388@ns.southern.edu> + Files: pod/perlre.pod + + Title: "long list of man page nitpicks" + From: Greg Bacon , Tom Christiansen + + Msg-ID: <199804221844.NAA08338@pluto.cs.uah.edu>, + <199804222204.QAA20805@jhereg.perl.com> + Files: pod/perlapio.pod pod/perlcall.pod pod/perldebug.pod pod/perldelta.pod + pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod + pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod + pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod + pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod + pod/perlre.pod pod/perlref.pod pod/perlrun.pod + pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod + pod/pod2man.PL + + Title: "document that system() does not set $! when it fails" + From: "Mark R. Levinson" + Msg-ID: <199803011946.OAA31942@anaximander.dccs.upenn.edu> + Files: pod/perlfunc.pod + + Title: "Fix pod/roffitall execute permission" + From: lvirden@cas.org + Msg-ID: <1997Nov17.132031.2589892@cor.newman> + Files: pod/roffitall + + Title: "document when split ignores trailing empty fields" + From: Hugo van der Sanden + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "Buglet in Opcode.pm documentation" + From: Horst von Brand + Msg-ID: <199804170349.XAA32445@sleipnir.valparaiso.cl> + Files: ext/Opcode/Opcode.pm + + Title: "Failure to append to perllocal.pod should not be fatal" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Document that IO.pm does not load IO::Select etc" + From: Graham Barr + Msg-ID: <353B48F1.64E35A63@ti.com> + Files: ext/IO/IO.pm + + Title: "Install extensions with bootstrap (again) in $archlib" + From: Achim Bohnet , koenig@kulturbox.de (Andreas J. + Koenig) + Msg-ID: <9804061909.AA12675@o09.xray.mpe.mpg.de>, + + Files: lib/ExtUtils/Install.pm + + Title: "glibc2.0.6 missing MSG_* defines." + From: Andy Dougherty + Msg-ID: + Files: ext/Socket/Socket.xs + + ------ LIBRARY ------ + + Title: "Benchmark.pm: add run-for-some-time mode" + From: Jarkko Hietaniemi + Msg-ID: <199804080647.JAA15136@alpha.hut.fi> + Files: lib/Benchmark.pm + + Title: "Comments added to Carp.pm" + From: Andy Wardley , Chip Salzenberg + , Tom Christiansen + + Msg-ID: <19980422164242.E29222@perl.org>, + <199804222033.OAA17959@jhereg.perl.com>, + <980409182357.ZM21638@bandanna> + Files: lib/Carp.pm + + Title: "chat2.pl fix" + From: Charles Bailey + Msg-ID: <01IVMVF507PO001NKH@cor.newman.upenn.edu> + Files: lib/chat2.pl + + Title: "lib/Pod/Html.pm" + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199710170718.DAA25472@staff1.cso.uiuc.edu>, + <199710180417.AAA19778@staff2.cso.uiuc.edu> + Files: lib/Pod/Html.pm + + Title: "ormaments method in Term/ReadLine.pm causes warning with string + arg." + From: hiroo.hayashi@computer.org + Msg-ID: <199804061519.AAA21907@mail.fb3.so-net.ne.jp> + Files: lib/Term/ReadLine.pm + + ------ OTHER CHANGES ------ + + Title: "ptags broken" + From: Ilya Zakharevich + Msg-ID: <199804120208.WAA29264@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ PORTABILITY - WIN32 ------ + + Title: "win32 tweaks (signals and crypt support)" + From: Gurusamy Sarathy + Msg-ID: <199804170505.BAA06413@aatma.engin.umich.edu> + Files: perl.h win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/win32.c + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Social Contract (2nd Draft) as Porting/Contract" + From: Russ Allbery + Msg-ID: + Files: Porting/Contract + + Title: "Config: Irix 5 hints" + From: kstar@O2.chapin.edu + Msg-ID: <199804061712.NAA22823@O2.chapin.edu> + Files: hints/irix_5.sh + + Title: "VMS patches to 5.004_03" + From: Charles Bailey + Msg-ID: <01IVYJS0L8D200209B@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "hints/netbsd.sh - enable vfork" + From: Andy Dougherty + Msg-ID: + Files: hints/netbsd.sh + + ------ UTILITIES ------ + + Title: "support find2perl -follow" + From: Billy + Msg-ID: + Files: x2p/find2perl.PL + Branch: maint-5.004/perl + + Porting/Contract t/op/hashwarn.t + ! MANIFEST Todo doio.c emacs/ptags embed.h ext/IO/IO.pm + ! ext/Opcode/Opcode.pm ext/Socket/Socket.xs hints/irix_5.sh + ! hints/netbsd.sh hv.c lib/Benchmark.pm lib/Carp.pm + ! lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm + ! lib/Pod/Html.pm lib/Term/ReadLine.pm lib/chat2.pl opcode.h + ! opcode.pl perl.c perl.h pod/perlapio.pod pod/perlcall.pod + ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod + ! pod/perlembed.pod pod/perlfaq2.pod pod/perlfaq3.pod + ! pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq7.pod + ! pod/perlfaq8.pod pod/perlform.pod pod/perlfunc.pod + ! pod/perlguts.pod pod/perlhist.pod pod/perlipc.pod + ! pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod + ! pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + ! pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod pod/pod2man.PL + ! pod/roffitall pp.c pp_hot.c pp_sys.c sv.c t/TEST t/op/gv.t + ! t/op/substr.t vms/vms.c win32/config.bc win32/config.vc + ! win32/config_H.bc win32/config_H.vc win32/win32.c + ! x2p/find2perl.PL +____________________________________________________________________________ +[ 896] By: TimBunce on 1998/04/22 11:49:24 + Log: Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Additional regex-cache patch" + From: Chip Salzenberg + Msg-ID: <19980305104831.38100@cyprus> + Files: pp_ctl.c + + Title: "Conservative C<*x = undef> patch" + From: Chip Salzenberg + Msg-ID: <19980310163310.48509@cyprus> + Files: pod/perldiag.pod pod/perlfunc.pod pp.c sv.c t/op/gv.t + + Title: "Consider @ARGV to be plain files if inplace (-i)" + From: Chip Salzenberg + Msg-ID: <199802042106.QAA04082@nielsenmedia.com> + Files: doio.c + + Title: "Fix semctl for Linux, Sun and SVR4" + From: Graham Barr , lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <3484247D.BB036D39@ti.com>, <9712021313.AA11495@cas.org> + Files: doio.c + + Title: "C entails using C, not C" + From: Gurusamy Sarathy + Msg-ID: <199803070149.UAA12217@aatma.engin.umich.edu> + Files: pod/perlcall.pod pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod + doio.c doop.c ext/DB_File/DB_File.xs + ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs + ext/POSIX/POSIX.xs ext/Socket/Socket.xs gv.c + lib/ExtUtils/typemap mg.c os2/OS2/REXX/REXX.xs + win32/win32.c + + Title: "Make autouse -w-safe" + From: Ilya Zakharevich + Msg-ID: <199803030236.VAA13244@monk.mps.ohio-state.edu> + Files: lib/autouse.pm op.c sv.c + + Title: "Misleading error on close of unopened handle" + From: "M.J.T. Guy" + Msg-ID: + Files: doio.c + + Title: "Confusing error from perl -e "x'"" + From: Hans Mulder + Msg-ID: <1998Mar25.174320.2866352@cor.newman.upenn.edu> + Files: toke.c + + Title: "Add HAS_GNULIBC define" + From: Andy Dougherty + Msg-ID: + Files: config_H config_h.SH + + Title: "h_errno might not be an int" + From: Andy Dougherty + Msg-ID: + Files: pp_sys.c + + Title: "Revised taint hole closer", "Revised taint hole closer" + From: Chip Salzenberg , Ilya Zakharevich + + Msg-ID: <19980310222127.09350@cyprus>, + <199803110554.AAA29157@monk.mps.ohio-state.edu> + Files: doio.c + + Title: "SEGV compiling localised lexical in perl5.004_05t1" + From: Gurusamy Sarathy , h.sanden@elsevier.nl (Hugo + van der Sanden) + Msg-ID: <199803171530.QAA24053@dorlas.elsevier.nl>, + <199803171727.MAA05234@aatma.engin.umich.edu> + Files: op.c t/op/misc.t + + Title: "Stale SP in pp_substr" + From: Stephen McCamant + Msg-ID: + Files: pp.c + + Title: "Statement unlikely to be reached warning" + From: Hans Mulder + Msg-ID: <1997Dec24.171511.2683516@cor.newman> + Files: op.c + + Title: "Tainting propagates from nowhere" + From: Gurusamy Sarathy + Msg-ID: <199803140411.XAA09343@aatma.engin.umich.edu> + Files: pp.c + + Title: "two trivial tweaks to 5.004m5t1" + From: Gurusamy Sarathy + Msg-ID: <199803060553.AAA28461@aatma.engin.umich.edu> + Files: proto.h win32/Makefile + + Title: "unpacking negatives on Alpha" + From: Achim Bohnet + Msg-ID: <9710201503.AA24797@o09.xray.mpe.mpg.de> + Files: pp.c t/op/pack.t + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "Cwd.pm: abs_path() and fast_abs_path() plus code merge" + From: Graham Barr + Msg-ID: <3482F365.4A0486BA@ti.com> + Files: lib/Cwd.pm + + Title: "Math/BigInt.pm, fixed use of undefined value." + From: abigail@fnx.com + Msg-ID: <19980313052452.27365.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Math/BigInt.pm + + Title: "File::Find rewrite" + From: Ilya Zakharevich + Msg-ID: <199803052344.SAA01008@monk.mps.ohio-state.edu> + Files: lib/File/Find.pm + + Title: "efficient version of strict.pm" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: lib/strict.pm + + Title: "Socket occasional SEGV in pack_sockaddr_un" + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + + Title: "Warning on mis-use of 'use lib'" + From: "M.J.T. Guy" , Tom Phoenix + , chip@atlantic.net + Msg-ID: <199801270435.XAA14147@cyprus.atlantic.net>, + , + + Files: lib/lib.pm + + Title: "bug in Class::Struct" + From: Tom Christiansen + Msg-ID: <199803290814.KAA05699@toy.perl.com> + Files: lib/Class/Struct.pm + + Title: "Allow POSIX to export nice()" + From: bkeelerx@iwa.dp.intel.com (Bruce J. Keeler) + Msg-ID: + Files: ext/POSIX/POSIX.pm + + Title: "'use Env' on WinNT/95 fails" + From: Gurusamy Sarathy + Msg-ID: <199803280511.AAA15933@aatma.engin.umich.edu> + Files: lib/Env.pm + + ------ OTHER CHANGES ------ + + Title: "mv-if-diff" + From: Robin Barker + Msg-ID: <14572.9803271806@tempest.cise.npl.co.uk> + Files: mv-if-diff + + ------ PORTABILITY - WIN32 ------ + + Title: "fix various problems with backticks on win32" + From: Gurusamy Sarathy + Msg-ID: <199803070705.CAA15945@aatma.engin.umich.edu> + Files: win32/config_h.PL win32/win32.c + + ------ TESTS ------ + + Title: "Fix bug in locale.t" + From: Jarkko Hietaniemi + Msg-ID: <199801042148.XAA08599@alpha.hut.fi> + Files: t/pragma/locale.t + Branch: maint-5.004/perl + ! config_H config_h.SH doio.c doop.c ext/DB_File/DB_File.xs + ! ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs + ! ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs ext/Socket/Socket.xs + ! gv.c lib/Class/Struct.pm lib/Cwd.pm lib/Env.pm + ! lib/ExtUtils/typemap lib/File/Find.pm lib/Math/BigInt.pm + ! lib/autouse.pm lib/lib.pm lib/strict.pm mg.c mv-if-diff op.c + ! os2/OS2/REXX/REXX.xs pod/perlcall.pod pod/perldiag.pod + ! pod/perlembed.pod pod/perlfunc.pod pod/perlguts.pod + ! pod/perlxs.pod pp.c pp_ctl.c pp_sys.c proto.h sv.c t/op/gv.t + ! t/op/misc.t t/op/pack.t t/pragma/locale.t toke.c + ! win32/Makefile win32/config_h.PL win32/win32.c +____________________________________________________________________________ +[ 895] By: gsar on 1998/04/22 03:13:19 + Log: intern -> sys_intern + Branch: win32/perl + ! embedvar.h interp.sym intrpvar.h win32/win32.h +____________________________________________________________________________ +[ 894] By: gsar on 1998/04/22 02:42:20 + Log: hand-applied patch along with small tweaks + Message-Id: <35400e2a.13538517@smtp1.ibm.net> + Date: Tue, 21 Apr 1998 23:31:06 +0200 + From: jan.dubois@ibm.net (Jan Dubois) + Subject: Re: Per-Interpreter variables for win32.c + Branch: win32/perl + ! embedvar.h interp.sym intrpvar.h perl.c perl.h proto.h + ! win32/makedef.pl win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 893] By: gsar on 1998/04/21 03:42:21 + Log: add AS patch#17 + Branch: asperl + + win32/GenCAPI.pl + ! MANIFEST XSUB.h cv.h ipstdio.h lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp op.c perl.h + ! pp_ctl.c pp_hot.c proto.h sv.h thread.h win32/Makefile + ! win32/dl_win32.xs win32/makefile.mk win32/runperl.c + ! win32/win32.c +____________________________________________________________________________ +[ 892] By: gsar on 1998/04/20 20:51:50 + Log: add AS patch#16 + Branch: asperl + ! globals.c ipdir.h perl.h perlvars.h regcomp.h win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 891] By: gsar on 1998/04/19 23:50:34 + Log: tweak doc for C + Branch: win32/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 890] By: gsar on 1998/04/19 01:08:11 + Log: use a pidtable that grows dynamically for popen() + Message-Id: <3539f434.44835409@smtp1.ibm.net> + Date: Sat, 18 Apr 1998 21:01:27 +0200 + From: jan.dubois@ibm.net (Jan Dubois) + Subject: Re: [PATCH] for bug in 5.004_64 when compiled with MSC++ 4.2 + Branch: win32/perl + ! win32/win32.c +____________________________________________________________________________ +[ 889] By: gsar on 1998/04/17 02:13:58 + Log: support POSIX, enable more locale tests + Branch: win32/perl + ! ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + ! t/lib/posix.t t/pragma/locale.t win32/Makefile + ! win32/makedef.pl win32/makefile.mk +____________________________________________________________________________ +[ 888] By: mbeattie on 1998/04/14 16:22:51 + Log: CC did "<<" instead of ">>" for right-shift on ints. + Branch: perl + ! ext/B/B/CC.pm +____________________________________________________________________________ +[ 887] By: TimBunce on 1998/04/10 17:44:55 + Log: Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Re: die exits with 0" + From: Robin Barker + Files: perl.c t/op/die_exit.t + + Title: "More toke.c commentary; fix oddity" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803251022.LAA01308@dorlas.elsevier.nl> + Files: toke.c + + Title: "for semctl on solaris" + From: Graham Barr + Msg-ID: <34624B80.C014E841@ti.com> + Files: doio.c t/op/ipcmsg.t t/op/ipcsem.t + + ------ DOCUMENTATION ------ + + Title: "Add more 'see also's to perlre.pod.", "Perl regexp /g modifier bug" + From: Ilya Zakharevich , epeschko@den-mdev1 (Ed + Peschko), pjr@watcher.telstra.com.au (Peter Richardson) + Msg-ID: <199803050000.LAA11476@watcher.telecom.com.au>, + <199803050231.VAA19128@monk.mps.ohio-state.edu>, + <199803050605.XAA09785@den-mdev1.co.csgsystems.com> + Files: pod/perlre.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "BigFloat - small neagtive numbers cause panic" + From: Hugo van der Sanden + Msg-ID: <199711201325.NAA09732@crypt.compulink.co.uk> + Files: lib/Math/BigFloat.pm + + Title: "Update Getopt::Long to 2.16" + From: JVromans@Squirrel.nl (Johan Vromans), Johan Vromans + + Msg-ID: <13571.48089.726787.147769@plume.nl.compuware.com>, + <13572.6847.863219.973795@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "New Text::ParseWords" + From: pomeranz@netcom.com (Hal Pomeranz) + Msg-ID: <199710162118.OAA06275@netcom7.netcom.com> + Files: lib/Text/ParseWords.pm t/lib/parsewords.t + + Title: "Fixed Text/Wrap.pm bugs (2)" + From: Jacqui Caren + Msg-ID: <199709291548.QAA08645@toad.ig.co.uk> + Files: lib/Text/Wrap.pm + + Title: "Very *evil* File::CheckTree behavior! (now uses warn/die not + print/exit)" + From: Eryq , Randal Schwartz + Msg-ID: <34B542FD.190A@zeegee.com>, <8cen2i9k6f.fsf@gadget.cscaper.com> + Files: lib/File/CheckTree.pm + + ------ OTHER CHANGES ------ + + Title: "Add ./emacs/ptags" + From: Ilya Zakharevich + Msg-ID: <199803150847.DAA08196@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ TESTS ------ + + Title: "Avoid stat test failure from build in /tmp (tmpfs)", "Build in /tmp" + From: Andy Dougherty , Greg Bacon + , pudge@pobox.com (Chris Nandor) + Msg-ID: <199710171616.LAA13435@crp-201.adtran.com>, + , + + Files: t/op/stat.t + + Title: "for failure with lib/timelocal" + From: "M.J.T. Guy" , jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <34c78f61.2529827@smtp1.ibm.net>, + + Files: t/lib/timelocal.t + + Title: "Make "localhost" related failures more clear" + From: Paul Hoffman + Msg-ID: <199801201859.KAA05686@mail.proper.com> + Files: t/lib/io_sock.t t/lib/io_udp.t + + ------ UTILITIES ------ + + Title: "Let h2xs read multiple header files" + From: Andy Dougherty , Benjamin Sugars + + Msg-ID: , + + Files: utils/h2xs.PL + Branch: maint-5.004/perl + + emacs/ptags t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t + ! MANIFEST doio.c lib/File/CheckTree.pm lib/Getopt/Long.pm + ! lib/Math/BigFloat.pm lib/Text/ParseWords.pm lib/Text/Wrap.pm + ! lib/base.pm perl.c pod/perlre.pod t/lib/io_sock.t + ! t/lib/io_udp.t t/lib/parsewords.t t/lib/timelocal.t + ! t/op/stat.t toke.c utils/h2xs.PL vms/perly_h.vms +____________________________________________________________________________ +[ 886] By: TimBunce on 1998/04/10 14:35:34 + Log: Changes relating primarily to portability. + + ------ CORE LANGUAGE ------ + + Title: "5.004_55: Another round of OS/2 patches" + From: Ilya Zakharevich + Msg-ID: <199803050945.EAA20153@monk.mps.ohio-state.edu> + Files: hints/os2.sh pod/perlguts.pod cop.h perl.h proto.h README.os2 + global.sym lib/ExtUtils/MM_OS2.pm lib/File/Path.pm op.c + os2/Changes os2/Makefile.SHs os2/os2.c os2/perl2cmd.pl + perl.c pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c + t/lib/filecopy.t util.c utils/perldoc.PL + + Title: "VMS: chdir() with empty arg list" + From: lane@duphy4.drexel.edu (Charles Lane) + Msg-ID: <980317125556.222041c7@DUPHY4.Physics.Drexel.Edu> + Files: pp_sys.c + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "ExtUtils/MM_Unix.pm changed to use ld -rpath on IRIX" + From: "W. Phillip Moore" + Msg-ID: <199712011738.MAA21139@zappa.morgan.com> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "[Linux] POSIX::_[PS]C_.+ bug (add HINT_SC_EXIST)" + From: Yutaka OIWA + Msg-ID: <199712251923.EAA08260@tjms1f.is.s.u-tokyo.ac.jp> + Files: ext/POSIX/hints/linux.pl ext/POSIX/POSIX.xs + + Title: "5.004_04-m1] Use HAS_GNULIBC in POSIX.xs" + From: Andy Dougherty + Msg-ID: + Files: ext/POSIX/POSIX.xs + + Title: ""ODBM_File.c", line 275: NULL undefined" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9803091310.AA23264@claudius.bfsec.bt.co.uk> + Files: ext/ODBM_File/ODBM_File.xs + + ------ OTHER CHANGES ------ + Files: + + ------ PORTABILITY - GENERAL ------ + + Title: "5.004_04 QNX getcwd" + From: Norton Allen + Msg-ID: <199802121838.NAA20452@dolores.harvard.edu>, + <199803061511.KAA22346@bottesini.harvard.edu> + Files: hints/qnx.sh lib/Cwd.pm t/op/magic.t + + Title: "hints/netbsd.sh d_setrgid d_setruid" + From: Jarkko Hietaniemi + Msg-ID: <199802281435.QAA10866@alpha.hut.fi> + Files: hints/netbsd.sh + + Title: "osname=unixware, osvers=2.03, archname=i386-unixware + d_casti32=undef" + From: Tom Hughes + Msg-ID: <465398da47%tom@compton.demon.co.uk> + Files: hints/svr4.sh + + Title: "hints/bsdos.sh patch for BSDI 3.1" + From: Jan-Pieter Cornet + Msg-ID: <6fbip6$3cp$1@xs1.xs4all.nl> + Files: hints/bsdos.sh + + Title: "Remove BIND_NOSTART from DynaLoader for HP" + From: Keong Lim + Msg-ID: <01BD1D03.53B65E90@sieplan2.sr.com.au> + Files: ext/DynaLoader/dl_hpux.xs + + Title: "Building Perl on AIX 4+ with shared libraries and dynamic loading" + From: Juan Gallego + Msg-ID: + Files: hints/aix.sh + + Title: "alpha-dec_osf 5.0" + From: Spider Boardman + Msg-ID: <199712232305.SAA08359@Orb.Nashua.NH.US> + Files: hints/dec_osf.sh + + Title: "Off-by-one error with OS2::PrfDB" + From: Ilya Zakharevich + Msg-ID: <199710170920.FAA00390@monk.mps.ohio-state.edu> + Files: os2/OS2/PrfDB/PrfDB.xs + + Title: "5.004_04-m1] Allow overrides in hints/openbsd.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/openbsd.sh + + Title: "5.004_04-m1] Linux shouldn't use -lnet" + From: Andy Dougherty + Msg-ID: + Files: hints/linux.sh + + Title: "5.004_(04|63)] Close VMS security hole" + From: Charles Bailey + Msg-ID: <01IV6LRJCSSC0009C4@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "Re: Perl online documentation on OpenVMS" + From: pvhp@forte.com (Peter Prymmer) + Msg-ID: <9803192143.AA28120@forte.com> + Files: README.vms + + Title: "Perl5.004_04m4t4 *almost* makes it for VMS", "Updated + vms/perly_c.vms and vms/perly_h.vms" + From: Andy Dougherty , Dan Sugalski + , larry@wall.org (Larry Wall) + Msg-ID: <199710151650.JAA29185@wall.org>, + <3.0.3.32.19971014150404.02fdef78@osshe.edu>, + + Files: vms/perly_c.vms + + Title: "Updated, non-wordwrapped, patch to README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980213133828.0092c870@osshe.edu> + Files: README.vms + + Title: "VMS patches to 5.004_03 (excluding installperl and timelocal.t)" + From: Charles Bailey + Msg-ID: <01INZT9G2LZS0006YW@cor.newman.upenn.edu> + Files: lib/File/Basename.pm lib/File/Path.pm vms/config.vms vms/descrip.mms + vms/genconfig.pl vms/test.com vms/vms.c vms/ext/Filespec.pm + vms/ext/filespec.t + + Title: "Re: VMSperl crashes on -Mblib argument" + From: bailey@newman.upenn.edu (Charles Bailey) + Msg-ID: <1997Dec10.004439.2635060@cor.newman> + Files: lib/blib.pm vms/vms.c + + Title: "hints/linux.sh (MkLinux / PPC)" + From: pudge@pobox.com (Chris Nandor) + Msg-ID: + Files: hints/linux.sh + + Title: "hpux.sh hints file clarification suggestion" + From: root@qad.com + Msg-ID: <199802192351.QAA09096@jhereg.perl.com> + Files: hints/hpux.sh + + Title: "new hints/solaris_2.sh" + From: "M.J.T. Guy" + Msg-ID: + Files: hints/solaris_2.sh + Branch: maint-5.004/perl + ! README.os2 README.vms cop.h ext/DynaLoader/dl_hpux.xs + ! ext/ODBM_File/ODBM_File.xs ext/POSIX/POSIX.xs + ! ext/POSIX/hints/linux.pl global.sym hints/aix.sh + ! hints/bsdos.sh hints/dec_osf.sh hints/hpux.sh hints/linux.sh + ! hints/netbsd.sh hints/openbsd.sh hints/os2.sh hints/qnx.sh + ! hints/solaris_2.sh hints/svr4.sh lib/Cwd.pm + ! lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + ! lib/File/Basename.pm lib/File/Path.pm lib/blib.pm op.c + ! os2/Changes os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.xs os2/os2.c + ! os2/perl2cmd.pl perl.c perl.h pod/perlguts.pod pod/pod2man.PL + ! pp_ctl.c pp_hot.c pp_sys.c proto.h t/lib/filecopy.t + ! t/op/magic.t util.c utils/perldoc.PL vms/config.vms + ! vms/descrip.mms vms/ext/Filespec.pm vms/ext/filespec.t + ! vms/genconfig.pl vms/perly_c.vms vms/perly_h.vms vms/test.com + ! vms/vms.c +____________________________________________________________________________ +[ 885] By: gsar on 1998/04/08 01:14:29 + Log: small tweaks to make it compile (doesn't run) + Branch: asperl + ! objpp.h win32/Makefile win32/config.bc win32/config.gc + ! win32/config.vc win32/makefile.mk +____________________________________________________________________________ +[ 884] By: gsar on 1998/04/08 00:14:13 + Log: integrate mainline changes + Branch: asperl + +> Changes5.004 ext/Thread/Thread/Signal.pm + +> lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm + +> lib/ExtUtils/inst t/op/hashwarn.t + ! ObjXSub.h embedvar.h interp.sym intrpvar.h objpp.h + !> (integrate 127 files) +____________________________________________________________________________ +[ 883] By: gsar on 1998/04/06 20:21:20 + Log: make old DomainName() implementation the default (so Win95 + is happy) + Branch: win32/perl + ! win32/win32.c +____________________________________________________________________________ +[ 882] By: gsar on 1998/04/05 23:32:33 + Log: fix memory leaks in offer_nice_chunk() + Branch: win32/perl + ! perl.h sv.c +____________________________________________________________________________ +[ 881] By: gsar on 1998/04/04 23:11:52 + Log: set up PUSHSTACK for __DIE__ and __WARN__ hooks also + Branch: win32/perl + ! cop.h util.c +____________________________________________________________________________ +[ 880] By: gsar on 1998/04/04 22:35:54 + Log: fix refcounting of GvSTASH() when glob becomes nought + (this takes care of the "unbalanced strtab refcount" problem) + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 879] By: gsar on 1998/04/04 21:16:17 + Log: change 866 was incomplete + Branch: win32/perl + ! hv.c +____________________________________________________________________________ +[ 878] By: gsar on 1998/04/04 20:31:56 + Log: fixes for various noises under PERL_DESTRUCT_LEVEL + Branch: win32/perl + ! cop.h perl.c pp_ctl.c +____________________________________________________________________________ +[ 877] By: gsar on 1998/04/04 17:55:30 + Log: integrate mainline + Branch: win32/perl + +> Changes5.004 + !> Changes MANIFEST sv.c t/op/misc.t +____________________________________________________________________________ +[ 876] By: gsar on 1998/04/04 17:26:32 + Log: remove __declspec kludge in sdbm.h in favor of setting a + flag for static symbols + Branch: win32/perl + ! EXTERN.h ext/SDBM_File/sdbm/Makefile.PL + ! ext/SDBM_File/sdbm/sdbm.h +____________________________________________________________________________ +[ 875] By: gsar on 1998/04/04 01:11:57 + Log: fix order of init + Message-Id: <3.0.5.32.19980403135815.009d2440@osshe.edu> + Date: Fri, 03 Apr 1998 13:58:15 PST + From: Dan Sugalski + Subject: [PATCH 5.004_64] perl dies in perl_construct when compiled + with MULTIPLICITY + Branch: win32/perl + ! perl.c +____________________________________________________________________________ +[ 874] By: gsar on 1998/04/04 00:34:59 + Log: the EXTCONST in sdbm.h breaks SDBM on Borland, since + the declared symbol is not in a DLL (so kludge it) + Branch: win32/perl + ! ext/SDBM_File/sdbm/sdbm.h +____________________________________________________________________________ +[ 873] By: TimBunce on 1998/04/03 22:17:40 + Log: Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + Files: lib/FileHandle.pm + Branch: maint-5.004/perl + ! lib/FileHandle.pm +____________________________________________________________________________ +[ 872] By: TimBunce on 1998/04/03 22:01:03 + Log: Documentation and documentation related patches: + + ------ BUILD PROCESS ------ + + Title: "Docs re /usr/bin/perl quasi-standard location" + From: Tom Phoenix + Msg-ID: + Files: INSTALL pod/perlrun.pod + + ------ DOCUMENTATION ------ + + Title: "/RFC|RFC-1305/ non-greedy" + From: Jan-Pieter Cornet + Msg-ID: <6epo02$c4r$1@xs1.xs4all.nl> + Files: pod/perlre.pod + + Title: "5.004_04: perlhist.pod, buildtoc, perltoc.pod" + From: Jarkko Hietaniemi + Msg-ID: <199802191543.RAA29231@alpha.hut.fi> + Files: pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + + Title: "5.004_04: pod/perlfunc.pod: i18n example for localtime()" + From: Jarkko Hietaniemi + Msg-ID: <199711141555.RAA18875@alpha.hut.fi> + Files: pod/perlfunc.pod + + Title: "typo-fix and suggestion for perlguts.pod" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803051543.QAA03097@dorlas.elsevier.nl> + Files: pod/perlguts.pod + + Title: "perlfunc/syscall curiosity" + From: Roderick Schertler , Tkil + + Msg-ID: <199711302259.PAA02134@reptile.scrye.com>, + + Files: pod/perlfunc.pod + + Title: "Document sprintf %#x behaviour for zero value" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Nov5.185959.2539604@cor.newman> + Files: pod/perlfunc.pod + + Title: "NUL termination (was Re: STOP THE PRESSES)" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod + + Title: "Typo fix." + From: abigail@fnx.com + Msg-ID: <19971101120114.1030.qmail@betelgeuse.wayne.fnx.com> + Files: pod/perlop.pod pod/perlvar.pod + + Title: "5.004_63 perlrun.pod: _DEBUG_MSTATS" + From: Achim Bohnet + Msg-ID: <9803181940.AA22587@o09.xray.mpe.mpg.de> + Files: pod/perlrun.pod + + Title: "Re: Conservative C<*x = undef> patch" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perltrap.pod + + Title: "perlfunc.pod for flock()" + From: "Jeremy D. Zawodny" + Msg-ID: <3.0.5.32.19971118203119.00a723e0@woody.wcnet.org> + Files: pod/perlfunc.pod + + Title: "buglet: 'perltoc' not mentioned in perl.pod" + From: Tkil + Msg-ID: <19971127035036.17668.qmail@scrye.com> + Files: pod/perl.pod + + Title: "for() and map() peculiarity" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlsyn.pod + + Title: "Re: new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + Title: "perldsc's debugger x command" + From: Roderick Schertler + Msg-ID: <10669.878352893@eeyore.ibcinc.com> + Files: pod/perldsc.pod + + Title: "perlre.pod" + From: Ted Ashton + Msg-ID: <199802271501.KAA09279@ns.southern.edu> + Files: pod/perlre.pod + + Title: "Re: printf and $\", "printf and $\" + From: Roderick Schertler , Tom Phoenix + , nag + Msg-ID: <199711141918.TAA08096@flirble.org>, + , + Files: pod/perlfunc.pod + + Title: "recv() typo" + From: Roderick Schertler + Msg-ID: <12064.877012073@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "truncate return value" + From: Roderick Schertler + Msg-ID: <5490.878337883@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "update to perlbook.pod" + From: "Nathan V. Patwardhan" , Randal Schwartz + , Stephen Potter + , Tom Phoenix + + Msg-ID: <199803241354.HAA23938@psasolar.psa.pencom.com>, + <199803241441.OAA01261@mediaone.net>, + <8clnu0i05k.fsf@gadget.cscaper.com>, + + Files: pod/perlbook.pod + + Title: "utime documentation" + From: "Brandon S. Allbery KF8NH" , "M.J.T. Guy" + + Msg-ID: <199802180256.VAA11369@speaker.kf8nh.apk.net>, + + Files: pod/perlfunc.pod + + Title: "(well, doc patch) use of // requires successful match" + From: Roderick Schertler + Msg-ID: + Files: pod/perlop.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "MakeMaker PM doc patch and a DIR buglet" + From: Achim Bohnet + Msg-ID: <9711101050.AA13868@o09.xray.mpe.mpg.de> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "bareword clarification for constant.pm" + From: Roderick Schertler + Msg-ID: <6460.878143077@eeyore.ibcinc.com> + Files: lib/constant.pm + + Title: "integer rand - bug or feature?" + From: Roderick Schertler + Msg-ID: + Files: lib/integer.pm + + ------ OTHER CHANGES ------ + + Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + + Title: "perl5.004_61 myconfig updates" + From: Andy Dougherty + Msg-ID: + Files: myconfig + + Title: "small fixups in pod2latex.PL" + From: "Darren/Torin/Who Ever..." + Msg-ID: <873eg6o3v2.fsf@perv.daft.com> + + ------ PORTABILITY - GENERAL ------ + + Title: "Misc doc fixes for README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980121113134.00924a20@osshe.edu> + Files: README.vms + + Title: "moved DynaLib" + From: John Tobey + Msg-ID: <199710182332.XAA21630@remote212> + Files: ext/DynaLoader/DynaLoader.pm.PL + + ------ UTILITIES ------ + + Title: "Searching for FAQs (patch to perldoc)" + From: Piers Cawley , Russ Allbery + Msg-ID: , + + Files: utils/perldoc.PL + + Title: "perldoc" + From: Ted Ashton + Msg-ID: <199802271510.KAA10506@ns.southern.edu> + Files: utils/perldoc.PL + + Title: "perldoc -f not using pod2man" + From: Russ Allbery + Msg-ID: + Files: utils/perldoc.PL + + Title: "perldoc -m should not require pod" + From: Robin Houston + Msg-ID: <199803241319.NAA24777@stringfellow.guardian.co.uk> + Files: utils/perldoc.PL + + Title: "small fix for perldoc in perl 5.004_04" + From: Julian Yip + Msg-ID: + Files: utils/perldoc.PL + Branch: maint-5.004/perl + - ext/DynaLoader/DynaLoader.pm + ! Changes Configure INSTALL README.vms + ! ext/DynaLoader/DynaLoader.pm.PL ext/Socket/Socket.pm + ! lib/ExtUtils/MakeMaker.pm lib/Tie/Hash.pm lib/constant.pm + ! lib/integer.pm myconfig pod/buildtoc pod/checkpods.PL + ! pod/perl.pod pod/perlbook.pod pod/perldelta.pod + ! pod/perldiag.pod pod/perldsc.pod pod/perlfunc.pod + ! pod/perlguts.pod pod/perlhist.pod pod/perllocale.pod + ! pod/perlmod.pod pod/perlop.pod pod/perlre.pod pod/perlrun.pod + ! pod/perlsec.pod pod/perlstyle.pod pod/perlsyn.pod + ! pod/perltoc.pod pod/perltrap.pod pod/perlvar.pod + ! pod/pod2latex.PL toke.c utils/perldoc.PL + +---------------- +Version 5.004_64 +---------------- + +____________________________________________________________________________ +[ 871] By: mbeattie on 1998/04/03 13:38:59 + Log: Update Changes5.004 and Changes, fix MANIFEST + Branch: perl + + Changes + ! Changes5.004 MANIFEST +____________________________________________________________________________ +[ 870] By: mbeattie on 1998/04/03 13:36:29 + Log: Rename Changes to Changes5.004 (via an integrate) + Branch: perl + +> Changes5.004 + - Changes +____________________________________________________________________________ +[ 869] By: mbeattie on 1998/04/03 11:53:00 + Log: Subject: [PATCH] Perl 5.005b1t2/perl5.004_63 (resend) + Date: Wed, 18 Mar 1998 01:24:20 +0100 (MET) + From: Jan-Pieter Cornet + Branch: perl + ! sv.c t/op/misc.t +____________________________________________________________________________ +[ 868] By: mbeattie on 1998/04/03 11:16:26 + Log: Integrate win32 branch into mainline + Branch: perl + !> (integrate 31 files) +____________________________________________________________________________ +[ 867] By: gsar on 1998/04/03 08:47:55 + Log: config.* fixes + Branch: win32/perl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 866] By: gsar on 1998/04/03 07:22:50 + Log: fixup hv_free_ent() to not fail on null HeVAL() + Branch: win32/perl + ! hv.c perl.c +____________________________________________________________________________ +[ 865] By: gsar on 1998/04/03 07:06:12 + Log: integrate mainline + Branch: win32/perl + +> ext/Thread/Thread/Signal.pm t/op/hashwarn.t + !> (integrate 71 files) +____________________________________________________________________________ +[ 864] By: gsar on 1998/04/03 06:59:37 + Log: implement stack-of-stacks so that magic invocations don't + invalidate local stack pointer + Branch: win32/perl + ! av.c cop.h deb.c embed.h embedvar.h global.sym gv.c interp.sym + ! intrpvar.h mg.c op.c perl.c pp.h pp_ctl.c pp_sys.c proto.h + ! scope.c sv.c t/op/runlevel.t thrdvar.h util.c +____________________________________________________________________________ +[ 863] By: gsar on 1998/04/03 01:26:09 + Log: add AS patch#15 + Branch: asperl + ! ipenv.h lib/ExtUtils/MM_Unix.pm perl.c perlenv.h + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/config_sh.PL win32/runperl.c + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 862] By: mbeattie on 1998/04/02 17:08:43 + Log: Subject: [PATCH for 5.004_63] Config_63-04-05.diff + Date: Thu, 2 Apr 1998 11:56:51 -0500 (EST) + From: Andy Dougherty + Branch: perl + ! Configure ext/Socket/Socket.xs myconfig +____________________________________________________________________________ +[ 861] By: mbeattie on 1998/04/02 16:32:53 + Log: Change 854 added { NULL, 0 } to sdbm.h which needs to be {0, 0} + since appropriate headers aren't included. + Branch: perl + ! ext/SDBM_File/sdbm/sdbm.h +____________________________________________________________________________ +[ 860] By: mbeattie on 1998/04/02 16:17:11 + Log: Bumped patchlevel.h to 64 + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 859] By: mbeattie on 1998/04/02 16:16:26 + Log: Subject: Re: [PATCH] 5.004_63: UNICOS 9 + Date: Fri, 20 Mar 1998 19:39:28 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! hints/unicos.sh regcomp.h +____________________________________________________________________________ +[ 858] By: mbeattie on 1998/04/02 16:13:24 + Log: Subject: [PATCH] Re: Odd number of elements in hash list. + Date: Sat, 28 Mar 1998 15:26:46 -0800 (PST) + From: Tom Phoenix + Branch: perl + + t/op/hashwarn.t + ! MANIFEST pod/perldiag.pod pp.c pp_hot.c +____________________________________________________________________________ +[ 857] By: mbeattie on 1998/04/02 16:08:43 + Log: Subject: [PATCH 5.004_(04|63)] Close VMS security hole + Date: Sat, 28 Mar 1998 02:05:03 -0500 (EST) + From: Charles Bailey + Branch: perl + ! vms/vms.c +____________________________________________________________________________ +[ 856] By: mbeattie on 1998/04/02 16:07:44 + Log: Subject: [PATCH] mv-if-diff + Date: Fri, 27 Mar 98 18:06:11 GMT + From: Robin Barker + Branch: perl + ! mv-if-diff +____________________________________________________________________________ +[ 855] By: mbeattie on 1998/04/02 16:06:54 + Log: From: Jan-Pieter Cornet + Subject: Re: [PATCH] [BUG 5.004_63] define/set of PERL_DESTRUCT_LEVEL + Date: Fri, 27 Mar 1998 02:11:21 +0100 (MET) + Subject: [PATCH] another destruct_level fix + Date: Mon, 30 Mar 1998 23:48:12 +0200 (MET DST) + Branch: perl + ! perl.c sv.c +____________________________________________________________________________ +[ 854] By: mbeattie on 1998/04/02 16:03:37 + Log: Subject: Next wave of _63 VMS patches + Date: Thu, 26 Mar 1998 15:11:50 -0500 (EST) + From: Charles Bailey + Branch: perl + ! EXTERN.h INTERN.h ext/SDBM_File/Makefile.PL + ! ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/dba.c + ! ext/SDBM_File/sdbm/dbd.c ext/SDBM_File/sdbm/dbu.c + ! ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/pair.c + ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h + ! ext/Thread/io.t installperl lib/ExtUtils/MM_VMS.pm + ! lib/Net/Ping.pm perldir.h perlsdio.h t/lib/english.t + ! vms/config.vms vms/descrip.mms vms/ext/Filespec.pm + ! vms/ext/Stdio/0README.txt vms/ext/Stdio/Stdio.pm + ! vms/ext/Stdio/Stdio.xs vms/ext/Stdio/test.pl + ! vms/ext/filespec.t vms/genconfig.pl vms/perly_c.vms vms/vms.c + ! vms/vmsish.h +____________________________________________________________________________ +[ 853] By: mbeattie on 1998/04/02 15:55:46 + Log: Subject: [PATCH 5.00463] Confusing error from perl -e "x'" + Date: Wed, 25 Mar 1998 17:43:17 -0500 (EST) + From: Hans Mulder + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 852] By: mbeattie on 1998/04/02 15:54:24 + Log: Subject: [PATCH] small fixups in pod2latex.PL + Date: 25 Mar 1998 13:30:25 -0800 + From: "Darren/Torin/Who Ever..." + Branch: perl + ! pod/pod2latex.PL +____________________________________________________________________________ +[ 851] By: mbeattie on 1998/04/02 15:50:58 + Log: Subject: [PATCH] hints/irix_6.sh with GCC + Date: Tue, 24 Mar 1998 12:25:10 -0800 (EST) + From: kstar@chapin.edu (Kurt D. Starsinic) + Branch: perl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 850] By: mbeattie on 1998/04/02 15:45:33 + Log: Subject: [PATCH] perldoc -m + Date: Tue, 24 Mar 1998 13:19:38 GMT + From: Robin Houston + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 849] By: mbeattie on 1998/04/02 15:42:52 + Log: Subject: [PATCH for 5.004_63] dos-djgpp update + Date: Mon, 23 Mar 1998 14:13:46 +0100 + From: Laszlo Molnar + Branch: perl + ! djgpp/config.over hints/dos_djgpp.sh +____________________________________________________________________________ +[ 848] By: mbeattie on 1998/04/02 15:38:19 + Log: Subject: [PATCH] Stale SP in pp_substr + Date: Thu, 19 Mar 1998 21:28:02 -0600 (CST) + From: Stephen McCamant + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 847] By: mbeattie on 1998/04/02 15:36:33 + Log: Add missing export of "nice" to ext/POSIX/POSIX.pm (Phil Tait) + Branch: perl + ! ext/POSIX/POSIX.pm +____________________________________________________________________________ +[ 846] By: mbeattie on 1998/04/02 15:34:36 + Log: Subject: [PATCH] 5.004_63: further -e patching + Date: Wed, 18 Mar 1998 23:21:08 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! perl.c pod/perldiag.pod +____________________________________________________________________________ +[ 845] By: mbeattie on 1998/04/02 15:25:18 + Log: Andy Dougherty's configuration patches (Config_63-01 up to 04). + Branch: perl + ! Configure INSTALL Policy_sh.SH Porting/Glossary + ! Porting/config.sh Porting/config_H config_h.SH + ! ext/POSIX/POSIX.xs handy.h hints/hpux.sh myconfig perlsock.h + ! pp.c pp_sys.c regexec.c +____________________________________________________________________________ +[ 844] By: mbeattie on 1998/04/02 14:28:17 + Log: Subject: [PATCH 5.004_63] perlrun.pod: PERL_DEBUG_MSTATS + Date: Wed, 18 Mar 1998 20:40:19 +0100 + From: Achim Bohnet + Branch: perl + ! pod/perlrun.pod +____________________________________________________________________________ +[ 843] By: mbeattie on 1998/04/02 14:26:52 + Log: From: Dan Sugalski + Subject: 5.004_63 picky compiler fixes [PATCH] + Date: Wed, 18 Mar 1998 09:36:32 -0800 + Subject: [PATCH 5.004_63] Fix function prototype with long doubles + Date: Wed, 18 Mar 1998 14:48:19 -0800 + Branch: perl + ! ext/POSIX/POSIX.xs ext/Thread/Thread.xs vms/vms.c +____________________________________________________________________________ +[ 842] By: mbeattie on 1998/04/02 14:22:41 + Log: From: Stephen Potter + Subject: Re: doc: perlrun typo + Date: Wed, 18 Mar 1998 10:06:55 -0600 + Subject: Re: [PATCH 5.004_63] PerlLIO abstraction cleanup + Date: Tue, 24 Mar 1998 21:20:51 -0600 + Branch: perl + ! mg.c perl.c pod/perlrun.pod pp_hot.c pp_sys.c util.c +____________________________________________________________________________ +[ 841] By: mbeattie on 1998/04/02 14:17:31 + Log: Subject: [PATCH] Add "Full 64 bit support" to Todo; document Todo in pumpkin.pod + Date: Wed, 18 Mar 1998 12:44:58 +0100 + From: Dominic Dunlop + Branch: perl + ! Porting/pumpkin.pod Todo +____________________________________________________________________________ +[ 840] By: mbeattie on 1998/04/02 14:14:22 + Log: Subject: [PATCH] Configure hints/ patches + Date: Wed, 18 Mar 1998 02:47:38 +0100 (MET) + From: Jan-Pieter Cornet + Branch: perl + ! hints/linux.sh hints/qnx.sh +____________________________________________________________________________ +[ 839] By: mbeattie on 1998/04/02 14:13:13 + Log: Remove duplicate code in cygwin32/perlgcc (Blair Zajac) + Branch: perl + ! cygwin32/perlgcc +____________________________________________________________________________ +[ 838] By: gsar on 1998/03/28 05:01:57 + Log: fix Env.pm to weed out illegal names + Branch: win32/perl + ! lib/Env.pm +____________________________________________________________________________ +[ 837] By: gsar on 1998/03/28 04:39:43 + Log: fix typo in makefile.mk + Branch: win32/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 836] By: gsar on 1998/03/23 17:40:15 + Log: add file: to installhtml URLs + Branch: win32/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 835] By: mbeattie on 1998/03/18 11:03:11 + Log: Add Thread::Signal to run signal handlers reliably in a new thread + Branch: perl + + ext/Thread/Thread/Signal.pm + ! MANIFEST ext/Thread/Thread.xs + +---------------- +Version 5.004_63 +---------------- + +____________________________________________________________________________ +[ 834] By: mbeattie on 1998/03/17 16:19:10 + Log: Policy_sh.SH had extra $ in pager=$pager comment (Hallvard B Furuseth) + Branch: perl + ! Policy_sh.SH +____________________________________________________________________________ +[ 833] By: mbeattie on 1998/03/17 16:11:02 + Log: Integrate win32 branch into mainline. + Branch: perl + !> regcomp.c win32/config.bc win32/config.gc win32/config.vc + !> win32/config_H.bc win32/config_H.gc win32/config_H.vc + !> win32/win32.c +____________________________________________________________________________ +[ 832] By: gsar on 1998/03/17 14:32:39 + Log: propagate bugfix @ change831 from asperl + Branch: win32/perl + ! regcomp.c +____________________________________________________________________________ +[ 831] By: gsar on 1998/03/17 14:02:51 + Log: fix buggy order of free() in regcomp.c (from AS) + Branch: asperl + ! regcomp.c +____________________________________________________________________________ +[ 830] By: gsar on 1998/03/17 01:10:54 + Log: add a part of AS patch#14, backout incomplete variable + name changes for gcc. Builds and tests under VC/BC once again. + Branch: asperl + ! bytecode.h mg.c pp.c pp_ctl.c pp_hot.c toke.c +____________________________________________________________________________ +[ 829] By: gsar on 1998/03/16 23:49:18 + Log: stray tweak to win32.c + Branch: win32/perl + ! win32/win32.c +____________________________________________________________________________ +[ 828] By: gsar on 1998/03/16 22:06:03 + Log: update win32/config* files + Branch: win32/perl + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 827] By: gsar on 1998/03/16 19:09:30 + Log: trivial integrate of mainline + Branch: win32/perl + +> lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm + +> lib/ExtUtils/inst + !> (integrate 61 files) +____________________________________________________________________________ +[ 826] By: mbeattie on 1998/03/16 16:39:23 + Log: newCONSTSUB had private MY_start_subparse. + Branch: perl + ! op.c +____________________________________________________________________________ +[ 825] By: mbeattie on 1998/03/16 16:36:55 + Log: Missing dTHR in hv_fetch_ent when statics moved to thread struct. + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 824] By: mbeattie on 1998/03/16 16:27:43 + Log: Added missing entry for lib/ExtUtils/Packlist.pm to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 823] By: mbeattie on 1998/03/16 16:26:02 + Log: Missed p4 add of lib/ExtUtils/Packlist.pm in change 814. + Branch: perl + + lib/ExtUtils/Packlist.pm +____________________________________________________________________________ +[ 822] By: mbeattie on 1998/03/16 16:22:58 + Log: Bump patchlevel.h to 63. + Branch: perl + ! ext/IO/IO.xs patchlevel.h + !> (integrate 41 files) +____________________________________________________________________________ +[ 821] By: mbeattie on 1998/03/16 16:18:35 + Log: newCONSTSUB added (XSUB equivalent for inlinable sub () { 123 }). + Subject: Bundling builtin.pm and newCONSTSUB with the core? + From: jan.dubois@ibm.net (Jan Dubois) + Date: Sun, 15 Mar 1998 19:09:05 +0100 + Branch: perl + ! embed.h global.sym op.c pod/perlguts.pod proto.h +____________________________________________________________________________ +[ 820] By: mbeattie on 1998/03/16 16:02:50 + Log: Subject: [PATCH] STRESS_REALLOC + Date: Fri, 13 Mar 1998 22:28:19 -0600 (CST) + From: Stephen McCamant + Branch: perl + ! malloc.c perl.c scope.c +____________________________________________________________________________ +[ 819] By: mbeattie on 1998/03/16 16:01:06 + Log: Subject: [BUG+PATCH] _62 with -DDEBUGGING and -Duseperlio + Date: Fri, 13 Mar 1998 23:21:25 +0100 + From: Jan-Pieter Cornet + Branch: perl + ! perly.c +____________________________________________________________________________ +[ 818] By: mbeattie on 1998/03/16 15:59:16 + Log: Subject: [Configure PATCH] for OS/2 + Date: Fri, 13 Mar 1998 16:18:12 -0500 (EST) + From: Ilya Zakharevich + [Two hunks to Configure failed to apply due to clashes] + Branch: perl + ! Configure hints/os2.sh +____________________________________________________________________________ +[ 817] By: mbeattie on 1998/03/16 15:55:28 + Log: Subject: [PATCH 5.004_62] VMS updates (direct) + Date: Thu, 12 Mar 1998 16:02:29 -0500 (EST) + From: Charles Bailey + [Needed manual tweaks on vms/config.vms since it clashed with other + patches. I may have got it wrong.] + Branch: perl + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/Mksymlists.pm perl.h pp.c pp_hot.c regcomp.c + ! regcomp.h utils/perldoc.PL vms/config.vms vms/descrip.mms + ! vms/ext/Stdio/Stdio.pm vms/ext/filespec.t vms/fndvers.com + ! vms/gen_shrfls.pl vms/genconfig.pl vms/sockadapt.h + ! vms/test.com vms/vms.c vms/vmsish.h +____________________________________________________________________________ +[ 816] By: mbeattie on 1998/03/16 15:26:04 + Log: Subject: [PATCH] Let h2xs read multiple header files + Date: Tue, 10 Mar 1998 09:35:42 -0500 (EST) + From: Benjamin Sugars + Branch: perl + ! utils/h2xs.PL +____________________________________________________________________________ +[ 815] By: mbeattie on 1998/03/16 15:24:12 + Log: Subject: Re: Almost OK: Perl 5.004_62 on VMS 7.1 + Date: Mon, 09 Mar 1998 09:18:56 -0800 + From: Dan Sugalski + Branch: perl + ! vms/config.vms +____________________________________________________________________________ +[ 814] By: mbeattie on 1998/03/16 13:17:14 + Log: Subject: PATCH for 5.004_62 : Add .packlist handling classes to ExtUtils + Date: Sun, 08 Mar 1998 12:50:23 +0000 + From: Alan Burlison + plus manual update of MANIFEST + Branch: perl + + lib/ExtUtils/Installed.pm lib/ExtUtils/inst + ! MANIFEST installman installperl lib/ExtUtils/Install.pm + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 813] By: mbeattie on 1998/03/16 13:08:55 + Log: From: Blair Zajac + Subject: PATCH: util.c and util.h function declarations do not match + Date: Fri, 6 Mar 1998 10:29:29 -0800 (PST) + Subject: PATCH: cgywin32 patch for perlgcc + Date: Fri, 6 Mar 1998 11:15:36 -0800 (PST) + Subject: PATCH: perl5.004_62 on cygwin32 + Date: Fri, 6 Mar 1998 11:57:35 -0800 (PST) + Branch: perl + ! Configure cygwin32/perlgcc cygwin32/perlld pp_sys.c x2p/util.c +____________________________________________________________________________ +[ 812] By: mbeattie on 1998/03/16 12:55:39 + Log: From: Andy Dougherty + Subject: [PATCH 5.004_62} Config_62-01 patch available. + Date: Mon, 9 Mar 1998 15:23:33 -0500 (EST) + Subject: [PATCH 5.004_62] Tiny hint file updates + Date: Mon, 9 Mar 1998 13:21:46 -0500 (EST) + Branch: perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH ext/ODBM_File/ODBM_File.xs handy.h hints/aix.sh + ! hints/dec_osf.sh hints/dos_djgpp.sh hints/freebsd.sh + ! hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh + ! hints/os2.sh hints/solaris_2.sh patchlevel.h perl.c perl.h + ! perllio.h pod/perldiag.pod pp_sys.c vms/config.vms +____________________________________________________________________________ +[ 811] By: mbeattie on 1998/03/16 12:13:55 + Log: DOS djgpp updates: + From: Laszlo Molnar + Subject: [PATCH for 5.004_61] dos-djgpp update + Date: Fri, 6 Mar 1998 10:41:01 +0100 + Subject: [PATCH 5.004_62] dos-djgpp update + Date: Thu, 12 Mar 1998 13:34:51 +0100 + Branch: perl + ! djgpp/config.over hints/dos_djgpp.sh +____________________________________________________________________________ +[ 810] By: gsar on 1998/03/16 08:48:17 + Log: integrate mainline + Branch: win32/perl + !> pp_sys.c +____________________________________________________________________________ +[ 809] By: gsar on 1998/03/16 08:44:37 + Log: various changes to get asperl working under Borland + (passes all tests when built under PERL_OBJECT) + Branch: asperl + ! ObjXSub.h ext/Opcode/Opcode.xs globals.c mg.c objpp.h op.c + ! perl.h perly.c perly.c.diff pp.c pp_ctl.c pp_hot.c pp_sys.c + ! proto.h scope.h sv.c toke.c win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/makedef.pl + ! win32/makefile.mk win32/runperl.c win32/win32.c win32/win32.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 808] By: gsar on 1998/03/12 19:50:20 + Log: set sockets to nonoverlapped mode for every thread + Message-Id: <35081FE4.965A484D@enteract.com> + Date: Thu, 12 Mar 1998 11:48:20 CST + From: Steve Nielsen + Subject: [PATCH 5.004_62] win32: set sockopt on a per-thread basis + Branch: win32/perl + ! win32/win32.h win32/win32sck.c +____________________________________________________________________________ +[ 807] By: gsar on 1998/03/12 19:26:54 + Log: add AS patch#13 + Branch: asperl + ! win32/Makefile +____________________________________________________________________________ +[ 806] By: gsar on 1998/03/12 00:51:08 + Log: added AS patch#12 with minor changes + Branch: asperl + ! ObjXSub.h bytecode.h byterun.c doio.c iplio.h + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp objpp.h perl.c + ! perllio.h proto.h regcomp.c win32/Makefile win32/config_h.PL + ! win32/runperl.c +____________________________________________________________________________ +[ 805] By: gsar on 1998/03/10 20:35:10 + Log: reinstate some standard sig_names to avoid noise from + modules (and in hopes of making them _do_ something in future) + Branch: win32/perl + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 804] By: gsar on 1998/03/10 20:33:05 + Log: mingw32 tweaks + Branch: win32/perl + ! win32/makefile.mk win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 803] By: gsar on 1998/03/09 20:56:07 + Log: tweak Win32::DomainName() implementation + Branch: win32/perl + ! win32/Makefile win32/win32.c +____________________________________________________________________________ +[ 802] By: gsar on 1998/03/09 03:51:01 + Log: merge C patch, also moved statics in + [ah]v.c to thrdvar.h + Branch: win32/perl + ! av.c embedvar.h hv.c scope.c t/op/local.t thrdvar.h +____________________________________________________________________________ +[ 801] By: gsar on 1998/03/09 02:38:35 + Log: minor win32 support fixes + - add a better implementation of Win32::DomainName() (as + suggested by Jutta M. Klebe ) + - fix opendir() emulation was unsafe what given long paths + Branch: win32/perl + ! win32/win32.c +____________________________________________________________________________ +[ 800] By: nick on 1998/03/07 09:36:41 + Log: There has been a 'thaw' in config.h (the ICE has gone ;-)) + So pp_sys.c needs tweaking otherwise it does not believe getservby*() + exist. (Breaks libnet). + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 799] By: gsar on 1998/03/07 07:51:28 + Log: integrate mainline changes + Branch: asperl + !> (integrate 111 files) +____________________________________________________________________________ +[ 798] By: gsar on 1998/03/07 07:01:55 + Log: integrate mainline + Branch: win32/perl + !> myconfig patchlevel.h +____________________________________________________________________________ +[ 797] By: gsar on 1998/03/07 06:49:49 + Log: provide our own popen()/pclose() to fix problems with qx//: + - qx// used to always invoke the shell, now does so only when needed + - qx// didn't respect PERL5SHELL, now does + Branch: win32/perl + ! lib/ExtUtils/typemap win32/config_h.PL win32/win32.c +____________________________________________________________________________ +[ 796] By: gsar on 1998/03/07 01:37:10 + Log: a missed s/sp/SP/ + Branch: win32/perl + ! lib/ExtUtils/typemap pod/perlcall.pod +____________________________________________________________________________ +[ 795] By: gsar on 1998/03/07 01:05:21 + Log: change all 'sp' to 'SP' in code and in the docs. Explicitly + mention that local stack pointer should be called SP. This makes the + API safer from source incompatibilities down the line. + Branch: win32/perl + ! av.c doio.c doop.c ext/DB_File/DB_File.xs + ! ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs + ! ext/POSIX/POSIX.xs ext/Socket/Socket.xs ext/Thread/Thread.xs + ! gv.c mg.c op.c os2/OS2/REXX/REXX.xs perl.c pod/perlcall.pod + ! pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod pp.c + ! pp_ctl.c pp_hot.c pp_sys.c util.c + +---------------- +Version 5.004_62 +---------------- + +____________________________________________________________________________ +[ 794] By: mbeattie on 1998/03/06 09:38:08 + Log: Subject: [PATCH] perl5.004_61 myconfig updates + Date: Thu, 5 Mar 1998 15:10:54 -0500 (EST) + From: Andy Dougherty + Branch: perl + ! myconfig +____________________________________________________________________________ +[ 793] By: mbeattie on 1998/03/06 09:36:37 + Log: Bump patchlevel.h to 62. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 792] By: mbeattie on 1998/03/06 09:35:57 + Log: Integrate win32 branch into mainline. + Branch: perl + !> bytecode.h op.c proto.h scope.c win32/Makefile win32/config.bc + !> win32/config.gc win32/config.vc win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 791] By: gsar on 1998/03/06 06:00:08 + Log: various + - s/PerlIO_fread/PerlIO_read/, the former doesn't exist + - add missing prototypes + - regenerate win32/config*.?c + Branch: win32/perl + ! bytecode.h proto.h win32/config.bc win32/config.gc + ! win32/config.vc win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc win32/makefile.mk +____________________________________________________________________________ +[ 790] By: gsar on 1998/03/06 03:19:23 + Log: fix typo in Makefile + Branch: win32/perl + ! win32/Makefile +____________________________________________________________________________ +[ 789] By: gsar on 1998/03/05 22:55:53 + Log: integrate mainline + Branch: win32/perl + !> (integrate 47 files) +____________________________________________________________________________ +[ 788] By: gsar on 1998/03/05 20:02:09 + Log: added AS patch#11 + Message-Id: <01BD4820.AFC70110.dougl@ActiveState.com> + Date: Thu, 05 Mar 1998 10:23:04 PST + From: Douglas Lankshear + + This patch fixes a bug I introduced removing duplicate code. + -- Doug + Branch: asperl + ! ObjXSub.h objpp.h win32/runperl.c +____________________________________________________________________________ +[ 787] By: gsar on 1998/03/05 19:56:17 + Log: add Nick's dTHR fixes + Branch: win32/perl + ! op.c scope.c +____________________________________________________________________________ +[ 786] By: gsar on 1998/03/05 19:54:49 + Log: maintpatch + Message-Id: <199803050749.CAA15206@Orb.Nashua.NH.US> + Date: Thu, 05 Mar 1998 02:49:46 EST + From: Spider Boardman + Subject: [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void + Branch: win32/perl + ! scope.c +____________________________________________________________________________ +[ 785] By: mbeattie on 1998/03/05 19:12:14 + Log: Subject: [5.004_61 PATCH] Make incompatible changes to RE engine NOW + Date: Wed, 4 Mar 1998 23:55:54 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! op.c proto.h regcomp.c regexp.h util.c +____________________________________________________________________________ +[ 784] By: mbeattie on 1998/03/05 19:11:09 + Log: Subject: [PATCH] Re: perl 5.0061 unable to build on sparc 5 Sol2.5.1 threads. + Date: Wed, 4 Mar 1998 10:18:03 GMT + From: Nick Ing-Simmons + Branch: perl + ! atomic.h +____________________________________________________________________________ +[ 783] By: mbeattie on 1998/03/05 19:09:16 + Log: Subject: Configure patches -01 and -02 for 5.004_61. + Date: Tue, 3 Mar 1998 16:41:16 -0500 (EST) + From: Andy Dougherty + Branch: perl + ! Configure INSTALL Policy_sh.SH Porting/Glossary + ! Porting/config.sh Porting/config_H Porting/pumpkin.pod + ! config_h.SH handy.h hints/README.hints hints/aix.sh + ! hints/linux.sh hints/solaris_2.sh hints/unicos.sh + ! makedepend.SH myconfig pp_sys.c +____________________________________________________________________________ +[ 782] By: mbeattie on 1998/03/05 19:05:23 + Log: Subject: [PATCH] Compiling with OP_IN_REGISTER + Date: 03 Mar 1998 18:05:07 +0100 + From: Gisle Aas + Branch: perl + ! perl.h pp_ctl.c +____________________________________________________________________________ +[ 781] By: mbeattie on 1998/03/05 19:04:34 + Log: Subject: [PATCH] Make autouse -w-safe + Date: Mon, 2 Mar 1998 21:36:02 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! lib/autouse.pm op.c sv.c +____________________________________________________________________________ +[ 780] By: mbeattie on 1998/03/05 19:02:50 + Log: Subject: [PATCH] External symbol re_croak2 + Date: 02 Mar 1998 13:00:45 +0100 + From: Gisle Aas + Branch: perl + ! regcomp.c regcomp.h +____________________________________________________________________________ +[ 779] By: mbeattie on 1998/03/05 19:01:25 + Log: Subject: [PATCH 5.004_61] Miscellaneous minor fixes + Date: Mon, 02 Mar 1998 01:48:27 -0500 (EST) + From: bailey@newman.upenn.edu (Charles Bailey) + Branch: perl + ! bytecode.h embedvar.h ext/B/Makefile.PL ext/B/byteperl.c + ! ext/Thread/Makefile.PL lib/File/Path.pm patchlevel.h perldir.h + ! sv.h +____________________________________________________________________________ +[ 778] By: mbeattie on 1998/03/05 18:53:13 + Log: Subject: [PATCH 5.004_61] USHRT range limit macros + Date: Mon, 02 Mar 1998 01:41:41 -0500 (EST) + From: bailey@newman.upenn.edu (Charles Bailey) + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 777] By: mbeattie on 1998/03/05 18:50:25 + Log: Subject: [PATCH 5.004_61] File::Basename taint fix (revised) + Date: Mon, 02 Mar 1998 01:39:47 -0500 (EST) + From: bailey@newman.upenn.edu (Charles Bailey) + Branch: perl + ! lib/File/Basename.pm +____________________________________________________________________________ +[ 776] By: mbeattie on 1998/03/05 18:49:15 + Log: Subject: [PATCH] Take out version number in perlguts (perl5.004_61) + Date: 01 Mar 1998 15:16:03 +0100 + From: Gisle Aas + Branch: perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 775] By: mbeattie on 1998/03/05 18:48:05 + Log: Subject: Re: [PATCH] 5.004_61: Makefile.SH (Re: 5.004_61: annoyingly missing patch) + Date: Sun, 1 Mar 1998 12:14:44 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! Makefile.SH perl_exp.SH +____________________________________________________________________________ +[ 774] By: mbeattie on 1998/03/05 18:46:32 + Log: Subject: Almost OK: 5.004_61 (threads, perlio) + Date: Sun, 1 Mar 1998 02:02:47 -0500 + From: Spider Boardman + Branch: perl + ! bytecode.h bytecode.pl byterun.c byterun.h perlsdio.h +____________________________________________________________________________ +[ 773] By: mbeattie on 1998/03/05 18:43:57 + Log: Subject: [PATCH 5.004_61] print sort {-1} 1..10; hangs + Date: Sat, 28 Feb 1998 15:51:14 -0500 (EST) + From: Hans Mulder + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 772] By: mbeattie on 1998/03/05 18:39:25 + Log: Subject: [PATCH] 5.004_61: Makefile.SH: 'ok' target needs perlbug... + Date: Sat, 28 Feb 1998 17:06:41 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 771] By: mbeattie on 1998/03/05 18:38:32 + Log: Subject: [PATCH] 5.004_61: hints/netbsd.sh + Date: Sat, 28 Feb 1998 16:35:32 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! hints/netbsd.sh +____________________________________________________________________________ +[ 770] By: mbeattie on 1998/03/05 18:36:50 + Log: Add byterun.c to cflags.SH (Dominic Dunlop ) + Branch: perl + ! cflags.SH +____________________________________________________________________________ +[ 769] By: mbeattie on 1998/03/05 18:34:35 + Log: Change getc/fread to PerlIO_getc/fread in bytecode.h: + Subject: [PATCH 5.004_61] bunch of small patches + Date: Fri, 27 Feb 1998 20:03:29 -0500 (EST) + From: Andrew Cohen + Branch: perl + ! bytecode.h +____________________________________________________________________________ +[ 768] By: mbeattie on 1998/03/05 18:13:06 + Log: Integrate win32 branch into mainline. + Branch: perl + !> (integrate 53 files) +____________________________________________________________________________ +[ 767] By: TimBunce on 1998/03/05 11:48:09 + Log: Update to change 744. + Branch: maint-5.004/perl + ! lib/ExtUtils/Install.pm +____________________________________________________________________________ +[ 765] By: TimBunce on 1998/03/05 11:24:24 + Log: Update embed.h after make regen_headers. + Branch: maint-5.004/perl + ! embed.h +____________________________________________________________________________ +[ 764] By: TimBunce on 1998/03/05 11:05:13 + Log: APPLLIB_EXP now has arch and version dirs added to @INC + Branch: maint-5.004/perl + ! perl.c +____________________________________________________________________________ +[ 763] By: TimBunce on 1998/03/05 11:01:38 + Log: Added hints/openbsd.sh and t/op/pos.t to MANIFEST + Added MAINT_TRIAL_1 local patch label to patchlevel.h + Removed win32/win32io.c and win32/win32io.h from repository + Branch: maint-5.004/perl + - win32/win32io.c win32/win32io.h + ! MANIFEST patchlevel.h +____________________________________________________________________________ +[ 762] By: TimBunce on 1998/03/05 10:05:34 + Log: Title: "5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)" + From: Spider Boardman + Files: scope.c + Branch: maint-5.004/perl + ! scope.c +____________________________________________________________________________ +[ 761] By: TimBunce on 1998/03/05 10:03:10 + Log: Title: "properly refcount localization, fix C" + From: Gurusamy Sarathy + Msg-ID: <199802191207.MAA10742@toad.ig.co.uk> + Files: av.c hv.c scope.c t/op/local.t + Branch: maint-5.004/perl + ! av.c hv.c scope.c t/op/local.t +____________________________________________________________________________ +[ 760] By: gsar on 1998/03/04 20:58:21 + Log: added AS patch#10 + Message-Id: <01BD4691.963D1670.dougl@ActiveState.com> + Date: Tue, 03 Mar 1998 10:46:13 PST + From: Douglas Lankshear + Subject: [PATCH] + + Here's a patch to win32/dl_win32.xs that is a fix for the lookup of statically + linked modules. + + -- Doug + Branch: asperl + ! win32/dl_win32.xs +____________________________________________________________________________ +[ 759] By: TimBunce on 1998/03/04 18:46:41 + Log: Update patchls utility + Branch: maint-5.004/perl + ! Porting/patchls +____________________________________________________________________________ +[ 758] By: TimBunce on 1998/03/04 17:07:06 + Log: perldoc -f now uses pager if text is too long for screen + Branch: maint-5.004/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 757] By: TimBunce on 1998/03/04 16:57:04 + Log: Added OpenBSD hint file from + Document 'warn with no args' behaviour, from + Branch: maint-5.004/perl + + hints/openbsd.sh + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 756] By: TimBunce on 1998/03/04 16:48:40 + Log: Fix for new gnulibc stdio.h when using sfio+perlio + Branch: maint-5.004/perl + ! perlsdio.h +____________________________________________________________________________ +[ 755] By: TimBunce on 1998/03/04 16:47:08 + Log: Fixed typo in vms/ext/Stdio/Stdio.pm AUTOLOAD + Added details of split in scalar context to perlfunc.pod + Branch: maint-5.004/perl + ! pod/perlfunc.pod vms/ext/Stdio/Stdio.pm +____________________________________________________________________________ +[ 754] By: TimBunce on 1998/03/04 16:35:58 + Log: Updated perl -v info to include reference to docs and home page. + Branch: maint-5.004/perl + ! perl.c +____________________________________________________________________________ +[ 753] By: TimBunce on 1998/03/04 16:31:29 + Log: Updated hints/bsdos.sh for BSD/OS 3.1 + Fixed typo in pod/perlsyn.pod + Added workaround for old gmake in ext/SDBM_File/sdbm/Makefile.PL + Fixed typo in ext/GDBM_File/GDBM_File.pm + Branch: maint-5.004/perl + ! ext/GDBM_File/GDBM_File.pm ext/SDBM_File/sdbm/Makefile.PL + ! hints/bsdos.sh pod/perlsyn.pod +____________________________________________________________________________ +[ 752] By: TimBunce on 1998/03/04 15:49:19 + Log: Changed bug address in README to perlbug@perl.com + Changed Copyright in perl.c to 1998 + Added op/pos.t test from Robin Houston + Branch: maint-5.004/perl + + t/op/pos.t + ! README perl.c +____________________________________________________________________________ +[ 751] By: TimBunce on 1998/03/04 14:47:15 + Log: Make t/comp/require.t and t/lib/ph.t executable in repository + Branch: maint-5.004/perl + ! t/comp/require.t t/lib/ph.t +____________________________________________________________________________ +[ 750] By: TimBunce on 1998/03/04 13:29:58 + Log: Added dTHR definition to ease backwards compatibility for XS + source code from 5.005. + Branch: maint-5.004/perl + ! perl.h +____________________________________________________________________________ +[ 749] By: TimBunce on 1998/03/04 12:19:19 + Log: Title: "rename local 'op' variables to 'o'", #F114 + From: Gurusamy Sarathy + Files: op.h opcode.h proto.h dump.c op.c opcode.pl pp_ctl.c run.c scope.c + toke.c + Branch: maint-5.004/perl + ! dump.c op.c op.h opcode.h opcode.pl pp_ctl.c proto.h run.c + ! scope.c toke.c +____________________________________________________________________________ +[ 748] By: TimBunce on 1998/03/04 12:12:27 + Log: Title: "consolidated win32 patch", #F112 + From: Gurusamy Sarathy + Files: MANIFEST pod/perlfaq2.pod pod/perlrun.pod win32/include/sys/socket.h + EXTERN.h INTERN.h dosish.h lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm t/TEST + t/harness win32/win32.h win32/win32iop.h README.win32 + doio.c installhtml installperl pp_sys.c win32/Makefile + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/config_h.PL win32/config_sh.PL + win32/dl_win32.xs win32/makedef.pl win32/makefile.mk + win32/perllib.c win32/runperl.c win32/win32.c + win32/win32sck.c win32/bin/perlglob.pl x2p/a2p.h x2p/a2p.c + x2p/a2py.c + Branch: maint-5.004/perl + + win32/bin/perlglob.pl + ! EXTERN.h INTERN.h MANIFEST README.win32 doio.c dosish.h + ! installhtml installperl lib/ExtUtils/Command.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + ! lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm + ! pod/perlfaq2.pod pod/perlrun.pod pp_sys.c t/TEST t/harness + ! win32/Makefile win32/config.bc win32/config.vc + ! win32/config_H.bc win32/config_H.vc win32/config_h.PL + ! win32/config_sh.PL win32/dl_win32.xs + ! win32/include/sys/socket.h win32/makedef.pl win32/makefile.mk + ! win32/perllib.c win32/runperl.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32sck.c x2p/a2p.c x2p/a2p.h + ! x2p/a2py.c +____________________________________________________________________________ +[ 747] By: TimBunce on 1998/03/04 11:59:57 + Log: Title: "initialize @INC in ph.t, and fix up MANIFEST", #F111 + From: Gurusamy Sarathy + Files: MANIFEST t/lib/ph.t + Branch: maint-5.004/perl + ! MANIFEST t/lib/ph.t +____________________________________________________________________________ +[ 746] By: TimBunce on 1998/03/04 11:47:43 + Log: Title: "properly save STDOUT during system() in debugger", #F110 + From: Jason Smith + Files: lib/perl5db.pl + Branch: maint-5.004/perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 745] By: TimBunce on 1998/03/04 11:40:19 + Log: Title: "generate DynaLoader.pm at build time", #F109 + From: Achim Bohnet + Msg-ID: <9802111938.AA26224@o09.xray.mpe.mpg.de> + Files: MANIFEST ext/DynaLoader/DynaLoader.pm.PL ext/DynaLoader/Makefile.PL + Branch: maint-5.004/perl + + ext/DynaLoader/DynaLoader.pm.PL + ! MANIFEST ext/DynaLoader/Makefile.PL +____________________________________________________________________________ +[ 744] By: TimBunce on 1998/03/04 11:34:09 + Log: Title: "Install extensions with bootstrap in $archlib", #F108 + From: koenig@anna.mind.de (Andreas J. Koenig), koenig@kulturbox.de (Andreas + J. Koenig) + Msg-ID: + Files: lib/ExtUtils/Install.pm + Branch: maint-5.004/perl + ! lib/ExtUtils/Install.pm +____________________________________________________________________________ +[ 743] By: TimBunce on 1998/03/04 10:45:05 + Log: Title: "Pod::Html trips over "C<0>"", #F107 + From: Chip Salzenberg + Files: lib/Pod/Html.pm + Branch: maint-5.004/perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 742] By: TimBunce on 1998/03/04 10:12:54 + Log: Title: "5.004_58 | _04: pod2*,perlpod: L", #F106 + From: Achim Bohnet + Msg-ID: <9802111629.AA00595@o09.xray.mpe.mpg.de> + Files: pod/perlpod.pod lib/Pod/Html.pm lib/Pod/Text.pm pod/pod2man.PL + Branch: maint-5.004/perl + ! lib/Pod/Html.pm lib/Pod/Text.pm pod/perlpod.pod pod/pod2man.PL +____________________________________________________________________________ +[ 741] By: TimBunce on 1998/03/04 10:08:31 + Log: Title: "New patch for $^E==GetLastError() under Win32", #F105 + From: Gurusamy Sarathy , Tye McQueen + , ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <199801040630.AA29298@metronet.com>, + <199801041826.NAA11568@aatma.engin.umich.edu>, + <1998Jan4.130412.2719461@cor.newman> + Files: pod/perlfunc.pod pod/perlvar.pod doio.c lib/dumpvar.pl lib/perl5db.pl + win32/win32.h mg.c util.c win32/makedef.pl win32/win32.c + Branch: maint-5.004/perl + ! doio.c lib/dumpvar.pl lib/perl5db.pl mg.c pod/perlfunc.pod + ! pod/perlvar.pod util.c win32/makedef.pl win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 740] By: TimBunce on 1998/03/04 09:55:57 + Log: Title: "5.004_56: Patch to Tie::Hash and docs", #F104 + From: Ilya Zakharevich + Msg-ID: <199801120134.UAA05437@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod lib/Tie/Hash.pm + Branch: maint-5.004/perl + ! lib/Tie/Hash.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 739] By: TimBunce on 1998/03/04 09:26:01 + Log: Title: "more doc for perldoc", #F103 + From: Gurusamy Sarathy + Files: utils/perldoc.PL + Branch: maint-5.004/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 738] By: TimBunce on 1998/03/04 09:23:16 + Log: Title: "Make perldoc look for an index file ", #F102 + From: Gisle Aas + Msg-ID: <199801221220.NAA22902@furu.g.aas.no> + Files: utils/perldoc.PL + Branch: maint-5.004/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 737] By: TimBunce on 1998/03/04 09:21:15 + Log: Title: "perldoc -F filename", #F101 + From: Ilya Zakharevich + Msg-ID: <199712120037.TAA00176@math.mps.ohio-state.edu> + Files: utils/perldoc.PL + Branch: maint-5.004/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 736] By: TimBunce on 1998/03/04 09:16:20 + Log: Title: "sv_grow can fail for HAS_64K_LIMIT systems", #F100 + From: Gisle Aas + Msg-ID: + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 735] By: TimBunce on 1998/03/04 09:08:51 + Log: Title: "Benchmark.pm: timethese corrupts $_", #F099 + From: abigail@fnx.com + Msg-ID: <19980201114609.7779.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Benchmark.pm + Branch: maint-5.004/perl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 734] By: TimBunce on 1998/03/04 08:59:58 + Log: Title: "STRANGE_MALLOC should test failed alloc", #F098 + From: Gisle Aas + Msg-ID: <199802021406.PAA03285@furu.g.aas.no> + Files: hv.c + Branch: maint-5.004/perl + ! hv.c +____________________________________________________________________________ +[ 733] By: TimBunce on 1998/03/04 08:35:19 + Log: Title: "support caseless %ENV", #F097 + From: Gurusamy Sarathy + Files: hv.c t/op/magic.t win32/win32.h + Branch: maint-5.004/perl + ! hv.c t/op/magic.t win32/win32.h +____________________________________________________________________________ +[ 732] By: TimBunce on 1998/03/04 08:33:58 + Log: Title: "newer cperl-mode.el (from 5.004_60)", #F096 + From: Ilya Zakharevich + Files: emacs/cperl-mode.el + Branch: maint-5.004/perl + ! emacs/cperl-mode.el +____________________________________________________________________________ +[ 731] By: TimBunce on 1998/03/04 08:26:23 + Log: Title: "Handle set magic on xsub OUTPUT args, add API functions that handle + magic", #F095 + From: Gurusamy Sarathy + Msg-ID: <199801190409.XAA26710@aatma.engin.umich.edu> + Files: pod/perlguts.pod pod/perlxs.pod embed.h proto.h sv.h global.sym + lib/ExtUtils/xsubpp sv.c + Branch: maint-5.004/perl + ! embed.h global.sym lib/ExtUtils/xsubpp pod/perlguts.pod + ! pod/perlxs.pod proto.h sv.c sv.h +____________________________________________________________________________ +[ 730] By: TimBunce on 1998/03/04 08:20:52 + Log: Title: "Fix flawed cleanup when signal handlers are not defined", #F094 + From: Gurusamy Sarathy + Msg-ID: <199710290106.UAA11485@aatma.engin.umich.edu> + Files: mg.c + Branch: maint-5.004/perl + ! mg.c +____________________________________________________________________________ +[ 729] By: TimBunce on 1998/03/04 08:18:02 + Log: Title: "Tests for C", #F093 + From: Hugo van der Sanden + Msg-ID: <199711021247.MAA01743@crypt.compulink.co.uk> + Files: t/op/sort.t + Branch: maint-5.004/perl + ! t/op/sort.t +____________________________________________________________________________ +[ 728] By: TimBunce on 1998/03/04 08:17:07 + Log: Title: "Make search.pl work on win32", #F092 + From: Gurusamy Sarathy + Files: win32/bin/search.pl + Branch: maint-5.004/perl + ! win32/bin/search.pl +____________________________________________________________________________ +[ 727] By: gsar on 1998/03/04 04:13:23 + Log: missing s/op/o/ from one of the mainpatches + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 726] By: gsar on 1998/03/04 02:12:13 + Log: maintpatches #102 and #103 to perldoc.PL + Branch: win32/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 725] By: gsar on 1998/03/04 02:00:15 + Log: renumber some tests to match maint branch + Branch: win32/perl + ! t/op/local.t +____________________________________________________________________________ +[ 724] By: gsar on 1998/03/04 01:25:50 + Log: maintpatch + #70: "Fix random whitespace errors in docs" + From: Roderick Schertler + Msg-ID: <12726.877706444@eeyore.ibcinc.com> + Date: Fri, 24 Oct 1997 11:20:44 -0400 + Files: pod/checkpods.PL pod/perlfunc.pod + Branch: win32/perl + ! pod/checkpods.PL +____________________________________________________________________________ +[ 723] By: gsar on 1998/03/04 01:04:37 + Log: sync maintpatch + #76: "Fix infinite loop on unlink() failure in File::Path::rmtree() + From: Chip Salzenberg + Files: lib/File/Path.pm + Branch: win32/perl + ! lib/File/Path.pm +____________________________________________________________________________ +[ 722] By: gsar on 1998/03/04 00:46:46 + Log: remove redundancy in File::Find + Branch: win32/perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 721] By: TimBunce on 1998/03/03 20:06:41 + Log: Title: "Fix spurious perldoc warnings on DOSISH platforms", #F091 + From: Molnar Laszlo + Msg-ID: <34475659.1AA69855@cdata.tvnet.hu> + Files: utils/perldoc.PL + Branch: maint-5.004/perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 720] By: TimBunce on 1998/03/03 20:03:59 + Log: Title: "Make ExtUtils::MM_Unix::fixin() do something meaningful on win32", + #F090 + From: Gurusamy Sarathy + Msg-ID: <199801070016.TAA17766@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + Branch: maint-5.004/perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 719] By: TimBunce on 1998/03/03 20:02:06 + Log: Title: "Fix inconsistent case $ENV{Path} (vs $ENV{PATH})", #F089 + From: Gurusamy Sarathy + Files: lib/FindBin.pm + Branch: maint-5.004/perl + ! lib/FindBin.pm +____________________________________________________________________________ +[ 718] By: TimBunce on 1998/03/03 20:00:26 + Log: Title: "Fix File::Find's longstanding confusion about win32 being like VMS", + #F088 + From: Gurusamy Sarathy + Msg-ID: <199802020459.XAA04964@aatma.engin.umich.edu> + Files: lib/File/Find.pm + Branch: maint-5.004/perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 717] By: TimBunce on 1998/03/03 19:59:38 + Log: Title: "do_postponed breaks with multiple interpreters", #F087 + From: Gurusamy Sarathy + Msg-ID: <199710290316.WAA15888@aatma.engin.umich.edu> + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 716] By: TimBunce on 1998/03/03 19:57:17 + Log: Title: "Make warning on C optional, add to perl{diag,delta}.pod", + #F086 + From: Gurusamy Sarathy + Files: pod/perldelta.pod pod/perldiag.pod toke.c + Branch: maint-5.004/perl + ! pod/perldelta.pod pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 715] By: TimBunce on 1998/03/03 19:51:33 + Log: Title: "Pod::Html bug and fix: missing in index", #F085 + From: Gurusamy Sarathy + Msg-ID: <199802192314.SAA23326@aatma.engin.umich.edu> + Files: lib/Pod/Html.pm + Branch: maint-5.004/perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 714] By: TimBunce on 1998/03/03 19:50:28 + Log: Title: "New pod: perlhist", #F084 + From: Jarkko Hietaniemi + Msg-ID: <199802191556.RAA09578@alpha.hut.fi> + Files: MANIFEST pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + Branch: maint-5.004/perl + + pod/perlhist.pod + ! MANIFEST pod/buildtoc pod/perl.pod pod/perltoc.pod +____________________________________________________________________________ +[ 713] By: TimBunce on 1998/03/03 19:47:13 + Log: Title: "Fix restoration of locals on scope unwinding", #F083 + From: Gurusamy Sarathy + Msg-ID: <199802110515.AAA23700@aatma.engin.umich.edu> + Files: pp_ctl.c t/op/local.t + Branch: maint-5.004/perl + ! pp_ctl.c t/op/local.t +____________________________________________________________________________ +[ 712] By: TimBunce on 1998/03/03 19:45:56 + Log: Title: "after an eval-ed bad require, requiring a string ref SEGVs", #F082 + From: Gurusamy Sarathy + Msg-ID: <199802102349.SAA16001@aatma.engin.umich.edu> + Files: pp_ctl.c + Branch: maint-5.004/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 711] By: TimBunce on 1998/03/03 19:44:41 + Log: Title: "Fix seg fault on eval/require and syntax errors", #F081 + From: Gurusamy Sarathy + Msg-ID: <199802102321.SAA15346@aatma.engin.umich.edu> + Files: MANIFEST scope.h op.c pp_ctl.c scope.c t/comp/require.t toke.c + Branch: maint-5.004/perl + + t/comp/require.t + ! MANIFEST op.c pp_ctl.c scope.c scope.h toke.c +____________________________________________________________________________ +[ 710] By: TimBunce on 1998/03/03 19:36:34 + Log: Title: "5.004_58: the locale.t problem in IRIX", #F080 + From: Jarkko Hietaniemi + Msg-ID: <199802091747.TAA01735@alpha.hut.fi> + Files: t/pragma/locale.t + Branch: maint-5.004/perl + ! t/pragma/locale.t +____________________________________________________________________________ +[ 709] By: TimBunce on 1998/03/03 19:32:30 + Log: Title: "sv_setnv will upgrade SVt_NV to SVt_PVNV", #F079 + From: Gisle Aas + Msg-ID: + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 708] By: TimBunce on 1998/03/03 19:28:06 + Log: Title: "Eliminate double warnings under C", #F077 + From: "M.J.T. Guy" + Msg-ID: + Files: gv.c op.c toke.c + Branch: maint-5.004/perl + ! gv.c op.c toke.c +____________________________________________________________________________ +[ 707] By: TimBunce on 1998/03/03 19:13:17 + Log: Title: "Fix infinite loop on unlink() failure in File::Path::rmtree()", + #F076 + From: Murray Nesbitt , Tim Bunce + Msg-ID: <199802061100.LAA16423@toad.ig.co.uk> + Files: lib/File/Path.pm + Branch: maint-5.004/perl + ! lib/File/Path.pm +____________________________________________________________________________ +[ 706] By: TimBunce on 1998/03/03 19:08:45 + Log: Title: "Update of h2ph", #F075 + From: kstar@www.chapin.edu (Kurt D. Starsinic) + Msg-ID: <199802051354.FAA11452@www.chapin.edu> + Files: t/lib/ph.t utils/h2ph.PL + Branch: maint-5.004/perl + + t/lib/ph.t + ! utils/h2ph.PL +____________________________________________________________________________ +[ 705] By: TimBunce on 1998/03/03 18:56:59 + Log: Title: "Fix AutoLoader for deep packages", #F074 + From: Zachary Miller + Msg-ID: <199710092348.SAA02108@zappy.er.usgs.gov> + Files: lib/AutoLoader.pm + Branch: maint-5.004/perl + ! lib/AutoLoader.pm +____________________________________________________________________________ +[ 704] By: TimBunce on 1998/03/03 18:35:36 + Log: Title: "Fix order of warnings for misplaced subscripts", #F073 + From: Hugo van der Sanden + Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk> + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 703] By: TimBunce on 1998/03/03 18:32:28 + Log: Title: "Make recursive lexical analysis more robust", #F072 + From: Ilya Zakharevich and Chip Salzenberg + Msg-ID: <199710160102.VAA28817@monk.mps.ohio-state.edu> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 702] By: TimBunce on 1998/03/03 18:18:10 + Log: Title: "Fix random whitespace errors in docs", #F070 + From: Roderick Schertler + Msg-ID: <12726.877706444@eeyore.ibcinc.com> + Files: pod/perlfunc.pod pod/checkpods.PL + Branch: maint-5.004/perl + ! pod/checkpods.PL pod/perlfunc.pod +____________________________________________________________________________ +[ 701] By: TimBunce on 1998/03/03 18:13:54 + Log: Title: "Fix line numbers after here documents in eval STRING", #F069 + From: Ilya Zakharevich + Msg-ID: <199710241745.NAA08166@monk.mps.ohio-state.edu> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 700] By: TimBunce on 1998/03/03 18:11:20 + Log: Title: "Fix SEGV from combining caller and C", #F068 + From: James Duncan , Nicholas Clark + + Msg-ID: <199710241248.NAA00163@flirble.org>, + + Files: pp_ctl.c sv.c + Branch: maint-5.004/perl + ! pp_ctl.c sv.c +____________________________________________________________________________ +[ 699] By: TimBunce on 1998/03/03 18:06:59 + Log: Title: "Don't fold string comparison under C", #F067 + From: Jarkko Hietaniemi + Msg-ID: <199711151506.RAA26287@alpha.hut.fi> + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 698] By: TimBunce on 1998/03/03 18:04:51 + Log: Title: "Fix SEGV on constant at end of sort block", #F066 + From: Administration + Msg-ID: <199711170838.JAA26073@thetis.fi.muni.cz> + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 697] By: TimBunce on 1998/03/03 18:02:54 + Log: Title: "Allow C to mean C", #F065 + From: Chip Salzenberg + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 696] By: TimBunce on 1998/03/03 17:58:12 + Log: Title: "Fix extension version mismatch message", #F064 + From: Chip Salzenberg + Files: XSUB.h + Branch: maint-5.004/perl + ! XSUB.h +____________________________________________________________________________ +[ 695] By: TimBunce on 1998/03/03 17:53:04 + Log: Title: "Better handle and test struct tm of Linux and SunOS", #F063 + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t + Branch: maint-5.004/perl + + ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + ! MANIFEST hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t +____________________________________________________________________________ +[ 694] By: TimBunce on 1998/03/03 17:40:47 + Log: Title: "Fix doc bug in getservbyname() examples", #F062 + From: Tom Christiansen + Files: ext/Socket/Socket.pm + Branch: maint-5.004/perl + ! ext/Socket/Socket.pm +____________________________________________________________________________ +[ 693] By: TimBunce on 1998/03/03 17:32:57 + Log: Title: "Kill warning about parameter type", #F061 + From: Chip Salzenberg + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 692] By: TimBunce on 1998/03/03 17:11:07 + Log: Title: "Socket occasional SEGV", #F060 + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + Branch: maint-5.004/perl + ! ext/Socket/Socket.xs +____________________________________________________________________________ +[ 691] By: TimBunce on 1998/03/03 17:09:51 + Log: Title: "Avoid SEGV from local($@)", #F059 + From: Gurusamy Sarathy + Msg-ID: <199710290251.VAA14362@aatma.engin.umich.edu> + Files: pp_ctl.c + Branch: maint-5.004/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 690] By: TimBunce on 1998/03/03 17:08:21 + Log: Title: "Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )", #F058 + From: Gurusamy Sarathy + Msg-ID: <199710300036.TAA01004@aatma.engin.umich.edu> + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 689] By: TimBunce on 1998/03/03 17:05:57 + Log: Title: "Use STMT_{START,END} in XSRETURN", #F057 + From: Gurusamy Sarathy + Msg-ID: <199710300245.VAA04244@aatma.engin.umich.edu> + Files: XSUB.h + Branch: maint-5.004/perl + ! XSUB.h +____________________________________________________________________________ +[ 688] By: TimBunce on 1998/03/03 17:04:15 + Log: Title: "Re: Sort grammar bug", #F056 + From: Gurusamy Sarathy + Msg-ID: <199711011946.OAA18882@aatma.engin.umich.edu> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 687] By: TimBunce on 1998/03/03 17:01:32 + Log: Title: "Document indirect object cases for exec(), system()", #F055 + From: Dominic Dunlop + Msg-ID: + Files: pod/perlfunc.pod + Branch: maint-5.004/perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 686] By: TimBunce on 1998/03/03 16:56:44 + Log: Title: "Update docs on tr///", #F054 + From: Tom Phoenix + Msg-ID: + Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + pod/perllocale.pod pod/perlmod.pod pod/perlop.pod + pod/perlstyle.pod toke.c + Branch: maint-5.004/perl + ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + ! pod/perllocale.pod pod/perlmod.pod pod/perlop.pod + ! pod/perlstyle.pod toke.c +____________________________________________________________________________ +[ 685] By: TimBunce on 1998/03/03 16:38:50 + Log: Title: "Re: perlop bitwise & | ^ documentation", #F053 + From: Tom Phoenix + Msg-ID: + Files: pod/perlop.pod + Branch: maint-5.004/perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 684] By: TimBunce on 1998/03/03 16:37:00 + Log: Title: "Fix SEGV on C<*glob{'SCALAR','ARRAY'}>", #F052 + From: "Joseph N. Hall" + Msg-ID: <199711110552.WAA12613@gadget.cscaper.com> + Files: perly.c perly.c.diff perly.y vms/perly_c.vms + Branch: maint-5.004/perl + ! perly.c perly.c.diff perly.y vms/perly_c.vms +____________________________________________________________________________ +[ 683] By: TimBunce on 1998/03/03 16:31:15 + Log: Title: "for perlguts.pod: document sv_derived_from, sv_vcatpfn and + sv_vsetpfn", #F051 + From: jan.dubois@ibm.net (Jan Dubois) and Chip Salzenberg + Msg-ID: <346ae970.7444534@smtp1.ibm.net> + Files: pod/perlguts.pod + Branch: maint-5.004/perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 682] By: TimBunce on 1998/03/03 16:28:30 + Log: Title: "5.004_04: locale startup failure (at last) documented", #F050 + From: Jarkko Hietaniemi + Msg-ID: <199711172054.WAA08261@alpha.hut.fi> + Files: INSTALL pod/perldiag.pod pod/perllocale.pod + Branch: maint-5.004/perl + ! INSTALL pod/perldiag.pod pod/perllocale.pod +____________________________________________________________________________ +[ 681] By: TimBunce on 1998/03/03 16:24:12 + Log: Title: "Cope with lack of args in Fcntl::AUTOLOAD", #F049 + From: Jerome Abela + Msg-ID: <19971120183248.23588@coredump.hsc.fr> + Files: ext/Fcntl/Fcntl.pm + Branch: maint-5.004/perl + ! ext/Fcntl/Fcntl.pm +____________________________________________________________________________ +[ 680] By: TimBunce on 1998/03/03 16:23:20 + Log: Title: "Commenting toke.c", #F048 + From: gnat@frii.com + Msg-ID: <199801082138.OAA14186@prometheus.frii.com> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 679] By: TimBunce on 1998/03/03 16:18:32 + Log: Title: "Re: 5.004_04 vec() fails with 32-bit values", #F047 + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod pp.c t/op/vec.t + Branch: maint-5.004/perl + ! pod/perlguts.pod pp.c t/op/vec.t +____________________________________________________________________________ +[ 678] By: TimBunce on 1998/03/03 16:15:44 + Log: Title: "A few perl5.004_03 bugs", #F046 + From: Hugo van der Sanden + Msg-ID: <199801221211.MAA05315@crypt.compulink.co.uk> + Files: mg.c t/op/magic.t + Branch: maint-5.004/perl + ! mg.c t/op/magic.t +____________________________________________________________________________ +[ 677] By: TimBunce on 1998/03/03 16:13:11 + Log: Title: "Faster, cleaner av_unshift() ", #F045 + From: Gisle Aas + Msg-ID: <199801221850.TAA23111@furu.g.aas.no> + Files: av.c + Branch: maint-5.004/perl + ! av.c +____________________________________________________________________________ +[ 676] By: TimBunce on 1998/03/03 16:04:30 + Log: Title: "New hints/solaris2.sh", #F044 + From: Stephen Zander + Msg-ID: <87oh12y458.fsf@wsuse5.mckesson.com> + Files: hints/solaris_2.sh + Branch: maint-5.004/perl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 675] By: TimBunce on 1998/03/03 15:33:07 + Log: Title: "Refresh Complex.pm and test", #F043 + From: Jarkko Hietaniemi + Msg-ID: <199802051608.SAA20262@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + Branch: maint-5.004/perl + ! lib/Math/Complex.pm t/lib/complex.t +____________________________________________________________________________ +[ 674] By: TimBunce on 1998/03/03 15:29:16 + Log: Title: "Fix (\@@) proto", #F042 + From: "Joseph N. Hall" + Msg-ID: <199801240132.SAA25111@gadget.cscaper.com> + Files: op.c t/comp/proto.t + Branch: maint-5.004/perl + ! op.c t/comp/proto.t +____________________________________________________________________________ +[ 673] By: TimBunce on 1998/03/03 15:26:31 + Log: Title: "Allow empty BLOCK in code", #F041 + From: Vladimir Alexiev + Msg-ID: <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 672] By: TimBunce on 1998/03/03 15:23:55 + Log: Title: "Fix name of $Foo::{'Bar::'}: '*Foo::Bar::'", #F040 + From: Chip Salzenberg + Files: gv.c t/op/gv.t + Branch: maint-5.004/perl + ! gv.c t/op/gv.t +____________________________________________________________________________ +[ 671] By: TimBunce on 1998/03/03 10:02:32 + Log: Title: "Keep accurate reference count on globs' stashes", #F038 + From: Gisle Aas + Msg-ID: + Files: gv.c sv.c + Branch: maint-5.004/perl + ! gv.c sv.c +____________________________________________________________________________ +[ 670] By: TimBunce on 1998/03/03 09:59:48 + Log: Title: "Avoid memory allocation in gv_fetchpv(), for speed", #F037 + From: Chip Salzenberg + Files: gv.c + Branch: maint-5.004/perl + ! gv.c +____________________________________________________________________________ +[ 669] By: TimBunce on 1998/03/03 09:58:58 + Log: Title: "Make Configure less negative about PerlIO", #F036 + From: chip@atlantic.net + Msg-ID: <199801312323.SAA15237@cyprus.atlantic.net> + Files: Configure + Branch: maint-5.004/perl + ! Configure +____________________________________________________________________________ +[ 668] By: TimBunce on 1998/03/03 09:55:51 + Log: Title: "Fix (mostly) pseudo-same-REs due to embedded NULs", #F035 + From: Martin Plechsmid + Msg-ID: <199802021217.NAA05230@albert.karlin.mff.cuni.cz> + Files: pp_ctl.c + Branch: maint-5.004/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 667] By: TimBunce on 1998/03/03 09:52:59 + Log: Title: "Make Getopt::Long avoid $&, $`, $'", #F034 + From: Irving Reid + Msg-ID: <98Feb3.005102est.11655@janus.tor.securecomputing.com> + Files: lib/Getopt/Long.pm + Branch: maint-5.004/perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 666] By: TimBunce on 1998/03/03 09:51:27 + Log: Title: "adding the newSVpvn API function", #F033 + From: Matthias Ulrich Neeracher + Msg-ID: <199801310532.GAA23798@solar.ethz.ch> + Files: pod/perlguts.pod pod/perltoc.pod proto.h global.sym sv.c + Branch: maint-5.004/perl + ! global.sym pod/perlguts.pod pod/perltoc.pod proto.h sv.c +____________________________________________________________________________ +[ 665] By: TimBunce on 1998/03/03 09:43:30 + Log: Title: "Support C as function-blind bearword", #F032 + From: Chip Salzenberg + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 664] By: TimBunce on 1998/03/03 09:41:40 + Log: Title: "Re-optimize character classes", #F031 + From: Chip Salzenberg + Files: regcomp.h regcomp.c regexec.c + Branch: maint-5.004/perl + ! regcomp.c regcomp.h regexec.c +____________________________________________________________________________ +[ 663] By: TimBunce on 1998/03/03 09:39:55 + Log: Title: "Fix C which needed ENTER/LEAVE", #F030 + From: dfh@dwroll.lucent.com (D461-David_F_Haertig(Dave)83040) + Msg-ID: + Files: op.c t/op/local.t + Branch: maint-5.004/perl + ! op.c t/op/local.t +____________________________________________________________________________ +[ 662] By: TimBunce on 1998/03/03 09:37:51 + Log: Title: "Dramatically improve performance of // with parens or $&", #F029 + From: Chip Salzenberg + Files: cop.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c pp_ctl.c + pp_hot.c regexec.c scope.c + Branch: maint-5.004/perl + ! cop.h gv.c interp.sym perl.c perl.h pp.c pp_ctl.c pp_hot.c + ! proto.h regexec.c regexp.h scope.c +____________________________________________________________________________ +[ 661] By: TimBunce on 1998/03/03 09:27:04 + Log: Title: "Don't warn on $x{shift}, ne => 1, or -f => 1", #F028 + From: Chip Salzenberg + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 660] By: TimBunce on 1998/03/03 09:24:41 + Log: Title: "Protect against weirdness with unreal @_ in C", #F027 + From: Chip Salzenberg + Files: scope.c + Branch: maint-5.004/perl + ! scope.c +____________________________________________________________________________ +[ 659] By: TimBunce on 1998/03/03 09:24:00 + Log: Title: "Fix C", #F026 + From: Hugo van der Sanden + Msg-ID: <199711021331.NAA01826@crypt.compulink.co.uk> + Files: sv.c t/op/sprintf.t + Branch: maint-5.004/perl + ! sv.c t/op/sprintf.t +____________________________________________________________________________ +[ 658] By: TimBunce on 1998/03/03 09:22:13 + Log: Title: "Tiny core patch for source filters", #F025 + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9711202312.AA02937@claudius.bfsec.bt.co.uk> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 657] By: TimBunce on 1998/03/03 09:20:00 + Log: Title: "Here-doc in s///e (was: Bug)", #F024 + From: Hugo van der Sanden + Msg-ID: <199711221445.OAA14153@crypt.compulink.co.uk> + Files: t/base/lex.t toke.c + Branch: maint-5.004/perl + ! t/base/lex.t toke.c +____________________________________________________________________________ +[ 656] By: TimBunce on 1998/03/03 09:17:56 + Log: Title: "Fix duplicate warnings on C<-e undef>", #F023 + From: Hugo van der Sanden + Msg-ID: <199711221252.MAA14000@crypt.compulink.co.uk> + Files: doio.c t/pragma/warn-1global + Branch: maint-5.004/perl + ! doio.c t/pragma/warn-1global +____________________________________________________________________________ +[ 655] By: TimBunce on 1998/03/03 09:16:56 + Log: Title: "Fix '*' prototype", #F022 + From: Ilya Zakharevich + Msg-ID: <199711212225.RAA00755@monk.mps.ohio-state.edu> + Files: toke.c + Branch: maint-5.004/perl + ! toke.c +____________________________________________________________________________ +[ 654] By: TimBunce on 1998/03/03 09:15:04 + Log: Title: "File::Find bugs (and patches)", "File::Find bugs & patches", #F021 + From: "Conrad E. Kimball" + Msg-ID: <199711260703.XAA21257@mailgate2.boeing.com> + Files: lib/File/Find.pm + Branch: maint-5.004/perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 653] By: TimBunce on 1998/03/03 09:11:55 + Log: Title: "Fix typo: FORM{,AT}LINE", #F020 + From: Chip Salzenberg + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 652] By: TimBunce on 1998/03/03 09:07:50 + Log: Title: "Fix use of unref mem when blessed object goes out of scope", #F019 + From: Gurusamy Sarathy + Msg-ID: <199711282326.SAA15090@aatma.engin.umich.edu> + Files: scope.c + Branch: maint-5.004/perl + ! scope.c +____________________________________________________________________________ +[ 651] By: TimBunce on 1998/03/03 09:07:10 + Log: Title: "Fix C", #F018 + From: Stephane Payrard + Msg-ID: <199712040054.BAA04612@www.zweig.com> + Files: op.c t/op/my.t + Branch: maint-5.004/perl + ! op.c t/op/my.t +____________________________________________________________________________ +[ 650] By: TimBunce on 1998/03/03 09:04:04 + Log: Title: "enhanced "use strict" warning", #F017 + From: Tkil + Msg-ID: <199712040938.CAA07628@reptile.scrye.com> + Files: gv.c t/pragma/strict-subs t/pragma/strict-vars + Branch: maint-5.004/perl + ! gv.c t/pragma/strict-subs t/pragma/strict-vars +____________________________________________________________________________ +[ 649] By: TimBunce on 1998/03/03 09:02:55 + Log: Title: "eval of sub gives spurious "uninitialised" warning", #F016 + From: Gurusamy Sarathy + Msg-ID: <199712061025.FAA14396@aatma.engin.umich.edu> + Files: pod/perldelta.pod pod/perlfunc.pod op.c t/op/eval.t + Branch: maint-5.004/perl + ! op.c pod/perldelta.pod pod/perlfunc.pod t/op/eval.t +____________________________________________________________________________ +[ 648] By: TimBunce on 1998/03/03 08:58:00 + Log: Title: "[PERL] Assigning result of pop scrambles unrelated reference", #F015 + From: Gurusamy Sarathy + Msg-ID: <199712061100.GAA14864@aatma.engin.umich.edu> + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 647] By: TimBunce on 1998/03/03 08:53:35 + Log: Title: "[PERL] Filedescriptor leak in 5.004_55 (and earlier)", #F014 + From: Ilya Zakharevich + Msg-ID: <199712151922.OAA06410@monk.mps.ohio-state.edu> + Files: os2/os2.c util.c + Branch: maint-5.004/perl + ! os2/os2.c util.c +____________________________________________________________________________ +[ 646] By: TimBunce on 1998/03/03 08:51:04 + Log: Title: "Fix fdopen() on STD{IN,OUT,ERR}", #F013 + From: Roderick Schertler + Msg-ID: + Files: doio.c t/op/misc.t + Branch: maint-5.004/perl + ! doio.c t/op/misc.t +____________________________________________________________________________ +[ 645] By: TimBunce on 1998/03/03 08:49:34 + Log: Title: "Fix local $a[0] and local $h{a}", #F012 + From: Stephen McCamant + Msg-ID: + Files: embed.h scope.h global.sym pp.c pp_hot.c scope.c t/op/local.t + Branch: maint-5.004/perl + ! embed.h global.sym pp.c pp_hot.c scope.c scope.h t/op/local.t +____________________________________________________________________________ +[ 644] By: TimBunce on 1998/03/03 08:43:06 + Log: Title: "Eliminate redundant mg_get() in SvTRUE()", #F011 + From: Spider Boardman + Msg-ID: <199712251839.NAA14800@Orb.Nashua.NH.US> + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 643] By: TimBunce on 1998/03/03 08:41:07 + Log: Title: "Don't force scalar context on C or C", #F010 + From: Chip Salzenberg + Files: op.c t/op/my.t + Branch: maint-5.004/perl + ! op.c t/op/my.t +____________________________________________________________________________ +[ 642] By: TimBunce on 1998/03/03 08:39:11 + Log: Title: "Fix assignment to $_[0] in DESTROY", #F009 + From: Gurusamy Sarathy + Msg-ID: <199801010030.TAA14274@aatma.engin.umich.edu> + Files: pod/perlobj.pod sv.c t/op/ref.t + Branch: maint-5.004/perl + ! pod/perlobj.pod sv.c t/op/ref.t +____________________________________________________________________________ +[ 641] By: gsar on 1998/03/03 04:39:49 + Log: merge problematic maintpatch to op.c + #77: "Eliminate double warnings under C" + From: Chip Salzenberg + Files: gv.c op.c toke.c + Branch: win32/perl + ! gv.c op.c toke.c +____________________________________________________________________________ +[ 640] By: gsar on 1998/03/03 04:30:22 + Log: merge another conflicting maintpatch to op.c + #17: "Enhanced "use strict" warning" + From: Tkil + Msg-ID: <199712040938.CAA07628@reptile.scrye.com> + Date: Thu, 4 Dec 1997 02:38:26 -0700 + Files: gv.c t/pragma/strict-subs t/pragma/strict-vars + Branch: win32/perl + ! gv.c t/pragma/strict-subs t/pragma/strict-vars +____________________________________________________________________________ +[ 639] By: gsar on 1998/03/03 04:09:11 + Log: maintpatch + #73: "Fix order of warnings for misplaced subscripts" + From: Hugo van der Sanden + Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk> + Date: Mon, 13 Oct 1997 11:23:56 +0100 + Files: op.c + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 638] By: gsar on 1998/03/03 04:02:16 + Log: manually apply another conflicting maintpatch + #64: "Fix extension version mismatch message" + From: Chip Salzenberg + Files: XSUB.h + Branch: win32/perl + ! XSUB.h +____________________________________________________________________________ +[ 637] By: gsar on 1998/03/03 03:57:08 + Log: maintpatch + #62: "Fix doc bug in getservbyname() examples" + From: Tom Christiansen + Files: ext/Socket/Socket.pm + Branch: win32/perl + ! ext/Socket/Socket.pm +____________________________________________________________________________ +[ 636] By: gsar on 1998/03/03 03:55:13 + Log: maintpatch + #60: "Socket occasional SEGV" + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Date: Tue, 28 Oct 1997 13:04:43 -0500 (EST) + Files: ext/Socket/Socket.xs + Branch: win32/perl + ! ext/Socket/Socket.xs +____________________________________________________________________________ +[ 635] By: gsar on 1998/03/03 03:51:01 + Log: maintpatches for docs + #53: "Perlop bitwise & | ^ documentation" + From: Tom Phoenix + Msg-ID: + Msg-ID: + Message-Id: <199801221211.MAA05315@crypt.compulink.co.uk> + Date: Thu, 22 Jan 1998 12:11:49 +0000 + Subject: Re: [PERL] A few perl5.004_03 bugs + Branch: win32/perl + ! mg.c t/op/magic.t +____________________________________________________________________________ +[ 633] By: gsar on 1998/03/03 03:36:40 + Log: merge another toke.c patch and its dependent (very carefully) + #32: "Support C as function-blind bearword" + From: Chip Salzenberg + Files: toke.c + -------- + #86: "Make warning on C optional, add to perl{diag,delta}.pod" + From: Gurusamy Sarathy + Files: toke.c pod/perldelta.pod pod/perldiag.pod + Branch: win32/perl + ! pod/perldelta.pod pod/perldiag.pod toke.c +____________________________________________________________________________ +[ 632] By: gsar on 1998/03/03 03:12:16 + Log: another toke.c maintpatch + #28: "Don't warn on $x{shift}, ne => 1, or -f => 1" + From: Chip Salzenberg + Files: toke.c + Branch: win32/perl + ! toke.c +____________________________________________________________________________ +[ 631] By: gsar on 1998/03/03 03:06:59 + Log: still another maintpatch + From: Hugo van der Sanden + Message-Id: <199711021331.NAA01826@crypt.compulink.co.uk> + Date: Sun, 02 Nov 1997 13:31:54 +0000 + Subject: [PATCH] assorted sprintf bugs + Branch: win32/perl + ! sv.c t/op/sprintf.t +____________________________________________________________________________ +[ 630] By: gsar on 1998/03/03 03:03:55 + Log: yet another maintpatch + From: Hugo van der Sanden + Message-Id: <199711221252.MAA14000@crypt.compulink.co.uk> + Date: Sat, 22 Nov 1997 12:52:16 +0000 + Subject: Re: [PERL] Unexpected output + Branch: win32/perl + ! doio.c t/pragma/warn-1global +____________________________________________________________________________ +[ 629] By: gsar on 1998/03/03 02:57:33 + Log: merge another maintpatch to toke.c + From: Hugo van der Sanden + Date: Sat, 22 Nov 1997 14:45:23 GMT + Message-Id: <199711221445.OAA14153@crypt.compulink.co.uk> + Subject: Re: [PERL] Here-doc in s///e (was: Bug) + Branch: win32/perl + ! t/base/lex.t toke.c +____________________________________________________________________________ +[ 628] By: gsar on 1998/03/03 02:50:20 + Log: manually merge a maintpatch + Date: Thu, 8 Jan 1998 14:38:04 -0700 (MST) + Message-Id: <199801082138.OAA14186@prometheus.frii.com> + From: gnat@frii.com + Subject: [PERL] Commenting toke.c + Branch: win32/perl + ! toke.c +____________________________________________________________________________ +[ 627] By: TimBunce on 1998/03/02 22:34:47 + Log: Title: "Fix inefficient checks for TIEHANDLE", #F008 + From: Gurusamy Sarathy + Msg-ID: <199801080106.UAA05048@aatma.engin.umich.edu> + Files: pp_hot.c pp_sys.c + Branch: maint-5.004/perl + ! pp_hot.c pp_sys.c +____________________________________________________________________________ +[ 626] By: TimBunce on 1998/03/02 22:31:13 + Log: This is the change description for change 625 + Title: "Fix tr///s option", #F007 + From: Inaba Hiroto + Msg-ID: <19980110155333D.inaba@st.rim.or.jp> + Files: doop.c + Branch: maint-5.004/perl + ! doop.c +____________________________________________________________________________ +[ 625] By: TimBunce on 1998/03/02 22:23:48 + Log: Branch: maint-5.004/perl + ! doop.c +____________________________________________________________________________ +[ 623] By: TimBunce on 1998/03/02 21:51:53 + Log: Title: "Fix lexical lookup in eval-sub-eval", #F006 + From: Chip Salzenberg + Files: pp_ctl.c + Branch: maint-5.004/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 622] By: TimBunce on 1998/03/02 21:43:29 + Log: Title: "Don't upgrade target of assignment from LVALUE", #F005 + From: Chip Salzenberg + Files: sv.c + Branch: maint-5.004/perl + ! sv.c +____________________________________________________________________________ +[ 621] By: TimBunce on 1998/03/02 21:29:59 + Log: Title: "Fix compile-time warning line in while ()", #F004 + From: Chip Salzenberg + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 620] By: TimBunce on 1998/03/02 21:25:27 + Log: Title: "STMT foreach LIST;", #F002 + From: Chip Salzenberg + Files: pod/perlsyn.pod perly.c perly.c.diff perly.y t/cmd/mod.t toke.c + vms/perly_c.vms + Branch: maint-5.004/perl + ! perly.c perly.c.diff perly.y pod/perlsyn.pod t/cmd/mod.t + ! toke.c vms/perly_c.vms +____________________________________________________________________________ +[ 619] By: TimBunce on 1998/03/02 21:12:58 + Log: Title: "Fix SIGSEGV on C<42 until forever>", #F001 + From: Chip Salzenberg + Files: op.c + Branch: maint-5.004/perl + ! op.c +____________________________________________________________________________ +[ 618] By: gsar on 1998/03/02 04:40:16 + Log: make t/lib/nothread.t type xtext also + Branch: win32/perl + ! t/op/nothread.t +____________________________________________________________________________ +[ 617] By: gsar on 1998/03/02 04:35:15 + Log: make t/lib/thread.t type xtext + Branch: win32/perl + ! t/lib/thread.t +____________________________________________________________________________ +[ 616] By: gsar on 1998/03/02 04:17:40 + Log: fix misapplied hunks in change#614 + Branch: win32/perl + ! scope.c scope.h +____________________________________________________________________________ +[ 615] By: gsar on 1998/03/02 03:39:16 + Log: another one down + From: "Conrad E. Kimball" + Message-Id: <199711260703.XAA21257@mailgate2.boeing.com> + Date: Tue, 25 Nov 1997 23:03:48 -0800 + Subject: [PERL] File::Find bugs & patches + Branch: win32/perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 614] By: gsar on 1998/03/02 03:28:28 + Log: this one with adjusted test numbers + Message-Id: + Date: Sat, 20 Dec 1997 15:16:14 -0600 (CST) + From: Stephen McCamant + Subject: [PERL] [PATCH] Fix local $a[0] and local $h{a} + Branch: win32/perl + ! embed.h global.sym pp.c pp_hot.c scope.c scope.h t/op/local.t +____________________________________________________________________________ +[ 613] By: gsar on 1998/03/02 03:13:32 + Log: still another + From: Inaba Hiroto + Subject: [PERL] tr///s bug + Message-Id: <19980110155333D.inaba@st.rim.or.jp> + Date: Sat, 10 Jan 1998 15:53:33 +0900 + Branch: win32/perl + ! doop.c t/op/subst.t +____________________________________________________________________________ +[ 612] By: gsar on 1998/03/02 03:01:27 + Log: yet another patch + From: Chip Salzenberg + Message-Id: <199709161748.NAA08418@nielsenmedia.com> + Subject: Tiny but massively cool: C + Date: Tue, 16 Sep 1997 13:47:28 -0400 (EDT) + Branch: win32/perl + ! perly.c perly.c.diff perly.y pod/perlsyn.pod t/cmd/mod.t + ! toke.c vms/perly_c.vms +____________________________________________________________________________ +[ 611] By: gsar on 1998/03/02 01:52:46 + Log: yet another 'old' patch + From: Stephane Payrard + Message-Id: <199712040054.BAA04612@www.zweig.com> + To: perl5-porters@perl.org + Subject: Re: [PERL] buglet : minor but gratuitous inconsistency + between `my' and `local' (Patch included) + Branch: win32/perl + ! op.c t/op/my.t +____________________________________________________________________________ +[ 610] By: gsar on 1998/03/02 01:45:55 + Log: another 'old' patch + From: Roderick Schertler + Date: 19 Dec 1997 12:52:36 -0500 + Message-Id: + Subject: [PERL] [PATCH] Re: Problem with open >&= + Branch: win32/perl + ! doio.c t/op/misc.t +____________________________________________________________________________ +[ 609] By: gsar on 1998/03/02 01:23:56 + Log: apply missing pieces from: + From: Chip Salzenberg + Message-Id: <199711272044.PAA12102@nielsenmedia.com> + Subject: [PATCH] Improved LVALUE patch + Date: Thu, 27 Nov 1997 15:44:02 -0500 (EST) + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 608] By: gsar on 1998/03/02 01:13:01 + Log: merge two important 'old' patches + From: Chip Salzenberg + Message-Id: <199709241632.MAA09164@nielsenmedia.com> + Subject: [PATCH] Fix C<42 until forever> SIGSEGV + Date: Wed, 24 Sep 1997 12:32:11 -0400 (EDT) + ------ + From: Chip Salzenberg + Message-Id: <199710221332.JAA04814@nielsenmedia.com> + Subject: [PATCH] Fix for compile-time while() warnings + Date: Wed, 22 Oct 1997 09:31:50 -0400 (EDT) + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 607] By: gsar on 1998/03/01 06:52:26 + Log: integrate mainline changes + Branch: asperl + +> Policy_sh.SH Porting/config.sh Porting/config_H atomic.h + +> lib/Tie/Handle.pm t/op/tiehandle.t + - config_H + !> (integrate 89 files) +____________________________________________________________________________ +[ 606] By: gsar on 1998/02/28 23:11:00 + Log: misc small tweaks + - AutoLoader fix for long::pack::names + - d_mymalloc can be set from makefiles now + - make search.pl actually work on win32 + - revert podoc about $^E on OS/2 (per Ilya's wishes) + Branch: win32/perl + ! lib/AutoLoader.pm pod/perlvar.pod win32/Makefile + ! win32/bin/search.pl win32/makefile.mk win32/win32.c +____________________________________________________________________________ +[ 605] By: gsar on 1998/02/28 22:16:45 + Log: fix typo in sv.h, and run 'make regen_headers' to make it build + Branch: win32/perl + ! embedvar.h sv.h +____________________________________________________________________________ +[ 604] By: gsar on 1998/02/28 21:08:58 + Log: integrate mainline + Branch: win32/perl + +> Policy_sh.SH atomic.h lib/Tie/Handle.pm t/op/tiehandle.t + !> Configure MANIFEST Makefile.SH bytecode.h bytecode.pl + !> byterun.c ext/SDBM_File/Makefile.PL + !> ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.h + !> lib/ExtUtils/MM_VMS.pm os2/diff.configure os2/os2.c perl.c + !> perlvars.h pod/perltie.pod pp_sys.c sv.c sv.h t/lib/anydbm.t + !> t/lib/sdbm.t util.c vms/descrip.mms vms/perlvms.pod + !> vms/test.com win32/makedef.pl +____________________________________________________________________________ +[ 603] By: nick on 1998/02/28 11:31:15 + Log: Missed FREAD in bytecode.h + Cannot export svref_mutex in non-threaded perl + Branch: perl + ! bytecode.h win32/makedef.pl + +---------------- +Version 5.004_61 +---------------- + +____________________________________________________________________________ +[ 602] By: mbeattie on 1998/02/27 18:35:27 + Log: Change FREAD/FGETC to BGET_FREAD/BGET_FGETC to avoid clash with + preprocessor symbol on Digital UNIX. + Branch: perl + ! bytecode.h bytecode.pl byterun.c +____________________________________________________________________________ +[ 601] By: mbeattie on 1998/02/27 18:27:00 + Log: Fix stupid ATOMIC_DEC_AND_TEST typo in sv.h. + Branch: perl + ! sv.h +____________________________________________________________________________ +[ 600] By: mbeattie on 1998/02/27 18:15:07 + Log: Add atomic.h to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 599] By: mbeattie on 1998/02/27 18:13:52 + Log: Integrate win32 branch into mainline. + Branch: perl + ! bytecode.pl + !> bytecode.h byterun.c byterun.h dosish.h embed.h embedvar.h + !> ext/B/B.xs ext/B/Makefile.PL global.sym perl.h sv.c + !> win32/Makefile win32/bin/pl2bat.pl win32/config.bc + !> win32/config.gc win32/config.vc win32/config_H.bc + !> win32/config_H.gc win32/config_H.vc win32/config_h.PL + !> win32/makedef.pl win32/makefile.mk win32/win32.c win32/win32.h + !> win32/win32thread.h +____________________________________________________________________________ +[ 598] By: mbeattie on 1998/02/27 18:06:41 + Log: Make refcounts atomic for threading (dependent on appropriate + arch-dependent and compiler-dependent definitions in atomic.h + or else falls back to a global mutex to protect refcounts). + Branch: perl + + atomic.h + ! global.sym perl.c perlvars.h sv.c sv.h +____________________________________________________________________________ +[ 597] By: mbeattie on 1998/02/27 15:37:22 + Log: Tiehandle stuff in change 595 didn't add to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 596] By: mbeattie on 1998/02/27 15:34:55 + Log: Missed adding new file Policy_sh.SH in change 592. + Branch: perl + + Policy_sh.SH +____________________________________________________________________________ +[ 595] By: mbeattie on 1998/02/27 15:34:06 + Log: Subject: [PATCH] _60 & _04 - Add WRITE & CLOSE to TIEHANDLE + Date: Fri, 27 Feb 1998 04:15:04 +0000 + From: Graham Barr + Branch: perl + + lib/Tie/Handle.pm t/op/tiehandle.t + ! pod/perltie.pod pp_sys.c +____________________________________________________________________________ +[ 594] By: mbeattie on 1998/02/27 15:31:12 + Log: From: Dan Sugalski + Subject: [PATCH 5.004_60] Fix to MM_VMS.PM + Date: Thu, 26 Feb 1998 11:09:55 -0800 + Subject: [PATCH 5.004_60] Get SDBM_File working on VMS + Date: Thu, 26 Feb 1998 11:15:24 -0800 + Branch: perl + ! ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL + ! ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_VMS.pm + ! t/lib/anydbm.t t/lib/sdbm.t vms/descrip.mms vms/perlvms.pod + ! vms/test.com +____________________________________________________________________________ +[ 593] By: mbeattie on 1998/02/27 15:26:45 + Log: Fix file-descriptor leak when pipes fail via taint checks: + Subject: [PATCH] Some patches went through cracks + Date: Thu, 26 Feb 1998 02:47:46 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! os2/os2.c util.c +____________________________________________________________________________ +[ 592] By: mbeattie on 1998/02/27 15:15:12 + Log: Subject: Config_60-03-04.diff patch for 5.004_60 + Date: Wed, 25 Feb 1998 17:14:39 -0500 (EST) + From: Andy Dougherty + Branch: perl + ! Configure MANIFEST Makefile.SH os2/diff.configure +____________________________________________________________________________ +[ 591] By: gsar on 1998/02/26 19:34:50 + Log: added AS patch#9 + Branch: asperl + - win32/ipdir.c win32/ipenv.c win32/iplio.c win32/ipmem.c + - win32/ipproc.c win32/ipsock.c win32/ipstdio.c + - win32/ipstdiowin.h win32/perlobj.def + ! ObjXSub.h globals.c perl.c proto.h win32/Makefile + ! win32/dl_win32.xs win32/runperl.c win32/win32.c win32/win32.h + ! win32/win32sck.c win32/win32thread.c +____________________________________________________________________________ +[ 590] By: gsar on 1998/02/26 04:25:40 + Log: various changes to make win32 build under the new Configure & co. + - added byterun.c to core C build + - makefile.mk now has a regen_config_h target to quickly update config_H.[bgv]c + after adding new variables to config.[bgv]c + - sig_name_init now has only the valid signals + - we now have $Config{usethreads} + - tested under the two commercial compilers w/ and w/o usethreads + Branch: win32/perl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/makedef.pl win32/makefile.mk +____________________________________________________________________________ +[ 589] By: gsar on 1998/02/26 03:56:19 + Log: various cleanups so that B can be built as "just another extension" + - export symbols needed for building B + - bset_obj_store() is needed by byterun(), so define it there instead + of at B.xs, and export it + - freadpv() is only used in B.xs, so move it there + - byte*.h are now included by perl.h + - regenerate embed*.h + Branch: win32/perl + ! bytecode.h bytecode.pl byterun.c byterun.h embed.h embedvar.h + ! ext/B/B.xs ext/B/Makefile.PL global.sym perl.h +____________________________________________________________________________ +[ 588] By: gsar on 1998/02/25 21:46:35 + Log: integrate mainline + Branch: win32/perl + +> Porting/config.sh Porting/config_H + - config_H + !> (integrate 54 files) +____________________________________________________________________________ +[ 587] By: gsar on 1998/02/25 19:20:26 + Log: added AS patch#8 + Branch: asperl + ! sv.c x2p/a2py.c x2p/util.c +____________________________________________________________________________ +[ 586] By: gsar on 1998/02/25 19:08:06 + Log: added AS patch#7 + Message-Id: <01BD40F9.CE57B210.dougl@ActiveState.com> + Date: Tue, 24 Feb 1998 07:57:07 PST + From: Douglas Lankshear + Subject: [PATCH] + + Here's an attempt at + 6. MANIFEST must be updated with new file names + 5. Mktime(), Stat() etc., rather than MKtime()/STat() etc. + And some changes to move toward + 1. Merge PERL_OBJECT build support into regular Makefile and makefile.mk + + -- Doug + Branch: asperl + ! MANIFEST installperl ipdir.h ipenv.h iplio.h ipmem.h ipproc.h + ! ipsock.h ipstdio.h lib/ExtUtils/MM_Win32.pm perldir.h + ! perlenv.h perlio.h perllio.h win32/Makefile +____________________________________________________________________________ +[ 585] By: mbeattie on 1998/02/25 17:44:34 + Log: More compiler tweaks. + Branch: perl + ! Makefile.SH bytecode.pl byterun.c byterun.h ext/B/B/Asmdata.pm +____________________________________________________________________________ +[ 584] By: mbeattie on 1998/02/25 15:36:38 + Log: Subject: [PATCH 5.004_60] dos-djgpp update + Date: Wed, 25 Feb 1998 11:17:07 +0100 + From: Laszlo Molnar + Branch: perl + ! djgpp/djgpp.c dosish.h hints/dos_djgpp.sh perl.c thread.h +____________________________________________________________________________ +[ 583] By: mbeattie on 1998/02/25 15:34:48 + Log: Move find_threadsv to right bit of global.sym. Bump patchlevel to 61. + Branch: perl + ! global.sym patchlevel.h +____________________________________________________________________________ +[ 582] By: mbeattie on 1998/02/25 15:28:08 + Log: Subject: Re: [PATCH 5.004_60] Fix goto-in-eval segfault (unwrapped!) + Date: Tue, 24 Feb 1998 11:15:57 +0000 + From: Robin Houston + Branch: perl + ! pod/perldiag.pod pp_ctl.c +____________________________________________________________________________ +[ 581] By: mbeattie on 1998/02/25 15:27:06 + Log: Subject: [PATCH] #ifdef CAN_PROTOTYPE cleanup + Date: 23 Feb 1998 23:36:09 +0100 + From: Gisle Aas + Branch: perl + ! doio.c miniperlmain.c op.c perl.c pp.h regcomp.c toke.c util.c +____________________________________________________________________________ +[ 580] By: mbeattie on 1998/02/25 15:25:29 + Log: Subject: [PATCH 5.004_60] improved Test.pm + Date: Sat, 21 Feb 1998 14:17:09 -0500 + From: Joshua Pritikin + Branch: perl + ! lib/Test.pm +____________________________________________________________________________ +[ 579] By: mbeattie on 1998/02/25 15:23:24 + Log: HP-UX hints and AIX global.sym changes (with Makefile.SH rule) + From: Jarkko Hietaniemi + Subject: [PATCH] 5.004_60: AIX: global.sym and Makefile.SH + Date: Sat, 21 Feb 1998 15:26:19 +0200 (EET) + Subject: Re: your HP-UX perl patch + Date: Mon, 23 Feb 1998 23:14:37 +0200 (EET) + Branch: perl + ! Makefile.SH embed.h global.sym hints/hpux.sh +____________________________________________________________________________ +[ 578] By: mbeattie on 1998/02/25 15:18:06 + Log: Back out DB_File patch (change _553) and tweak Configure. + Subject: ANNOUNCE: perl5.004_60 is available + Date: Mon, 23 Feb 1998 10:47:26 -0000 + From: Paul Marquess + Branch: perl + ! Configure ext/DB_File/DB_File.xs +____________________________________________________________________________ +[ 577] By: mbeattie on 1998/02/25 15:04:00 + Log: Subject: [PATCH] Cwd.pm + Date: Fri, 20 Feb 1998 10:27:54 -0600 + From: Graham Barr + Branch: perl + ! lib/Cwd.pm +____________________________________________________________________________ +[ 576] By: mbeattie on 1998/02/25 15:02:57 + Log: From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Subject: [5.004_5* PATCH] Make ornaments default in Term::ReadLine + Date: Fri, 20 Feb 1998 00:09:52 -0500 (EST) + Subject: [PATCH 5.004_5*] Fix debugger messages and the default package + Date: Fri, 20 Feb 1998 00:12:28 -0500 (EST) + Subject: Re: Continued presence of segmentation violation in study_chunk()[PATCH] + Date: Sat, 21 Feb 1998 15:32:29 -0500 (EST) + Branch: perl + ! lib/Term/ReadLine.pm lib/perl5db.pl regcomp.c +____________________________________________________________________________ +[ 575] By: mbeattie on 1998/02/25 14:58:00 + Log: Subject: Re: ANNOUNCE: perl5.004_60 Configure patch is available + Date: Tue, 24 Feb 1998 16:02:43 -0500 (EST) + From: Andy Dougherty + Branch: perl + + Porting/config.sh Porting/config_H + - config_H + ! Configure INSTALL MANIFEST Makefile.SH Porting/Glossary + ! Porting/pumpkin.pod config_h.SH ext/POSIX/POSIX.xs + ! hints/aix.sh hints/amigaos.sh hints/bsdos.sh hints/dec_osf.sh + ! hints/freebsd.sh hints/irix_6.sh hints/linux.sh + ! hints/netbsd.sh hints/next_3.sh hints/next_4.sh hints/os2.sh + ! hints/solaris_2.sh makedepend.SH perl.c perl.h pp.c pp_sys.c + ! t/lib/thread.t t/op/nothread.t x2p/Makefile.SH +____________________________________________________________________________ +[ 574] By: gsar on 1998/02/24 02:21:14 + Log: fix typos in sv.c + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 573] By: mbeattie on 1998/02/23 10:03:39 + Log: Remove old Linux+threads segfault degugging kludge. + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 572] By: gsar on 1998/02/23 09:45:26 + Log: undo previous change (no added value!) + Branch: win32/perl + ! win32/bin/pl2bat.pl +____________________________________________________________________________ +[ 571] By: gsar on 1998/02/23 09:18:32 + Log: fix pl2bat.pl to tolerate trailing .bat (as suggested by + John Cavanaugh ) + Branch: win32/perl + ! win32/bin/pl2bat.pl +____________________________________________________________________________ +[ 570] By: gsar on 1998/02/22 04:02:15 + Log: support chown() (just a noop for now) + Branch: win32/perl + ! dosish.h win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 569] By: gsar on 1998/02/22 03:09:55 + Log: integrate latest win32 branch + Branch: asperl + +> (branch 41 files) + !> (integrate 59 files) +____________________________________________________________________________ +[ 568] By: gsar on 1998/02/22 02:40:56 + Log: get compiler building under win32 (needed Makefile.PL + hacks that could be applicable to other platforms) + Branch: win32/perl + ! ext/B/Makefile.PL win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 567] By: gsar on 1998/02/22 01:30:19 + Log: integrate mainline + Branch: win32/perl + +> (branch 41 files) + !> (integrate 46 files) +____________________________________________________________________________ +[ 566] By: gsar on 1998/02/20 22:31:56 + Log: fix handle leak in join() + Branch: win32/perl + ! win32/win32thread.h + +---------------- +Version 5.004_60 +---------------- + +____________________________________________________________________________ +[ 565] By: mbeattie on 1998/02/20 18:23:47 + Log: Remove compiler files from their old lib/B locations. The compiler + now builds by default (without the byteperl executable so far) and + seems to work at least minimally. + Branch: perl + - lib/B.pm lib/B/Asmdata.pm lib/B/Assembler.pm lib/B/Bblock.pm + - lib/B/Bytecode.pm lib/B/C.pm lib/B/CC.pm lib/B/Debug.pm + - lib/B/Deparse.pm lib/B/Disassembler.pm lib/B/Lint.pm + - lib/B/Showlex.pm lib/B/Stackobj.pm lib/B/Terse.pm + - lib/B/Xref.pm lib/B/assemble lib/B/cc_harness + - lib/B/disassemble lib/B/makeliblinks lib/O.pm + ! MANIFEST bytecode.pl +____________________________________________________________________________ +[ 564] By: mbeattie on 1998/02/20 18:05:33 + Log: Move lib/B/... and lib/[BO].pm over to where they should be, + under ext/B. + Branch: perl + +> ext/B/B.pm ext/B/B/Asmdata.pm ext/B/B/Assembler.pm + +> ext/B/B/Bblock.pm ext/B/B/Bytecode.pm ext/B/B/C.pm + +> ext/B/B/CC.pm ext/B/B/Debug.pm ext/B/B/Deparse.pm + +> ext/B/B/Disassembler.pm ext/B/B/Lint.pm ext/B/B/Showlex.pm + +> ext/B/B/Stackobj.pm ext/B/B/Terse.pm ext/B/B/Xref.pm + +> ext/B/B/assemble ext/B/B/cc_harness ext/B/B/disassemble + +> ext/B/B/makeliblinks ext/B/O.pm +____________________________________________________________________________ +[ 563] By: mbeattie on 1998/02/20 17:54:58 + Log: Start getting compiler to work when built with the core. + [Still won't work as of this change.] + Branch: perl + +> byterun.c byterun.h lib/B/Asmdata.pm lib/B/Assembler.pm + +> lib/B/Bblock.pm lib/B/Bytecode.pm lib/B/C.pm lib/B/CC.pm + +> lib/B/Debug.pm lib/B/Deparse.pm lib/B/Disassembler.pm + +> lib/B/Lint.pm lib/B/Showlex.pm lib/B/Stackobj.pm + +> lib/B/Terse.pm lib/B/Xref.pm + ! MANIFEST Makefile.SH bytecode.pl ext/B/Makefile.PL +____________________________________________________________________________ +[ 562] By: mbeattie on 1998/02/20 16:42:13 + Log: Merge perlext/Compiler/... into mainline. Some files move to + ext/B/..., some to lib/B/..., O.pm and B.pm go in lib and some + move to the base perl directory (e.g. headers). Will need some + cleaning up before it builds properly, I would guess. + Branch: perl + +> bytecode.h bytecode.pl cc_runtime.h ext/B/B.xs + +> ext/B/Makefile.PL ext/B/NOTES ext/B/README ext/B/TESTS + +> ext/B/Todo ext/B/byteperl.c ext/B/ramblings/cc.notes + +> ext/B/ramblings/curcop.runtime ext/B/ramblings/flip-flop + +> ext/B/ramblings/magic ext/B/ramblings/reg.alloc + +> ext/B/ramblings/runtime.porting ext/B/typemap lib/B.pm + +> lib/B/assemble lib/B/cc_harness lib/B/disassemble + +> lib/B/makeliblinks lib/O.pm +____________________________________________________________________________ +[ 561] By: mbeattie on 1998/02/20 16:39:38 + Log: Win32 changes from Sarathy, tweaked slightly by me. + Branch: perlext + ! Compiler/B.xs Compiler/B/Asmdata.pm Compiler/B/Bytecode.pm + ! Compiler/B/C.pm Compiler/Makefile.PL Compiler/assemble + ! Compiler/bytecode.h Compiler/bytecode.pl Compiler/byteperl.c + ! Compiler/byterun.c Compiler/byterun.h Compiler/cc_harness +____________________________________________________________________________ +[ 560] By: mbeattie on 1998/02/20 15:46:15 + Log: Initialise $@ early (fixes t/lib/ph.t for threaded perl). + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 559] By: mbeattie on 1998/02/20 12:56:10 + Log: Add missing t/op/wantarray.t to MANIFEST. Bump patchlevel to 60. + Branch: perl + ! MANIFEST patchlevel.h +____________________________________________________________________________ +[ 558] By: mbeattie on 1998/02/20 12:53:26 + Log: Integrate win32 branch into mainline. + Branch: perl + !> XSUB.h config_h.SH doio.c lib/Pod/Html.pm pp_sys.c + !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc + !> win32/config_H.bc win32/config_H.gc win32/config_H.vc + !> win32/makedef.pl win32/makefile.mk win32/win32.c win32/win32.h + !> win32/win32iop.h x2p/a2p.h +____________________________________________________________________________ +[ 557] By: mbeattie on 1998/02/20 12:51:42 + Log: Subject: retry [PATCH] 5.004_59: the perlhist.pod etc + Date: Thu, 19 Feb 1998 17:54:52 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! ext/Thread/Thread.pm ext/Thread/Thread/Queue.pm + ! ext/Thread/Thread/Semaphore.pm ext/Thread/Thread/Specific.pm + ! lib/fields.pm pod/buildtoc pod/perl.pod pod/perlhist.pod + ! pod/perltoc.pod pod/perlvar.pod +____________________________________________________________________________ +[ 556] By: mbeattie on 1998/02/20 12:49:54 + Log: Subject: [PATCH] installperl + Date: Wed, 18 Feb 1998 11:51:44 -0500 (est) + From: Norton Allen + Branch: perl + ! installperl +____________________________________________________________________________ +[ 555] By: mbeattie on 1998/02/20 12:49:09 + Log: Subject: [PATCH:_59] t/op/wantarray.t + Date: Wed, 18 Feb 1998 11:19:54 -0500 (est) + From: Norton Allen + Branch: perl + + t/op/wantarray.t +____________________________________________________________________________ +[ 554] By: mbeattie on 1998/02/20 12:47:44 + Log: Subject: Misprint in regcomp.c [PATCH] + Date: Tue, 17 Feb 1998 23:54:07 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 553] By: mbeattie on 1998/02/20 12:45:08 + Log: Subject: DB_File ->length does not work just after tie. + Date: Tue, 17 Feb 1998 13:19:18 GMT + From: Nick Ing-Simmons + Branch: perl + ! ext/DB_File/DB_File.xs +____________________________________________________________________________ +[ 552] By: mbeattie on 1998/02/20 12:43:32 + Log: Subject: [PATCH] - perl5.005_59, update Copyright + Date: Mon, 16 Feb 1998 20:31:06 -0500 (EST) + From: lusol@CS4.CC.Lehigh.EDU (Stephen O. Lidie) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 551] By: mbeattie on 1998/02/20 12:42:41 + Log: Subject: Re: for() and map() peculiarity + Date: Mon, 16 Feb 1998 21:33:44 +0000 + From: "M.J.T. Guy" + Branch: perl + ! pod/perlsyn.pod +____________________________________________________________________________ +[ 550] By: mbeattie on 1998/02/20 12:41:53 + Log: Subject: [PATCH 5.004_59] Updates to VMS/CONFIG.VMS + Date: Mon, 16 Feb 1998 11:46:29 -0800 + From: Dan Sugalski + Branch: perl + ! vms/config.vms +____________________________________________________________________________ +[ 549] By: mbeattie on 1998/02/20 12:40:55 + Log: Subject: [PATCH] 5.004_59 global.sym for AIX 3.2.5 + Date: Mon, 16 Feb 1998 14:27:53 -0500 (EST) + From: "Stephen O. Lidie" + Branch: perl + ! global.sym +____________________________________________________________________________ +[ 548] By: mbeattie on 1998/02/20 12:39:56 + Log: Subject: [PATCH] 5.004_59: hints/irix_6.sh + Date: Mon, 16 Feb 1998 15:44:57 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 547] By: mbeattie on 1998/02/20 12:38:58 + Log: Subject: [PATCH] perlguts update + Date: 16 Feb 1998 11:23:53 +0100 + From: Gisle Aas + Branch: perl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 546] By: mbeattie on 1998/02/20 12:38:01 + Log: Subject: [PATCH 5.004_59] bsdos/hints.sh is wrong + Date: Sun, 15 Feb 1998 23:56:05 -0500 + From: Irving Reid + Branch: perl + ! hints/bsdos.sh +____________________________________________________________________________ +[ 545] By: mbeattie on 1998/02/20 12:37:11 + Log: Subject: [PATCH] 5% speedup in an empty loop + Date: Sun, 15 Feb 1998 17:49:46 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! op.c +____________________________________________________________________________ +[ 544] By: mbeattie on 1998/02/20 12:36:26 + Log: Subject: [PATCH for 5.004_59] netdb_host_type and netdb_hlen_type on NeXt + Date: Sun, 15 Feb 98 23:06:16 +0100 + From: Hans Mulder + Branch: perl + ! hints/next_3.sh hints/next_4.sh +____________________________________________________________________________ +[ 543] By: mbeattie on 1998/02/20 12:35:39 + Log: Subject: [PATCH for 5.004_59] Perl_sbrk declared inconsistently + Date: Sun, 15 Feb 98 23:05:20 +0100 + From: Hans Mulder + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 542] By: mbeattie on 1998/02/20 12:35:03 + Log: Subject: [PATCH for 5.004_59] "d_gethbyname" misspelled in Configure + From: Hans Mulder + Date: Sun, 15 Feb 98 23:04:29 +0100 + Branch: perl + ! Configure +____________________________________________________________________________ +[ 541] By: mbeattie on 1998/02/20 12:33:56 + Log: Subject: [PATCH for 5.004_59] NeXT doesn't need DONT_DECLARE_STD (was: + NeXT needs DONT_DECLARE_STD) + Date: Sun, 15 Feb 98 23:04:19 +0100 + From: Hans Mulder + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 540] By: mbeattie on 1998/02/20 12:32:25 + Log: Subject: [PATCH] sv_check_thinkfirst macroized + Date: 15 Feb 1998 22:00:38 +0100 + From: Gisle Aas + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 539] By: mbeattie on 1998/02/20 12:31:07 + Log: Subject: [PATCH 5.004_59] allow the Test::Harness to grok TODO-type tests docs + Date: Sat, 14 Feb 1998 17:58:01 -0500 + From: Joshua Pritikin + Branch: perl + + lib/Test.pm + ! MANIFEST lib/Test/Harness.pm +____________________________________________________________________________ +[ 538] By: mbeattie on 1998/02/20 12:24:31 + Log: Subject: [PATCH] 5.004_59: locale startup problems documentation++ + Date: Sat, 14 Feb 1998 15:40:44 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! INSTALL pod/perldiag.pod pod/perllocale.pod +____________________________________________________________________________ +[ 537] By: mbeattie on 1998/02/20 12:23:04 + Log: Subject: [PATCH] Updated, non-wordwrapped, patch to README.VMS + Date: Fri, 13 Feb 1998 13:38:28 -0800 + From: Dan Sugalski + Branch: perl + ! README.vms +____________________________________________________________________________ +[ 536] By: mbeattie on 1998/02/20 12:20:29 + Log: Subject: [PATCH] 5.004_58, move intuition tests + Date: Thu, 12 Feb 1998 17:11:05 -0600 + From: Stephen Potter + Branch: perl + ! t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t + ! t/lib/sdbm.t t/op/array.t t/op/delete.t t/op/each.t + ! t/op/flip.t t/op/pat.t t/op/push.t +____________________________________________________________________________ +[ 535] By: gsar on 1998/02/19 23:07:24 + Log: applied a version of this with tabs intact + Message-Id: + Date: 19 Feb 1998 15:06:38 EST + From: dfan@harmonixmusic.com (Dan Schmidt) + Subject: Pod::Html bug and fix: missing in index + Branch: win32/perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 534] By: gsar on 1998/02/19 19:40:27 + Log: Fix C<0> problem in Pod::Html + Branch: win32/perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 533] By: gsar on 1998/02/18 18:11:08 + Log: non-debug VC builds are -O1 now (they say it works, and is + faster) + Branch: win32/perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 532] By: gsar on 1998/02/18 04:11:03 + Log: integrate nick's patch to mainline + Branch: win32/perl + !> pp.c +____________________________________________________________________________ +[ 531] By: mbeattie on 1998/02/17 17:50:50 + Log: Assorted changes to the compiler + Branch: perlext + ! Compiler/B.pm Compiler/B.xs Compiler/B/Asmdata.pm + ! Compiler/B/Bytecode.pm Compiler/B/C.pm Compiler/B/Debug.pm + ! Compiler/NOTES Compiler/O.pm Compiler/bytecode.pl + ! Compiler/byterun.c Compiler/byterun.h Compiler/typemap +____________________________________________________________________________ +[ 530] By: gsar on 1998/02/17 01:47:35 + Log: DLLs are now ok on mingw32/gcc-2.8.0 after removing the + FORCE_ARG_STRING() hack (that bug is fixed in gcc now). mingw32 + build passes all tests except t/lib/io_xs.t (seems to be due to + broken tmpfile() in the CRT or import lib) + Branch: win32/perl + ! XSUB.h win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 529] By: gsar on 1998/02/16 23:03:31 + Log: fix mingw32 gcc 2.8.0 build (DLLs generated seem to be broken + in this version of gcc!) + Branch: win32/perl + ! doio.c pp_sys.c win32/config.gc win32/makefile.mk + ! win32/win32.c win32/win32.h win32/win32iop.h x2p/a2p.h +____________________________________________________________________________ +[ 528] By: nick on 1998/02/16 22:13:04 + Log: Missing PUSHMARK in unshift TIEARRAY hook + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 527] By: gsar on 1998/02/15 20:59:07 + Log: integrate win32 branch + Branch: asperl + !> config_h.SH win32/config.bc win32/config.gc win32/config.vc + !> win32/config_H.bc win32/config_H.gc win32/config_H.vc + !> win32/makedef.pl +____________________________________________________________________________ +[ 526] By: gsar on 1998/02/15 20:02:11 + Log: Fix typo: s/GETNETBYADD\b/GETNETBYADDR/ + Branch: win32/perl + ! config_h.SH win32/config_H.bc win32/config_H.gc + ! win32/config_H.vc +____________________________________________________________________________ +[ 525] By: gsar on 1998/02/15 03:26:45 + Log: fix build problems due to renamed Config variables + Branch: win32/perl + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makedef.pl +____________________________________________________________________________ +[ 524] By: gsar on 1998/02/14 01:00:15 + Log: bring ASPerl uptodate with mainline changes + Branch: asperl + +> ext/DB_File/Changes t/comp/require.t + !> (integrate 41 files) +____________________________________________________________________________ +[ 523] By: gsar on 1998/02/14 00:52:17 + Log: integrate mainline + Branch: win32/perl + !> hints/qnx.sh lib/Cwd.pm lib/ExtUtils/xsubpp patchlevel.h + !> pp_hot.c t/op/magic.t +____________________________________________________________________________ +[ 522] By: gsar on 1998/02/14 00:42:37 + Log: added AS patch#6 + Message-Id: <01BD3846.B29FB880.dougl@ActiveState.com> + Date: Fri, 13 Feb 1998 06:14:51 PST + From: Douglas Lankshear + Subject: [PATCH] command line build + + This patch is for the command line build of perl object. + I'll merge the ipfoo.c function with win32_xxx functions next. + + -- Doug + Branch: asperl + ! ObjXSub.h ext/Opcode/Opcode.xs lib/ExtUtils/MM_Win32.pm + ! objpp.h proto.h sv.c win32/dl_win32.xs win32/ipenv.c + ! win32/ipstdio.c win32/makedef.pl win32/runperl.c win32/win32.h +____________________________________________________________________________ +[ 521] By: gsar on 1998/02/14 00:14:04 + Log: added AS patch#5 (patch #4 was intentionally skipped after + discussion) + Branch: asperl + ! embed.h embedvar.h global.sym globals.c hv.c interp.sym + ! intrpvar.h op.c perl.c perl.h pp_ctl.c proto.h regcomp.c + ! regexec.c sv.c toke.c +____________________________________________________________________________ +[ 520] By: nick on 1998/02/13 18:15:46 + Log: Resolve ansiperl against win32 + Branch: ansiperl + +> ext/DB_File/Changes ext/POSIX/hints/linux.pl + +> ext/POSIX/hints/sunos_4.pl lib/Fatal.pm t/comp/require.t + +> t/lib/ph.t + !> (integrate 898 files) + +---------------- +Version 5.004_59 +---------------- + +____________________________________________________________________________ +[ 519] By: mbeattie on 1998/02/13 17:05:37 + Log: Integrate win32 into mainline. + Branch: perl + ! lib/ExtUtils/xsubpp + !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc + !> win32/makefile.mk +____________________________________________________________________________ +[ 518] By: mbeattie on 1998/02/13 17:01:16 + Log: Bump patchlevel.h to 59. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 517] By: mbeattie on 1998/02/13 16:57:59 + Log: Subject: [PATCH] _58: wantarray in void context broken + Date: Fri, 13 Feb 1998 11:24:49 -0500 (est) + From: Norton Allen + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 516] By: mbeattie on 1998/02/13 16:55:33 + Log: Subject: [PATCH] 5.004_58 QNX getcwd + Date: Thu, 12 Feb 1998 13:40:56 -0500 (est) + From: Norton Allen + Branch: perl + ! hints/qnx.sh lib/Cwd.pm t/op/magic.t +____________________________________________________________________________ +[ 515] By: gsar on 1998/02/12 18:29:52 + Log: pickup lddlflags properly for Config.pm + Branch: win32/perl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 514] By: gsar on 1998/02/12 18:16:09 + Log: fix xsubpp bug in SETMAGIC code + Branch: win32/perl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 513] By: gsar on 1998/02/12 18:06:30 + Log: integrate mainline + Branch: win32/perl + +> ext/DB_File/Changes + !> Configure MANIFEST config_h.SH ext/DB_File/DB_File.pm + !> ext/DB_File/DB_File.xs hints/machten.sh + !> lib/ExtUtils/Install.pm lib/Pod/Html.pm lib/Pod/Text.pm + !> lib/perl5db.pl malloc.c pod/perldiag.pod pod/perlpod.pod + !> pod/pod2man.PL pp_sys.c regcomp.c regexec.c scope.h sv.c + !> t/lib/db-recno.t t/lib/filecopy.t t/op/misc.t t/op/pat.t + !> t/op/re_tests t/pragma/locale.t +____________________________________________________________________________ +[ 512] By: mbeattie on 1998/02/12 17:34:02 + Log: Missing WITH_THR from new deb() in ENTER/LEAVE caused builds + with -DUSE_THREADS -DDEBUGGING to fail. + Branch: perl + ! scope.h +____________________________________________________________________________ +[ 511] By: mbeattie on 1998/02/12 16:44:03 + Log: Integrate win32 into mainline + Branch: perl + +> t/comp/require.t + !> MANIFEST pp_ctl.c scope.c scope.h t/op/local.t toke.c +____________________________________________________________________________ +[ 510] By: mbeattie on 1998/02/12 16:42:26 + Log: Subject: Re: [PATCH] 5.004_58 | _04 DynaLoader.pm -> DynaLoader.pm.PL (resend) + Date: 12 Feb 1998 14:25:55 +0100 + From: koenig@kulturbox.de (Andreas J. Koenig) + Branch: perl + ! lib/ExtUtils/Install.pm +____________________________________________________________________________ +[ 509] By: mbeattie on 1998/02/12 16:40:34 + Log: Subject: Re: wrong prototype for sbrk [PATCH] + Date: Wed, 11 Feb 1998 15:37:31 -0500 (EST) + From: Andy Dougherty + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 508] By: mbeattie on 1998/02/12 16:36:53 + Log: Subject: [PATCH] 5.004_58 | _04: pod2*,perlpod: L + Date: Wed, 11 Feb 1998 17:29:20 +0100 + From: Achim Bohnet + Branch: perl + ! lib/Pod/Html.pm lib/Pod/Text.pm pod/perlpod.pod pod/pod2man.PL +____________________________________________________________________________ +[ 507] By: mbeattie on 1998/02/12 16:35:26 + Log: Subject: [PATCH] slight tweaks to hints/machten.sh + Date: Wed, 11 Feb 1998 14:59:46 +0100 + From: Dominic Dunlop + Branch: perl + ! hints/machten.sh +____________________________________________________________________________ +[ 506] By: mbeattie on 1998/02/12 16:28:40 + Log: Subject: DB_File 1.58 patch + Date: Tue, 10 Feb 1998 11:23:22 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + + ext/DB_File/Changes + ! MANIFEST ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + ! t/lib/db-recno.t +____________________________________________________________________________ +[ 505] By: mbeattie on 1998/02/12 16:24:26 + Log: Subject: 5.004_5*: [PATCH] restore old behaviour of \1 in RE + Date: Tue, 10 Feb 1998 02:57:46 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! regexec.c t/op/re_tests +____________________________________________________________________________ +[ 504] By: mbeattie on 1998/02/12 16:22:46 + Log: From: Jarkko Hietaniemi + Subject: [PATCH] 5.004_58: the locale.t problem in IRIX + Date: Mon, 9 Feb 1998 19:47:22 +0200 (EET) + Subject: [PATCH] 5.004_58: reserve the POSIX regexp extensions + Date: Tue, 10 Feb 1998 15:12:12 +0200 (EET) + Subject: [PATCH] 5.004_58: API prototype probing + Date: Wed, 11 Feb 1998 12:50:35 +0200 (EET) + Branch: perl + ! Configure config_h.SH pod/perldiag.pod pp_sys.c regcomp.c + ! t/op/misc.t t/op/pat.t t/op/re_tests t/pragma/locale.t +____________________________________________________________________________ +[ 503] By: mbeattie on 1998/02/12 16:15:43 + Log: Subject: [PATCH] filecopy.t #3 fails on dos-djgpp + Date: Mon, 9 Feb 1998 13:19:45 +0100 + From: Laszlo Molnar + Branch: perl + ! t/lib/filecopy.t +____________________________________________________________________________ +[ 502] By: mbeattie on 1998/02/12 16:14:27 + Log: Assorted patches to sv.c: + From: Gisle Aas + Subject: [PATCH] sv_grow can fail for HAS_64K_LIMIT systems + Date: 07 Feb 1998 00:21:57 +0100 + Subject: [PATCH] sv_setnv will upgrade SVt_NV to SVt_PVNV + Date: 07 Feb 1998 00:29:45 +0100 + Subject: [PATCH] sv_upgrade() always returns TRUE + Date: 09 Feb 1998 15:44:01 +0100 + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 501] By: mbeattie on 1998/02/12 16:09:26 + Log: Fix saving of STDOUT during system() in lib/perl5db.pl: + Subject: Perl debugger. + Date: Fri, 6 Feb 1998 17:47:08 -0500 + From: "Jason A. Smith" + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 500] By: gsar on 1998/02/12 03:20:55 + Log: merge another maint patch + Message-Id: <199802102349.SAA16001@aatma.engin.umich.edu> + Date: Tue, 10 Feb 1998 18:49:00 EST + From: Gurusamy Sarathy + Subject: Re: after an eval-ed bad require, requiring a string ref gives a SEGV + Branch: win32/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 499] By: gsar on 1998/02/12 03:14:39 + Log: make t/comp/require.t type xtext + Branch: win32/perl + ! t/comp/require.t +____________________________________________________________________________ +[ 498] By: gsar on 1998/02/12 03:09:58 + Log: fix extra LEAVE when require fails + Message-Id: <199802102321.SAA15346@aatma.engin.umich.edu> + Date: Tue, 10 Feb 1998 18:21:37 EST + From: Gurusamy Sarathy + Subject: Re: evals and requires make seg-fault with bad require file + Branch: win32/perl + + t/comp/require.t + ! MANIFEST pp_ctl.c scope.c scope.h toke.c +____________________________________________________________________________ +[ 497] By: gsar on 1998/02/12 02:47:29 + Log: merge a maint patch + Message-Id: <199802110515.AAA23700@aatma.engin.umich.edu> + Date: Wed, 11 Feb 1998 00:15:51 EST + From: Gurusamy Sarathy + Subject: Re: "local" can crash perl-4.00[34] on Solaris-x86 & FreeBSD + Branch: win32/perl + ! pp_ctl.c t/op/local.t +____________________________________________________________________________ +[ 496] By: mbeattie on 1998/02/11 13:04:50 + Log: Integrate win32 into mainline. + Branch: perl + !> embed.h ext/GDBM_File/typemap ext/NDBM_File/typemap + !> ext/ODBM_File/typemap ext/SDBM_File/typemap global.sym gv.c + !> lib/ExtUtils/typemap lib/ExtUtils/xsubpp op.c + !> os2/OS2/PrfDB/typemap pod/perlguts.pod pod/perlobj.pod + !> pod/perlxs.pod pod/perlxstut.pod proto.h sv.c sv.h t/op/ref.t + !> win32/makedef.pl win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 495] By: mbeattie on 1998/02/11 13:03:59 + Log: Fix special constants in Xref.pm + Branch: perlext + ! Compiler/B/Xref.pm +____________________________________________________________________________ +[ 494] By: gsar on 1998/02/10 18:26:28 + Log: fix opendir() problem on share names + Message-Id: <199802101828.NAA10420@aatma.engin.umich.edu> + Date: Tue, 10 Feb 1998 13:28:53 EST + From: Gurusamy Sarathy + Subject: Re: BUG: opendir and UNC names on NT + Branch: win32/perl + ! win32/win32.c +____________________________________________________________________________ +[ 493] By: gsar on 1998/02/09 23:09:40 + Log: integrate win32 branch contents + Branch: asperl + +> ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + +> lib/Fatal.pm t/lib/ph.t + ! hv.c + !> (integrate 895 files) +____________________________________________________________________________ +[ 492] By: gsar on 1998/02/09 07:30:19 + Log: enhancements to previous patch for XSUB OUTPUT args + Message-Id: <199802090731.CAA04438@aatma.engin.umich.edu> + Date: Mon, 09 Feb 1998 02:31:55 EST + From: Gurusamy Sarathy + Subject: Re: [PATCH] XSUB OUTPUT arguments and 'set' magic + Branch: win32/perl + ! embed.h ext/GDBM_File/typemap ext/NDBM_File/typemap + ! ext/ODBM_File/typemap ext/SDBM_File/typemap global.sym + ! lib/ExtUtils/typemap lib/ExtUtils/xsubpp os2/OS2/PrfDB/typemap + ! pod/perlguts.pod pod/perlxs.pod pod/perlxstut.pod proto.h sv.c + ! sv.h +____________________________________________________________________________ +[ 491] By: gsar on 1998/02/09 03:00:52 + Log: don't share TARG unless -DUSE_BROKEN_PAD_RESET + Message-Id: <199710300036.TAA01004@aatma.engin.umich.edu> + Date: Wed, 29 Oct 1997 19:36:25 EST + From: Gurusamy Sarathy + Subject: [PATCH] Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 ) + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 490] By: gsar on 1998/02/09 02:30:43 + Log: fix for bugs in handling DESTROY (adjusted test numbers) + Message-Id: <199801010030.TAA14274@aatma.engin.umich.edu> + Subject: Re: [PERL] RFD: iterative DESTROYing of objects + Date: Wed, 31 Dec 1997 19:30:46 -0500 + From: Gurusamy Sarathy + Branch: win32/perl + ! pod/perlobj.pod sv.c t/op/ref.t +____________________________________________________________________________ +[ 489] By: gsar on 1998/02/09 00:30:35 + Log: ansify prototype for my_safemalloc(), avoid warnings + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 488] By: gsar on 1998/02/09 00:29:08 + Log: fix misapplied hunks in 5.004_58 + Message-Id: <199802080718.CAA18115@aatma.engin.umich.edu> + Date: Sun, 08 Feb 1998 02:18:12 EST + From: Gurusamy Sarathy + Subject: [PATCH] fixes for test failures in 5.004_58 + Branch: win32/perl + ! gv.c op.c +____________________________________________________________________________ +[ 487] By: gsar on 1998/02/09 00:27:16 + Log: win32_utime() tweaks to avoid warnings + Branch: win32/perl + ! win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 486] By: gsar on 1998/02/07 23:45:22 + Log: integrate mainline, plus a few small win32 enhancements + - remove Win32::GetCurrentDirectory() + - add Win32::Sleep() for compat + - add smarter utime() from Jan Dubois, and export it as win32_utime() + Branch: win32/perl + +> ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + +> lib/Fatal.pm t/lib/ph.t + ! win32/makedef.pl win32/win32.c win32/win32iop.h + !> (integrate 61 files) + +---------------- +Version 5.004_58 +---------------- + +____________________________________________________________________________ +[ 485] By: mbeattie on 1998/02/06 18:11:47 + Log: Bump patchlevel to 58. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 484] By: mbeattie on 1998/02/06 18:08:28 + Log: Fix up problem with gv.c from change 477. + Fix up Config.pm use in t/lib/ph.t from change 478. + Branch: perl + ! gv.c t/lib/ph.t +____________________________________________________________________________ +[ 483] By: mbeattie on 1998/02/06 17:34:34 + Log: Integrate win32 branch into mainline + Branch: perl + !> win32/win32sck.c +____________________________________________________________________________ +[ 482] By: mbeattie on 1998/02/06 17:26:41 + Log: lib/Fatal.pm missing from repository + Branch: perl + + lib/Fatal.pm +____________________________________________________________________________ +[ 481] By: mbeattie on 1998/02/06 17:24:57 + Log: Subject: [PATCH] Re: posix::strftime (core dumped) + Date: Thu, 5 Feb 1998 13:55:23 -0500 (EST) + From: Andy Dougherty + Branch: perl + + ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + ! MANIFEST hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t +____________________________________________________________________________ +[ 480] By: mbeattie on 1998/02/06 17:19:52 + Log: x2p/str.c was missing from list of changed files in change 466 + Branch: perl + ! x2p/str.c +____________________________________________________________________________ +[ 479] By: mbeattie on 1998/02/06 17:16:54 + Log: Added t/lib/ph.t to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 478] By: mbeattie on 1998/02/06 17:15:38 + Log: Subject: [PATCH] h2ph.PL + Date: Thu, 5 Feb 1998 05:53:54 -0800 (EST) + From: kstar@www.chapin.edu (Kurt D. Starsinic) + Branch: perl + + t/lib/ph.t + ! utils/h2ph.PL +____________________________________________________________________________ +[ 477] By: mbeattie on 1998/02/06 17:10:46 + Log: Subject: [PATCH] Faster gv_fetchpv() for nested packages + Date: 04 Feb 1998 14:49:46 +0100 + From: Gisle Aas + as modified by + From: chip@atlantic.net + Date: Wed, 4 Feb 1998 11:46:49 -0500 (EST) + Branch: perl + ! gv.c +____________________________________________________________________________ +[ 476] By: mbeattie on 1998/02/06 16:47:03 + Log: From: Jarkko Hietaniemi + Subject: [PATCH] almost OK: perl 5.00457 on i386-freebsd-thread 3.0 + Date: Wed, 4 Feb 1998 12:59:47 +0200 (EET) + Subject: Re: [PATCH] 5.004_04 and 5.004_57: Complex.pm and complex.t + Date: Thu, 5 Feb 1998 18:08:20 +0200 (EET) + Branch: perl + ! hints/freebsd.sh lib/Math/Complex.pm t/lib/complex.t +____________________________________________________________________________ +[ 475] By: mbeattie on 1998/02/06 16:44:57 + Log: Subject: [PATCH] nomemok + Date: Mon, 2 Feb 1998 15:06:50 +0100 + From: Gisle Aas + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 474] By: mbeattie on 1998/02/06 16:43:46 + Log: Subject: [PATCH] Benchmark.pm: timethese corrupts $_ + Date: Sun, 1 Feb 1998 06:46:08 -0500 (EST) + From: abigail@fnx.com + Branch: perl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 473] By: mbeattie on 1998/02/06 16:42:53 + Log: Subject: [PATCH] adding the newSVpvn API function + Date: Sat, 31 Jan 1998 06:32:42 +0100 + From: Matthias Ulrich Neeracher + Branch: perl + ! embed.h embedvar.h global.sym pod/perlguts.pod pod/perltoc.pod + ! proto.h sv.c +____________________________________________________________________________ +[ 472] By: mbeattie on 1998/02/06 16:35:41 + Log: Subject: Re: [PATCH] new hints/solaris2.sh (was Re: make check fails 17% of it's tests on Solaris...) + Date: 28 Jan 1998 17:40:37 -0800 + From: Stephen Zander + Branch: perl + ! hints/solaris_2.sh +____________________________________________________________________________ +[ 471] By: mbeattie on 1998/02/06 16:02:57 + Log: Subject: [PATCH] Re: 5.004_04 vec() fails with 32-bit values + Date: Thu, 15 Jan 1998 11:53:06 +0000 + From: "M.J.T. Guy" + Branch: perl + ! pod/perlguts.pod pp.c t/op/vec.t +____________________________________________________________________________ +[ 470] By: mbeattie on 1998/02/06 16:01:36 + Log: From: Ilya Zakharevich + Subject: 5.004_56: Patch to Tie::Hash and docs + Date: Sun, 11 Jan 1998 20:34:05 -0500 (EST) + Subject: 5.004_56: Patch to (?{}) quoting + cosmetic + Date: Mon, 2 Feb 1998 01:28:46 -0500 (EST) + Branch: perl + ! lib/Tie/Hash.pm pod/perlfunc.pod pod/perlre.pod regcomp.c + ! t/op/misc.t t/op/pat.t toke.c +____________________________________________________________________________ +[ 469] By: mbeattie on 1998/02/06 15:58:31 + Log: Subject: Another Array.pm patch + Date: Wed, 4 Feb 1998 20:37:03 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + ! lib/Tie/Array.pm +____________________________________________________________________________ +[ 468] By: mbeattie on 1998/02/06 15:56:28 + Log: Subject: documentation patch for 5.004_57 + Date: Wed, 4 Feb 1998 14:54:13 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + ! lib/Tie/Array.pm +____________________________________________________________________________ +[ 467] By: mbeattie on 1998/02/06 15:55:34 + Log: Subject: 5.004_56: patch for `use Fatal' again + Date: Thu, 29 Jan 1998 17:04:28 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! MANIFEST pod/perldiag.pod pod/perlfunc.pod pod/perlmodlib.pod + ! pp.c t/comp/proto.t toke.c +____________________________________________________________________________ +[ 466] By: mbeattie on 1998/02/06 15:53:53 + Log: Subject: Newer -DLEAKTEST patch + Date: Fri, 9 Jan 1998 17:55:09 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! ext/DB_File/DB_File.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_vms.xs ext/Opcode/Opcode.xs handy.h hv.c + ! perl.c perly.c perly.c.diff perly.fixer pod/perlembed.pod + ! pod/perlguts.pod pod/perlrun.pod pod/perltoc.pod pp_hot.c sv.c + ! toke.c util.c vms/perly_c.vms x2p/hash.c +____________________________________________________________________________ +[ 465] By: mbeattie on 1998/02/06 15:46:35 + Log: More Chip patches (tweaked for _5x). The final one mentioned here + (@ARGV with -i) actually went in at change 462 but I failed to + add it to the change description: + Subject: [PATCH] Fix typo: "FORM{,AT}LINE" + Date: Sun, 11 Jan 1998 19:37:17 -0500 (EST) + Subject: [PATCH] Fix for C<@x = my @y> + Date: Sun, 11 Jan 1998 18:12:16 -0500 (EST) + Subject: [PATCH] Fix SEGV on C<*glob{SCALAR,ARRAY}> + Date: Thu, 5 Feb 1998 21:30:13 -0500 (EST) + Subject: [PATCH] Allow last() to mean last + Date: Thu, 5 Feb 1998 21:42:57 -0500 (EST) + Subject: [PATCH] Consider @ARGV to be plain files if inplace (-i) + Date: Wed, 4 Feb 1998 16:04:47 -0500 (EST) + Branch: perl + ! op.c perly.c perly.h perly.y sv.c t/op/my.t vms/perly_c.vms + ! vms/perly_h.vms +____________________________________________________________________________ +[ 464] By: mbeattie on 1998/02/06 15:06:18 + Log: More Chip patches: + Subject: [PATCH] Fix SEGV from combining caller and C + Date: Thu, 5 Feb 1998 21:47:50 -0500 (EST) + Subject: [PATCH] Fix line numbers after here documents in eval STRING + Date: Thu, 5 Feb 1998 21:50:08 -0500 (EST) + Subject: [PATCH] Make recursive lexical analysis more robust + Date: Thu, 5 Feb 1998 21:57:02 -0500 (EST) + Branch: perl + ! pp_ctl.c sv.c toke.c +____________________________________________________________________________ +[ 463] By: mbeattie on 1998/02/06 15:04:17 + Log: Some more Chip patches (tweaked to match _5x): + Subject: [PATCH] Fix empty BLOCK + Date: Wed, 4 Feb 1998 16:52:28 -0500 (EST) + Subject: [PATCH] fix (\@@) proto + Date: Thu, 5 Feb 1998 10:24:29 -0500 (EST) + Subject: [PATCH] Cope with lack of args in Fcntl::AUTOLOAD + Date: Thu, 5 Feb 1998 21:26:55 -0500 (EST) + Subject: [PATCH] Don't fold string comparison under C + Date: Thu, 5 Feb 1998 21:46:25 -0500 (EST) + Branch: perl + ! ext/Fcntl/Fcntl.pm op.c t/comp/proto.t toke.c +____________________________________________________________________________ +[ 462] By: mbeattie on 1998/02/06 14:56:30 + Log: Some Chip patches (some tweaked to match _5x source): + From: Chip Salzenberg + Subject: [PATCH] local leakage + Date: Tue, 3 Feb 1998 09:16:50 -0500 (EST) + Subject: [PATCH] NULs in patterns + Date: Wed, 4 Feb 1998 01:33:51 -0500 (EST) + Subject: [PATCH] Configure on PerlIO + Date: Wed, 4 Feb 1998 01:38:43 -0500 (EST) + Subject: [PATCH] Avoid core dump on package alias + Date: Wed, 4 Feb 1998 15:38:42 -0500 (EST) + Subject: [PATCH] Fix name of $Foo::{'Bar::'} + Date: Wed, 4 Feb 1998 16:37:51 -0500 (EST) + Branch: perl + ! Configure doio.c gv.c op.c pp_ctl.c sv.c t/op/gv.t + ! t/op/local.t +____________________________________________________________________________ +[ 461] By: gsar on 1998/02/04 03:34:36 + Log: support win32_select(0,0,0,msec) (winsock doesn't) + Branch: win32/perl + ! win32/win32sck.c +____________________________________________________________________________ +[ 460] By: gsar on 1998/02/04 00:44:47 + Log: bug: win32_select() must StartSockets() + Branch: win32/perl + ! win32/win32sck.c + +---------------- +Version 5.004_57 +---------------- + +____________________________________________________________________________ +[ 459] By: mbeattie on 1998/02/03 16:00:07 + Log: Replaced two occurrences of THREADSV(find_thread_sv(...)) (order + of execution causes core dump if threadsvp is moved). Replaced + lvalue occurrence of AvARRAY(av) with SvPVX(av) (former does cast). + Branch: perl + ! av.c perl.c +____________________________________________________________________________ +[ 458] By: mbeattie on 1998/02/03 14:40:02 + Log: Fix up MANIFEST. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 457] By: mbeattie on 1998/02/03 13:50:23 + Log: Integrate win32 into mainline. My last integration from ansiperl + to the mainline was a dismal failure: I did -ay but meant -at. + This should fix things now since win32 has already integrated + all the necessary changes from ansiperl. + Branch: perl + !> (integrate 111 files) +____________________________________________________________________________ +[ 456] By: gsar on 1998/02/03 04:48:08 + Log: Fix minor problems with non USE_THREADS build. win32 branch + now looks 5.004_57-ready. + Branch: win32/perl + ! thread.h win32/makedef.pl +____________________________________________________________________________ +[ 455] By: gsar on 1998/02/03 03:45:09 + Log: integrate mainline + Branch: win32/perl + !> (integrate 887 files) +____________________________________________________________________________ +[ 454] By: mbeattie on 1998/02/02 16:44:24 + Log: The new dec_osf.sh didn't work so the new glibpth and useshrplib + defaults have been commented out for now. + Branch: perl + ! hints/dec_osf.sh +____________________________________________________________________________ +[ 453] By: mbeattie on 1998/02/02 15:51:39 + Log: Introduced thr->threadsvp and THREADSV() for faster per-thread + variables. Moved threadnum to a per-interpreter variable and + made dTHR and lock/unlock of sv_mutex bypass the get/lock unless + more than one thread may be running. Minor tweaks to Thread.xs. + Branch: perl + ! dosish.h embedvar.h ext/Thread/Thread.xs interp.sym intrpvar.h + ! op.c perl.c perl.h pp.c pp_ctl.c scope.c sv.c thrdvar.h + ! thread.h util.c +____________________________________________________________________________ +[ 452] By: gsar on 1998/02/02 04:56:50 + Log: remove totally egregious s/\\dir// in File::Find + Branch: win32/perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 451] By: gsar on 1998/02/01 22:20:20 + Log: added AS patch#3 + Message-Id: <01BD2EF2.53433A40.dougl@ActiveState.com> + Date: Sun, 01 Feb 1998 09:18:13 PST + From: Douglas Lankshear + To: "'Gurusamy Sarathy'" + + Here's an additional diff against //depot/asperl + + The field name mg_length was changed back to mg_len + The function name mg_len was change to mg_length + + The need for sort_mutex removed thanks to the code derived + from Tom Horsley's work. + + -- Doug + Branch: asperl + + XSLock.h + ! ObjXSub.h XSUB.h av.c embedvar.h ext/DynaLoader/dlutils.c + ! globals.c ipstdio.h mg.c mg.h objpp.h perl.c perl.h perlio.h + ! perlvars.h perly.c pp.c pp_ctl.c pp_hot.c proto.h regexec.c + ! scope.c scope.h sv.c toke.c universal.c util.c + ! win32/dl_win32.xs win32/iplio.c win32/ipstdio.c + ! win32/perlobj.def win32/runperl.c +____________________________________________________________________________ +[ 450] By: gsar on 1998/01/30 23:43:57 + Log: various tweaks + - add new functions to proto.h + - fix up makefile.mk for $(OBJECT) + Branch: asperl + ! pp_ctl.c proto.h win32/makefile.mk +____________________________________________________________________________ +[ 449] By: gsar on 1998/01/30 21:23:15 + Log: fix up missing patches from AS patch#2 + Branch: asperl + ! perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h + ! pp_ctl.c proto.h +____________________________________________________________________________ +[ 448] By: gsar on 1998/01/30 18:23:17 + Log: fix htonlx typo + Branch: win32/perl + ! perlsock.h +____________________________________________________________________________ +[ 447] By: mbeattie on 1998/01/30 16:03:49 + Log: Fix up MANIFEST to add missing files + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 446] By: mbeattie on 1998/01/30 12:34:55 + Log: Bump patchlevel to 57. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 445] By: gsar on 1998/01/30 10:44:38 + Log: initial merge of latest win32 branch into ASPerl + Branch: asperl + +> lib/Tie/Array.pm pod/perlhist.pod t/lib/tie-push.t + +> t/lib/tie-stdarray.t t/lib/tie-stdpush.t t/op/tiearray.t + +> win32/bin/perlglob.pl + !> (integrate 141 files) +____________________________________________________________________________ +[ 444] By: gsar on 1998/01/30 09:25:58 + Log: goofed branching, redo asperl branch + Branch: asperl + ! perl.h +____________________________________________________________________________ +[ 443] By: gsar on 1998/01/30 09:23:36 + Log: added AS patch#2 + Branch: asperl + + ObjXSub.h ipdir.h ipenv.h iplio.h ipmem.h ipproc.h ipsock.h + + ipstdio.h objpp.h win32/ipdir.c win32/ipenv.c win32/iplio.c + + win32/ipmem.c win32/ipproc.c win32/ipsock.c win32/ipstdio.c + + win32/ipstdiowin.h win32/perlobj.def + ! EXTERN.h XSUB.h cv.h doio.c dosish.h dump.c embedvar.h + ! globals.c gv.c hv.c intrpvar.h malloc.c mg.c mg.h op.c op.h + ! opcode.h perl.c perl.h perldir.h perlenv.h perlio.h perllio.h + ! perlmem.h perlproc.h perlsock.h perlvars.h perly.c pp.c pp.h + ! pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regcomp.h + ! regexec.c run.c scope.c scope.h sv.c sv.h thread.h toke.c + ! universal.c util.c vms/vms.c win32/Makefile win32/config_H.bc + ! win32/config_H.vc win32/dl_win32.xs win32/include/sys/socket.h + ! win32/makedef.pl win32/runperl.c win32/win32iop.h +____________________________________________________________________________ +[ 441] By: gsar on 1998/01/30 08:54:19 + Log: Created new branch from win32@396, added AS patch#1 + Branch: asperl + + doio.c malloc.c perl.c perl.h perldir.h perlenv.h perllio.h + + perlmem.h perlproc.h perlsock.h pp.c pp_hot.c pp_sys.c + + regcomp.c scope.h sv.c toke.c util.c + +> (branch 915 files) +____________________________________________________________________________ +[ 440] By: gsar on 1998/01/30 04:43:23 + Log: integrate winansi + Branch: win32/perl + +> pod/perlhist.pod + !> MANIFEST av.c hv.c op.c perlsock.h pp_ctl.c pp_sys.c scope.c + !> util.c +____________________________________________________________________________ +[ 439] By: mbeattie on 1998/01/27 15:31:53 + Log: Integrate ansi branch into mainline (resolve -ay). + Branch: perl + +> lib/Tie/Array.pm perldir.h perlenv.h perllio.h perlmem.h + +> perlproc.h perlsock.h pod/perlhist.pod t/lib/tie-push.t + +> t/lib/tie-stdarray.t t/lib/tie-stdpush.t t/op/tiearray.t + +> win32/bin/perlglob.pl + ! op.c + !> (integrate 868 files) +____________________________________________________________________________ +[ 438] By: nick on 1998/01/24 12:02:34 + Log: Gisle's av_unshift tweak, two small patches from chip + and check for NULL in hv_delete in case '~' and tie magic + are present + Branch: ansiperl + ! av.c hv.c op.c pp_ctl.c scope.c +____________________________________________________________________________ +[ 437] By: nick on 1998/01/24 10:37:56 + Log: Get PerlXxx_yyyy() macro stuff to _compile_ on Solaris. + Ugh! ... + Macros were unsuitable for declaring the functions, extra () round + parameters removed - non-function forms of PerlXxx_yyyy() need to + add () themselves. + Need to include perlmem.h in util.c (at least) if not using Perl's malloc. + Branch: ansiperl + ! perlsock.h pp_sys.c util.c +____________________________________________________________________________ +[ 436] By: nick on 1998/01/24 10:03:03 + Log: Integrate win32 into ansiperl + Branch: ansiperl + +> perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h + +> win32/bin/perlglob.pl + !> (integrate 38 files) +____________________________________________________________________________ +[ 435] By: nick on 1998/01/24 09:47:49 + Log: Add perlhist.pod + Branch: ansiperl + + pod/perlhist.pod + ! MANIFEST +____________________________________________________________________________ +[ 434] By: gsar on 1998/01/19 05:01:47 + Log: s/PerlENV/PerlEnv/ just to be consistent + Branch: win32/perl + ! malloc.c perl.c perlenv.h regcomp.c toke.c util.c +____________________________________________________________________________ +[ 433] By: gsar on 1998/01/19 04:52:18 + Log: foo() -> PerlGroup_foo() patch from ActiveState + Branch: win32/perl + + perldir.h perlenv.h perllio.h perlmem.h perlproc.h perlsock.h + ! doio.c malloc.c perl.c perl.h pp.c pp_hot.c pp_sys.c regcomp.c + ! scope.h sv.c toke.c util.c +____________________________________________________________________________ +[ 432] By: gsar on 1998/01/19 04:42:26 + Log: integrate mainline + Branch: win32/perl + !> pod/perlfunc.pod +____________________________________________________________________________ +[ 431] By: gsar on 1998/01/19 04:40:04 + Log: integrate changes in winansi + Branch: win32/perl + +> lib/Tie/Array.pm t/lib/tie-push.t t/lib/tie-stdarray.t + +> t/lib/tie-stdpush.t t/op/tiearray.t + !> (integrate 98 files) +____________________________________________________________________________ +[ 430] By: gsar on 1998/01/19 04:10:43 + Log: Fix autovivification problems with XSUB OUTPUT args + Message-Id: <199801190409.XAA26710@aatma.engin.umich.edu> + Date: Sun, 18 Jan 1998 23:09:07 EST + From: Gurusamy Sarathy + Subject: [PATCH] XSUB OUTPUT arguments and 'set' magic + Branch: win32/perl + ! ext/GDBM_File/typemap ext/NDBM_File/typemap + ! ext/ODBM_File/typemap ext/SDBM_File/typemap + ! lib/ExtUtils/typemap os2/OS2/PrfDB/typemap pod/perlguts.pod + ! pod/perlxs.pod pod/perlxstut.pod sv.c sv.h win32/win32.h +____________________________________________________________________________ +[ 429] By: nick on 1998/01/17 21:01:50 + Log: Subject: [PATCH] 5.004_56 threaded and "CONFIG key 'exe_ext' does not exist in Config.pm" + Date: Thu, 25 Dec 1997 13:39:15 -0500 + From: Spider Boardman + To: perl5-porters@perl.org + + It turns out that the potential for the "CONFIG key 'exe_ext' + does not exist in Config.pm" problem has been around for a while, + in the definition of SvTRUE(). It's just that non-gcc compilers + are more or less being built as CRIPPLED_CC when USE_THREADS is + defined (even if they can inline things). The inline macro for + SvTRUE works with tied hashes and the EXISTS method, and the + functional version (sv_true in 5.004_56, or SvTRUE in 5.004_04) + does not, because it adds an excess mg_get() which replaces the + EXISTS result with a FETCH result. + Branch: ansiperl + ! sv.c +____________________________________________________________________________ +[ 428] By: nick on 1998/01/17 20:59:11 + Log: From: Robin Barker + Date: Fri, 19 Dec 97 17:19:09 GMT + Message-Id: <26260.9712191719@lightning.cise.npl.co.uk> + Branch: ansiperl + ! doio.c sv.c toke.c util.c +____________________________________________________________________________ +[ 427] By: nick on 1998/01/17 12:01:53 + Log: Permit tie ?foo,$object + tidy up dead #ifdef ORIGINAL_TIE) + Remove 'P' magic from hash, before adding new one in dbm_open like tie does. + Branch: ansiperl + ! pp_sys.c +____________________________________________________________________________ +[ 426] By: nick on 1998/01/15 18:06:36 + Log: First working TIEARRAY and other misc tie fixes + Branch: ansiperl + ! MANIFEST pp.c pp_hot.c t/op/tiearray.t +____________________________________________________________________________ +[ 425] By: nick on 1998/01/14 21:56:40 + Log: Not working yet - split problems ... + Branch: ansiperl + ! pp.c t/lib/thread.t t/op/tiearray.t +____________________________________________________________________________ +[ 424] By: nick on 1998/01/14 18:49:25 + Log: TIEARRAY updates - almost works ... + Branch: ansiperl + + t/lib/tie-push.t t/lib/tie-stdarray.t t/lib/tie-stdpush.t + ! MANIFEST av.c av.h ext/DB_File/DB_File.pm lib/Tie/Array.pm + ! mg.c pod/perltie.pod pp.c pp_hot.c pp_sys.c scope.c + ! t/op/avhv.t t/op/push.t t/op/tiearray.t +____________________________________________________________________________ +[ 423] By: gsar on 1998/01/14 00:13:16 + Log: fix MakeMaker installbin problem + Message-Id: <199801070016.TAA17766@aatma.engin.umich.edu> + Subject: Re: can't modify message with HTML-Stream, v.1.42 + Date: Tue, 06 Jan 1998 19:16:35 -0500 + From: Gurusamy Sarathy + Branch: win32/perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 422] By: gsar on 1998/01/13 23:53:02 + Log: add archname to *sitearch in config.{b,g,v}c + Branch: win32/perl + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 421] By: gsar on 1998/01/13 23:15:14 + Log: set $ENV{PERL5LIB} in t/harness (so child perlglob.bat sees it) + Branch: win32/perl + ! t/harness +____________________________________________________________________________ +[ 420] By: nick on 1998/01/13 22:55:02 + Log: tiearray tweaks + Branch: ansiperl + ! av.c pp_sys.c t/op/nothread.t t/op/tiearray.t +____________________________________________________________________________ +[ 419] By: nick on 1998/01/13 21:27:33 + Log: Skeleton Tie::Array + Branch: ansiperl + + lib/Tie/Array.pm +____________________________________________________________________________ +[ 418] By: nick on 1998/01/13 20:52:38 + Log: tie array changes to core and tests + Branch: ansiperl + + t/op/tiearray.t + ! MANIFEST av.c av.h deb.c embed.h ext/DB_File/DB_File.pm + ! global.sym gv.c mg.c op.c perl.c perl.h pp.c pp.h pp_ctl.c + ! pp_hot.c proto.h sv.c toke.c universal.c util.c +____________________________________________________________________________ +[ 417] By: gsar on 1998/01/13 20:49:52 + Log: fix perlglob.bat warnings by splitting it from File::DosGlob + Branch: win32/perl + + win32/bin/perlglob.pl + ! MANIFEST README.win32 lib/File/DosGlob.pm win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 416] By: gsar on 1998/01/13 02:46:53 + Log: various tweaks to build support (NOTE: meant for 5.004_57) + - build and install x2p + - fix installperl warnings on win32 + - `make install` now does puts the archlibs in right places + - makefiles don't default to USE_THREADS anymore + - sync config.{b,g,v}c + - sync makefile.mk -> Makefile + Branch: win32/perl + ! installperl win32/Makefile win32/config.bc win32/config.gc + ! win32/config.vc win32/config_sh.PL win32/makefile.mk x2p/a2p.h + ! x2p/a2py.c +____________________________________________________________________________ +[ 415] By: nick on 1998/01/11 16:54:26 + Log: Integrate win32 into ansiperl + Branch: ansiperl + !> Configure hints/dec_osf.sh hv.c lib/Getopt/Long.pm lib/blib.pm + !> lib/newgetopt.pl perl.h perl_exp.SH pp_ctl.c pp_hot.c pp_sys.c + !> proto.h regcomp.h regexec.c t/op/re_tests t/pragma/locale.t + !> utils/perldoc.PL vms/config.vms vms/descrip.mms + !> vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c + !> vms/vmsish.h x2p/s2p.PL +____________________________________________________________________________ +[ 414] By: nick on 1998/01/11 15:13:49 + Log: Integratye mainline -> ansiperl + Branch: ansiperl + !> (integrate 64 files) +____________________________________________________________________________ +[ 413] By: mbeattie on 1998/01/09 12:57:58 + Log: Add missing blank line in pod/perlfunc.pod. + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 412] By: gsar on 1998/01/08 20:54:31 + Log: change#398 breaks ENV_IS_CASELESS, fix it + Branch: win32/perl + ! hv.c +____________________________________________________________________________ +[ 411] By: gsar on 1998/01/08 18:33:58 + Log: Integrate mainline + Branch: win32/perl + !> Configure hints/dec_osf.sh hv.c lib/Getopt/Long.pm lib/blib.pm + !> lib/newgetopt.pl perl.h perl_exp.SH pp_ctl.c pp_hot.c pp_sys.c + !> proto.h regcomp.h regexec.c t/op/re_tests t/pragma/locale.t + !> utils/perldoc.PL vms/config.vms vms/descrip.mms + !> vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c + !> vms/vmsish.h x2p/s2p.PL +____________________________________________________________________________ +[ 410] By: mbeattie on 1998/01/08 16:06:22 + Log: Fix thinko in t/pragma/locale.t: + Subject: [PATCH] _04 or _56: locale.t + Date: Sun, 4 Jan 1998 23:48:44 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! t/pragma/locale.t +____________________________________________________________________________ +[ 409] By: mbeattie on 1998/01/08 16:05:09 + Log: Use Tom Horley's qsort for sorting: + Subject: Re: [PATCH for 5.004_56] Re: op/sort.t hangs under Solaris 2.5 + Date: Fri, 02 Jan 1998 19:33:24 -0500 (EST) + From: Hans Mulder + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 408] By: mbeattie on 1998/01/08 16:01:57 + Log: Make s2p not use cpp: + Subject: [PATCH for 5.004_56] s2p shouldn't use cpp + Date: Mon, 29 Dec 1997 19:38:18 -0500 (EST) + From: Hans Mulder + Branch: perl + ! x2p/s2p.PL +____________________________________________________________________________ +[ 407] By: mbeattie on 1998/01/08 15:57:31 + Log: DG/UX tweaks to perl.h: + Subject: [PATCH] _56 on dgux without threads + Date: Sat, 20 Dec 1997 23:01:40 -0500 + From: Roderick Schertler + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 406] By: mbeattie on 1998/01/08 15:56:02 + Log: Configure and hints/dec_osf.sh changes for Digital UNIX: + Subject: [PATCH] perl5.004_56 NOT OK on alpha-dec_osf-thread (Digital UNIX X5.0-13) + Date: Sat, 20 Dec 1997 02:30:01 -0500 + From: Spider Boardman + Branch: perl + ! Configure hints/dec_osf.sh +____________________________________________________________________________ +[ 405] By: mbeattie on 1998/01/08 15:53:40 + Log: Missing "" in Configure echo for gethbadd_addr_type. + Branch: perl + ! Configure +____________________________________________________________________________ +[ 404] By: mbeattie on 1998/01/08 13:04:48 + Log: print/printf/... over-eager mg_find for glob magic: + Subject: [PATCH] fix inefficient checks for TIEHANDLE + Date: Wed, 07 Jan 1998 20:06:05 -0500 + From: Gurusamy Sarathy + Branch: perl + ! pp_hot.c pp_sys.c +____________________________________________________________________________ +[ 403] By: mbeattie on 1998/01/08 12:56:31 + Log: Assorted VMS patches (mostly VMS makefile update for new headers): + Subject: [PATCH] VMS update for 5.004_56 + Date: Sat, 03 Jan 1998 03:54:29 -0500 (EST) + From: Charles Bailey + Branch: perl + ! lib/blib.pm proto.h regcomp.h vms/config.vms vms/descrip.mms + ! vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms vms/vms.c + ! vms/vmsish.h +____________________________________________________________________________ +[ 402] By: mbeattie on 1998/01/08 12:46:15 + Log: Fix utils/perldoc.PL for dos-djgpp: + Subject: 5.004_56: perldoc.PL dos-djgpp patches + Date: Tue, 6 Jan 1998 18:14:59 +0100 + From: Molnar Laszlo + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 401] By: mbeattie on 1998/01/08 12:40:14 + Log: Version 2.13 of GetoptLong: + Subject: Re: ANNOUNCE: perl 5.004_56 is available + Date: 06 Jan 1998 16:21:45 +0100 + From: JVromans@Squirrel.nl (Johan Vromans) + Branch: perl + ! lib/Getopt/Long.pm lib/newgetopt.pl +____________________________________________________________________________ +[ 400] By: mbeattie on 1998/01/08 12:28:08 + Log: Fix variable export and threading configuration for AIX: + Subject: [PATCH] 5.004_56: AIX 4.1.5.0: sans et avec threads + Date: Tue, 23 Dec 1997 15:39:12 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! Configure perl_exp.SH +____________________________________________________________________________ +[ 399] By: mbeattie on 1998/01/08 12:25:38 + Log: Regexp fix: (?>a+)b doesn't match aaab: + Subject: Re: Regexp [PATCH] 5.004_56 (?>...) + Date: Fri, 19 Dec 1997 16:02:50 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! regexec.c t/op/re_tests +____________________________________________________________________________ +[ 398] By: mbeattie on 1998/01/08 12:23:41 + Log: Fix hv_delete for 'm'-magic. Based on following patch, modified + to cope with ENV_IS_CASELESS: + Subject: [perl5.004_56] [PATCH] hv_delete and 'm' magic + Date: Fri, 19 Dec 1997 11:31:36 -0500 + From: Owen Taylor + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 397] By: mbeattie on 1998/01/08 12:10:29 + Log: Integrate win32 branch into mainline. + Branch: perl + !> (integrate 41 files) +____________________________________________________________________________ +[ 396] By: gsar on 1998/01/07 19:12:27 + Log: tweak case-insensitive ENV implementation + Branch: win32/perl + ! hv.c +____________________________________________________________________________ +[ 395] By: nick on 1998/01/07 18:40:55 + Log: Integrate win32 branch + Branch: ansiperl + !> (integrate 31 files) +____________________________________________________________________________ +[ 394] By: gsar on 1998/01/05 19:17:40 + Log: Allow $ENV{PERL5SHELL} to contain switches etc., and document + the fact + Branch: win32/perl + ! pod/perlrun.pod win32/win32.c +____________________________________________________________________________ +[ 393] By: gsar on 1998/01/05 05:43:33 + Log: Support case-tolerant %ENV + - underlying system calls see the case-as-supplied by user + - added tests to verify addition/deletion/enumeration case-tolerance + - hv.c touched, but changes are fully conditional on -DENV_IS_CASELESS, + which is default on win32 now + Branch: win32/perl + ! hv.c t/op/magic.t win32/win32.h +____________________________________________________________________________ +[ 392] By: gsar on 1998/01/04 17:55:19 + Log: Add a tweaked version of: + Message-Id: <199801040630.AA29298@metronet.com> + Date: Sun, 04 Jan 1998 00:30:57 CST + From: Tye McQueen + Subject: New patch for $^E==GetLastError() under Win32 + Branch: win32/perl + ! doio.c lib/dumpvar.pl lib/perl5db.pl mg.c perl.h + ! pod/perlfunc.pod pod/perlvar.pod util.c win32/makedef.pl + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 391] By: gsar on 1998/01/04 07:59:44 + Log: Various win32 fixes + - support spawn via system(&P_NOWAIT,...) like OS2 + - support wait() and waitpid() + - s/GetCurrentDirectory/GetCwd/, long-named XS to be removed + - support -lfoo properly in ExtUtils::Liblist + - fix outdated info about Win32 support in perlfaq2 + - fix win32 bug in perldoc that causes spurious warnings + - regularize global function/variable names yet more + - fix bug in do_aspawn() (it was always invoking shell, instead of + almost never) + - implement and export win32_wait() + - stub version of USE_RTL_THREAD_API + Branch: win32/perl + ! README.win32 dosish.h lib/Cwd.pm lib/ExtUtils/Liblist.pm + ! pod/perlfaq2.pod pp_sys.c util.c utils/perldoc.PL + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32sck.c win32/win32thread.c + ! win32/win32thread.h +____________________________________________________________________________ +[ 390] By: gsar on 1997/12/30 21:00:28 + Log: Fix $ENV{Path} in FindBin.pm + Branch: win32/perl + ! lib/FindBin.pm +____________________________________________________________________________ +[ 389] By: nick on 1997/12/29 10:33:23 + Log: Resolve ansiperl against win32 + Branch: ansiperl + !> (integrate 105 files) +____________________________________________________________________________ +[ 388] By: gsar on 1997/12/24 04:59:28 + Log: make $? Unix (and ActiveWare) compatible + Branch: win32/perl + ! README.win32 win32/win32.c +____________________________________________________________________________ +[ 387] By: gsar on 1997/12/24 04:21:30 + Log: support ioctl() on sockets (does what ioctlsocket() does) to make + non-blocking IO on sockets possible + Branch: win32/perl + ! README.win32 dosish.h win32/makedef.pl win32/win32.c + ! win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 386] By: gsar on 1997/12/24 03:10:55 + Log: support getlogin() + Branch: win32/perl + ! README.win32 win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 385] By: gsar on 1997/12/24 02:24:59 + Log: add support for crypt() via user-supplied des_fcrypt() source or library. + Update README.win32. + Branch: win32/perl + ! README.win32 perl.h win32/Makefile win32/makedef.pl + ! win32/makefile.mk win32/win32.c win32/win32.h win32/win32iop.h +____________________________________________________________________________ +[ 384] By: gsar on 1997/12/24 02:22:42 + Log: tweak op.c to avoid warning + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 383] By: gsar on 1997/12/23 21:12:42 + Log: Trivial bugfix#3 from local repository + Message-Id: <199712061100.GAA14864@aatma.engin.umich.edu> + Subject: Re: Assigning result of pop scrambles unrelated reference + Date: Sat, 06 Dec 1997 06:00:45 -0500 + From: Gurusamy Sarathy + Branch: win32/perl + ! sv.c +____________________________________________________________________________ +[ 382] By: gsar on 1997/12/23 21:09:32 + Log: Trivial bugfix#2 from local repository + Message-Id: <199712061025.FAA14396@aatma.engin.umich.edu> + Subject: Re: eval of sub gives spurious "uninitialised" warning + Date: Sat, 06 Dec 1997 05:25:07 -0500 + From: Gurusamy Sarathy + Branch: win32/perl + ! op.c pod/perldelta.pod pod/perlfunc.pod t/op/eval.t +____________________________________________________________________________ +[ 381] By: gsar on 1997/12/23 21:01:04 + Log: Trivial bugfix#1 from local repository + Message-Id: <199711282326.SAA15090@aatma.engin.umich.edu> + Subject: [PATCH] Re: [5.004_04 BUG] bless broke scoping? + Date: Fri, 28 Nov 1997 18:26:52 -0500 + From: Gurusamy Sarathy + Branch: win32/perl + ! scope.c +____________________________________________________________________________ +[ 380] By: gsar on 1997/12/18 15:10:23 + Log: Integrate mainline + Branch: win32/perl + +> README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c + +> djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh + +> os2/os2.sym os2/os2thread.h + !> (integrate 77 files) + +---------------- +Version 5.004_56 +---------------- + +____________________________________________________________________________ +[ 379] By: mbeattie on 1997/12/18 13:28:35 + Log: Integrate ansi @364,@366 into mainline. + Branch: perl + !> lib/ExtUtils/MakeMaker.pm miniperlmain.c perl.h +____________________________________________________________________________ +[ 378] By: mbeattie on 1997/12/18 13:20:15 + Log: Add a few missing files to MANIFEST + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 377] By: mbeattie on 1997/12/18 13:00:16 + Log: Bump patchlevel to 56. + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 376] By: nick on 1997/12/18 01:32:12 + Log: Resolve against mainline + Branch: ansiperl + +> README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c + +> djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh + +> os2/os2.sym os2/os2thread.h + !> (integrate 74 files) +____________________________________________________________________________ +[ 375] By: nick on 1997/12/18 01:06:15 + Log: Resolve against Win32 + Branch: ansiperl + !> Configure README.threads config_h.SH doop.c embed.h + !> ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh + !> hints/irix_6.sh op.c op.h perl.h perlvars.h pp_hot.c pp_sys.c + !> sv.c sv.h thread.h util.c +____________________________________________________________________________ +[ 374] By: mbeattie on 1997/12/17 14:44:26 + Log: Lots of VMS changes. vms/gen_shrfls.pl (which parses header files) + needs rewriting now that we use perlvars.h and foovar.h: + Subject: [PATCH] 5.004_54 under VMS (fwd) + Date: Wed, 26 Nov 1997 12:32:09 -0400 (EDT) + From: Charles Bailey + Branch: perl + ! dosish.h handy.h intrpvar.h os2/os2ish.h perl.c perl.h + ! plan9/plan9ish.h pp.c proto.h sv.c t/lib/thread.t + ! t/lib/timelocal.t t/op/nothread.t taint.c thrdvar.h toke.c + ! unixish.h vms/config.vms vms/descrip.mms vms/fndvers.com + ! vms/gen_shrfls.pl vms/genconfig.pl vms/perly_c.vms + ! vms/test.com vms/vms.c vms/vms_yfix.pl vms/vmsish.h +____________________________________________________________________________ +[ 373] By: mbeattie on 1997/12/17 14:10:50 + Log: Major changes to the DOS/djgpp port (including threading): + Subject: Re: dos-djgpp port not in perl 5.004_54 + Date: Fri, 21 Nov 1997 10:58:26 +0100 + From: Molnar Laszlo + Branch: perl + + README.dos djgpp/config.over djgpp/configure.bat djgpp/djgpp.c + + djgpp/djgppsed.sh djgpp/fixpmain hints/dos_djgpp.sh + ! Configure MANIFEST Makefile.SH doio.c dosish.h + ! ext/POSIX/POSIX.xs installhtml installperl lib/AutoSplit.pm + ! lib/Cwd.pm lib/ExtUtils/Install.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/Manifest.pm lib/File/Basename.pm lib/File/Find.pm + ! lib/File/Path.pm lib/FindBin.pm lib/Pod/Html.pm + ! lib/Pod/Text.pm lib/Term/Cap.pm lib/perl5db.pl makedepend.SH + ! mg.c perl.c pod/pod2man.PL pp_hot.c t/io/fs.t t/lib/anydbm.t + ! t/lib/filehand.t t/lib/gdbm.t t/lib/io_sel.t t/lib/io_tell.t + ! t/lib/sdbm.t t/lib/thread.t t/op/magic.t t/op/stat.t + ! t/op/sysio.t t/op/taint.t utils/perldoc.PL +____________________________________________________________________________ +[ 372] By: mbeattie on 1997/12/17 13:18:34 + Log: Upgrade DB_File to 1.56: + Subject: DB_File-1.56 for _55 + Date: Tue, 16 Dec 1997 22:25:29 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + ! Configure ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + ! ext/DB_File/Makefile.PL ext/DB_File/typemap t/lib/db-btree.t +____________________________________________________________________________ +[ 371] By: mbeattie on 1997/12/17 12:02:03 + Log: Threading patches for OS/2 (missing files taken from previous patch): + Subject: Re: 5.004_55: OS/2 patches again + Date: Sat, 13 Dec 1997 18:09:15 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + + os2/os2.sym os2/os2thread.h + ! MANIFEST hints/os2.sh os2/Changes os2/Makefile.SHs + ! os2/OS2/PrfDB/PrfDB.xs os2/OS2/REXX/REXX.xs os2/os2.c + ! os2/os2ish.h perl.h +____________________________________________________________________________ +[ 370] By: mbeattie on 1997/12/17 11:01:34 + Log: Add OS2 to list for DONT_DECLARE_STD in perl.h: + Subject: Re: 5.004_55: OS/2 patches again + Date: Sat, 13 Dec 1997 18:05:55 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 369] By: mbeattie on 1997/12/17 10:59:40 + Log: Fix typo in compiler B/C.pm. + Branch: perlext + ! Compiler/B/C.pm +____________________________________________________________________________ +[ 368] By: mbeattie on 1997/12/17 10:58:35 + Log: Allow "perldoc -F filename": + Subject: 5.004_55: Patch to perldoc + Date: Thu, 11 Dec 1997 19:37:00 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 367] By: mbeattie on 1997/12/17 10:54:47 + Log: Fix not-reached warning for pp_threadsv. + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 366] By: nick on 1997/12/14 16:06:24 + Log: Fix typo in Ilya's patch :-( + Branch: ansiperl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 365] By: nick on 1997/12/14 15:30:25 + Log: #undef new PERLVARIC macro in appropriate places + Branch: ansiperl + ! miniperlmain.c perl.h +____________________________________________________________________________ +[ 364] By: nick on 1997/12/14 15:04:36 + Log: Ilya's MakeMaker (empty makefile) patch + Branch: ansiperl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 363] By: gsar on 1997/12/13 05:57:13 + Log: Integrate mainline. Builds and passes (Borland). + Branch: win32/perl + !> Configure README.threads config_h.SH doop.c embed.h + !> ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh + !> hints/irix_6.sh op.c op.h perl.h perlvars.h pp_hot.c pp_sys.c + !> sv.c sv.h thread.h util.c +____________________________________________________________________________ +[ 362] By: nick on 1997/12/13 02:53:03 + Log: Resolve ansiperl against mainline + Branch: ansiperl + !> (integrate 92 files) +____________________________________________________________________________ +[ 361] By: mbeattie on 1997/12/12 16:20:38 + Log: pp_print and pp_prtf handling of tied file handles used EXTEND + instead of MEXTEND leading to core dumps. This fix needs + propagating back to the maintenance branch. + Branch: perl + ! pp_hot.c pp_sys.c +____________________________________________________________________________ +[ 360] By: mbeattie on 1997/12/11 15:45:56 + Log: Add missing patch to op.c that didn't come across with win32 merge. + Branch: perl + ! op.c +____________________________________________________________________________ +[ 359] By: mbeattie on 1997/12/11 11:54:41 + Log: Stop tr/// from writing to target when only counting. + Branch: perl + ! doop.c op.c op.h +____________________________________________________________________________ +[ 358] By: mbeattie on 1997/12/10 18:36:26 + Log: Fix char*/unsigned char* clashes in util.c:fbm_instr and remove + a few extraneous trailing semicolons in perlvars.h. + Branch: perl + ! perlvars.h util.c +____________________________________________________________________________ +[ 357] By: mbeattie on 1997/12/10 18:33:53 + Log: Start overhauling compiler. It was working at least minimally + right up until the final tweak of B.xs to add threadsv_names + at which point building it provokes a seg fault in perl while + doing the xsubpp :-(. + Branch: perl + ! op.h util.c + Branch: perlext + ! Compiler/B.pm Compiler/B.xs Compiler/B/Asmdata.pm + ! Compiler/B/C.pm Compiler/B/CC.pm Compiler/Makefile.PL + ! Compiler/bytecode.pl Compiler/byteperl.c Compiler/byterun.c + ! Compiler/byterun.h Compiler/cc_harness Compiler/cc_runtime.h + ! Compiler/ccop.c Compiler/ccop.h Compiler/test_harness + ! Compiler/test_harness_cc +____________________________________________________________________________ +[ 356] By: mbeattie on 1997/12/10 13:43:32 + Log: Fix perl_os_thread typedef for pthreads. Tweak SvTAINT so that + sv_setfoo functions go back to not needing dTHR. Fix Configure + to check for already-existing -thread on archname and to check + better for d_pthread_created_joinable. + Branch: perl + ! Configure perl.h sv.c sv.h thread.h +____________________________________________________________________________ +[ 355] By: mbeattie on 1997/12/10 10:53:58 + Log: Minor fix/speedup to util.c:fbm_instr: + Subject: 5.004_55: Minor regexp patch + Date: Fri, 5 Dec 1997 05:09:54 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! util.c +____________________________________________________________________________ +[ 354] By: mbeattie on 1997/12/10 10:41:25 + Log: Patches for IRIX, AIX and some generic stuff: + Subject: [PATCH] _55: Mostly AIX stuff but also IRIX and generic + Date: Sat, 29 Nov 1997 08:35:30 -0800 (PST) + From: Jarkko Hietaniemi + (checked/ignored a few rejects; tweaked wording). + Branch: perl + ! Configure README.threads config_h.SH embed.h + ! ext/DynaLoader/dl_aix.xs global.sym hints/aix.sh + ! hints/irix_6.sh +____________________________________________________________________________ +[ 353] By: mbeattie on 1997/12/10 10:10:19 + Log: Integrate win32 back into mainline (trivial). + Branch: perl + +> embedvar.h intrpvar.h perlvars.h thrdvar.h win32/config.gc + +> win32/config_H.gc + !> (integrate 36 files) +____________________________________________________________________________ +[ 352] By: nick on 1997/12/09 17:36:45 + Log: Resolve win32 - Sarathy's tweak. + Branch: ansiperl + !> win32/makedef.pl +____________________________________________________________________________ +[ 351] By: gsar on 1997/12/08 06:13:04 + Log: re-add PERLVARI?C? change that somehow went missing in makedef.pl + Branch: win32/perl + ! win32/makedef.pl +____________________________________________________________________________ +[ 350] By: nick on 1997/12/05 00:56:03 + Log: Resolve ansiperl against win32 + Branch: ansiperl + - win32/makegcc.mk + !> embed.h embed.pl embedvar.h global.sym miniperlmain.c perl.h + !> perlvars.h win32/Makefile win32/config.gc win32/makedef.pl + !> win32/makefile.mk win32/perllib.c win32/win32.h +____________________________________________________________________________ +[ 349] By: gsar on 1997/12/02 07:28:23 + Log: Revert to keeping (some) constant strings as globals + Branch: win32/perl + ! embed.h embed.pl embedvar.h global.sym miniperlmain.c perl.h + ! perlvars.h win32/makedef.pl win32/perllib.c +____________________________________________________________________________ +[ 348] By: gsar on 1997/12/02 05:38:06 + Log: makegcc.mk merged into makefile.mk, so makegcc.mk is gone. + Other minor fixes. Now is a good time to get the changes in win32 branch. + Branch: win32/perl + - win32/makegcc.mk + ! win32/Makefile win32/config.gc win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 347] By: gsar on 1997/12/02 03:32:55 + Log: Integrate winansi again. Result builds and passes all tests on all + three compilers. + Branch: win32/perl + !> lib/ExtUtils/MM_Win32.pm win32/config.gc win32/makefile.mk + !> win32/makegcc.mk win32/win32.h +____________________________________________________________________________ +[ 346] By: gsar on 1997/12/02 03:28:23 + Log: various hacks to get mingw32 to build. Sync Makefile with makefile.mk. + makegcc.mk to be merged into makefile.mk soon. + Branch: win32/perl + ! lib/ExtUtils/MM_Win32.pm win32/Makefile win32/config.gc + ! win32/makedef.pl win32/makefile.mk win32/makegcc.mk + ! win32/win32.h +____________________________________________________________________________ +[ 345] By: nick on 1997/12/02 01:57:17 + Log: Add a 4th step (yes FOUR) to dll build process for gcc. + Now runs again... + Branch: ansiperl + ! lib/ExtUtils/MM_Win32.pm +____________________________________________________________________________ +[ 344] By: nick on 1997/12/02 01:11:16 + Log: Sarathy's patch + Branch: ansiperl + ! lib/ExtUtils/MM_Win32.pm win32/config.gc win32/makefile.mk + ! win32/makegcc.mk win32/win32.h +____________________________________________________________________________ +[ 343] By: gsar on 1997/12/01 04:37:06 + Log: Reverse integrate to get all of Nick's changes over at winansi (win32/perl/* + is identical to ansiperl/* now) + Branch: win32/perl + +> embedvar.h intrpvar.h perlvars.h thrdvar.h + !> (integrate 34 files) +____________________________________________________________________________ +[ 342] By: nick on 1997/12/01 04:01:57 + Log: Builds and passes all tests with gcc on Win32 - phew! + Branch: ansiperl + ! embed.h embedvar.h ext/Opcode/Opcode.xs global.sym perl.h + ! proto.h util.c win32/makedef.pl +____________________________________________________________________________ +[ 341] By: nick on 1997/12/01 02:54:29 + Log: Create a struct for all perls globals (as an option) + Mainly for Mingw32 which cannot import data. + Now only Opcode tests fail (op_desc/op_name not + handled yet stuff) + Branch: ansiperl + ! EXTERN.h embed.h embed.pl embedvar.h ext/Thread/Thread.xs + ! global.sym miniperlmain.c perl.c perl.h perlvars.h pp_hot.c + ! proto.h run.c util.c win32/Makefile win32/makedef.pl + ! win32/makegcc.mk win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32thread.c +____________________________________________________________________________ +[ 340] By: nick on 1997/11/30 20:21:10 + Log: Fixup exports in non -DDEBUGGING case + Branch: ansiperl + ! win32/makedef.pl +____________________________________________________________________________ +[ 339] By: nick on 1997/11/30 20:10:04 + Log: Disable hard-coded -DDEBUGGING + Branch: ansiperl + ! win32/config_h.PL +____________________________________________________________________________ +[ 338] By: nick on 1997/11/30 20:00:19 + Log: embed.pl now reads *var*.h to do its stuff. + Split generated embed.h into two - new embedvar.h + is #included when 'op' etc. will not mess up proto.h etc. + Removed #define foo (thr->Tfoo) from thread.h + Added some 'missing' symbols to global.sym, removed + those in the *var*.h files + Has build all MULTIPLICITY/USE_THREADS options on win32 + with VC++ (and passed tests), but not with exactly this set + of files. + Branch: ansiperl + + embedvar.h + ! embed.h embed.pl global.sym interp.sym intrpvar.h perl.h + ! perlvars.h regcomp.c thrdvar.h thread.h win32/Makefile + ! win32/makedef.pl +____________________________________________________________________________ +[ 337] By: nick on 1997/11/29 23:55:31 + Log: Globals and structs via macros - part 1 of N + - introduce perlvars.h intrpvar.h and thrdvar.h + - change perl.h and thread.h to include them with + appropriate macros defined + - result is status-quo but with macros + - next step is to tweak embed.* to capitalize on + new easy-to-find info. + Branch: ansiperl + + intrpvar.h perlvars.h thrdvar.h + ! perl.h thread.h win32/Makefile +____________________________________________________________________________ +[ 336] By: nick on 1997/11/29 19:13:55 + Log: VC++ default to threaded + Branch: ansiperl + ! win32/Makefile +____________________________________________________________________________ +[ 335] By: nick on 1997/11/29 18:38:26 + Log: Avoid __declspec(thread) by default, for both scratch + return areas and THR stuff. Use struct thread intern instead. + Branch: ansiperl + ! win32/win32.c win32/win32.h win32/win32sck.c + ! win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 334] By: nick on 1997/11/29 17:49:04 + Log: Non-threaded build fix + Branch: ansiperl + ! win32/win32thread.c +____________________________________________________________________________ +[ 333] By: nick on 1997/11/29 17:29:07 + Log: Sort out malloc_mutex for perl's malloc + Remove BINCOMPAT3 from embed.pl + Add dependancy to CORE_H for PERL95_OBJ + Branch: ansiperl + ! dosish.h embed.h embed.pl global.sym perl.h win32/Makefile + ! win32/win32.c +____________________________________________________________________________ +[ 332] By: nick on 1997/11/29 16:21:01 + Log: Integrate win32 into ansiperl + Branch: ansiperl + !> README.threads hints/irix_6.sh lib/Test/Harness.pm + !> lib/perl5db.pl malloc.c miniperlmain.c perl.h sv.c t/TEST + !> t/lib/anydbm.t t/lib/db-btree.t t/lib/db-hash.t + !> t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t + !> t/lib/safe2.t t/lib/sdbm.t t/op/pat.t t/op/taint.t + !> win32/perllib.c +____________________________________________________________________________ +[ 331] By: nick on 1997/11/29 01:35:45 + Log: GCC + Threads on Win32 - best gcc results yet + Branch: ansiperl + ! XSUB.h perl.h thread.h win32/makedef.pl win32/makegcc.mk + ! win32/win32.h win32/win32iop.h win32/win32thread.c + ! win32/win32thread.h +____________________________________________________________________________ +[ 330] By: nick on 1997/11/28 23:05:08 + Log: Un-botch gcc workround + Branch: ansiperl + ! XSUB.h +____________________________________________________________________________ +[ 329] By: nick on 1997/11/28 22:39:39 + Log: Builds completely with Mingw32, dynamic loaded extensions + don't work yet - suspect __declspec() non-implemented issues. + Branch: ansiperl + ! XSUB.h lib/ExtUtils/Command.pm lib/ExtUtils/MM_Win32.pm + ! lib/ExtUtils/Mksymlists.pm win32/config.gc win32/makegcc.mk + ! win32/runperl.c win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 328] By: gsar on 1997/11/28 05:48:15 + Log: integrate winansi. + Branch: win32/perl + +> win32/config.gc win32/config_H.gc win32/makegcc.mk + ! perl.h + !> dosish.h hv.c win32/dl_win32.xs win32/include/sys/socket.h + !> win32/makedef.pl win32/makefile.mk win32/runperl.c + !> win32/win32.c win32/win32.h win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 327] By: gsar on 1997/11/28 05:38:48 + Log: Integrate mainline. + Branch: win32/perl + !> README.threads hints/irix_6.sh lib/Test/Harness.pm + !> lib/perl5db.pl malloc.c miniperlmain.c sv.c t/TEST + !> t/lib/anydbm.t t/lib/db-btree.t t/lib/db-hash.t + !> t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t + !> t/lib/safe2.t t/lib/sdbm.t t/op/pat.t t/op/taint.t + !> win32/perllib.c +____________________________________________________________________________ +[ 326] By: nick on 1997/11/27 19:13:36 + Log: GCC builds perl.dll and perl.exe on Win32 + Branch: ansiperl + ! win32/makedef.pl win32/makegcc.mk +____________________________________________________________________________ +[ 325] By: nick on 1997/11/27 17:46:30 + Log: Add files and tweak others to get 'native' Mingw32 gcc port as + far as building miniperl and perl.dll (but not import lib yet) + Seems to lack popen()/pclose() and fcloseall() and fflushall(). + Also only CRTDLL not MCRTDLL so threading is probably not + possible yet. + Had to mess with win32iop.h's placement as we need __attribute__ + to get STDCALL, and #define of printf messes up proto.h + Branch: ansiperl + + win32/config.gc win32/config_H.gc win32/makegcc.mk + ! dosish.h perl.h win32/dl_win32.xs win32/include/sys/socket.h + ! win32/makefile.mk win32/runperl.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 324] By: mbeattie on 1997/11/27 17:08:06 + Log: Give dire warnings about the IRIX 6.2 kernel panic. + Branch: perl + ! README.threads hints/irix_6.sh +____________________________________________________________________________ +[ 323] By: mbeattie on 1997/11/27 16:57:33 + Log: Fix prototypes of sv_vsetpvfn and sv_vcatpvfn: + Subject: Re: ANNOUNCE: perl 5.004_55 is available + Date: 27 Nov 1997 17:18:53 +0100 + From: koenig@kulturbox.de (Andreas J. Koenig) + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 322] By: mbeattie on 1997/11/27 16:12:15 + Log: Integrate win32 branch back into mainline. + Branch: perl + !> (integrate 42 files) +____________________________________________________________________________ +[ 321] By: mbeattie on 1997/11/27 15:06:36 + Log: Fix t/lib/safe2.t for SunOS 4.1.3: + Subject: Re: ANNOUNCE: perl 5.004_55 is available + Date: Thu, 27 Nov 1997 10:46:42 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + ! t/lib/safe2.t +____________________________________________________________________________ +[ 320] By: mbeattie on 1997/11/27 15:02:59 + Log: Fix MYMALLOC (wrong #define in malloc.c): + Subject: 5.004_55: MYMALLOC completely busted + Date: Thu, 27 Nov 1997 01:08:16 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 319] By: mbeattie on 1997/11/27 15:01:37 + Log: Fix newSVrv so sv_setref_foo work better: + Subject: [PATCH] [5.004_55] newSVrv (again) + Date: Thu, 27 Nov 1997 00:25:50 -0500 + From: Owen Taylor + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 318] By: mbeattie on 1997/11/27 14:59:03 + Log: Output skipped test information in test suite: + Subject: 5.004_55: Making test harness platform_aware + Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST) + Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST) + Branch: perl + ! lib/Test/Harness.pm t/TEST t/lib/anydbm.t t/lib/db-btree.t + ! t/lib/db-hash.t t/lib/db-recno.t t/lib/gdbm.t t/lib/ndbm.t + ! t/lib/odbm.t t/lib/sdbm.t t/op/taint.t +____________________________________________________________________________ +[ 317] By: mbeattie on 1997/11/27 14:55:15 + Log: Add 'W'atch command to debugger and improve help: + Subject: 5.004_55: Debugger patch again + Date: Wed, 26 Nov 1997 17:05:57 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 316] By: mbeattie on 1997/11/27 14:52:44 + Log: Stop double initialisation of malloc_mutex: + Subject: 5.004_55: Double initialiazation of malloc_mutex + Date: Wed, 26 Nov 1997 16:51:43 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! miniperlmain.c win32/perllib.c +____________________________________________________________________________ +[ 315] By: mbeattie on 1997/11/27 14:48:58 + Log: Fix PVLV case in sv_setsv (plus tests in op/pat.t). + Branch: perl + ! sv.c t/op/pat.t +____________________________________________________________________________ +[ 314] By: nick on 1997/11/27 01:03:19 + Log: Merge win32 and ansiperl branches post _55 tweaks from Sarathy. + Branch: ansiperl + !> (integrate 897 files) +____________________________________________________________________________ +[ 313] By: gsar on 1997/11/26 03:20:55 + Log: merge win32-aware installperl in ansiperl branch. + Branch: win32/perl + !> installperl +____________________________________________________________________________ +[ 312] By: gsar on 1997/11/26 01:50:37 + Log: Fix for C bug: + From: Gurusamy Sarathy + Message-Id: <199711011946.OAA18882@aatma.engin.umich.edu> + Subject: [PATCH] Re: Sort grammar bug + Date: Sat, 01 Nov 1997 14:46:35 -0500 + ------ + From: Hugo van der Sanden + Message-Id: <199711021247.MAA01743@crypt.compulink.co.uk> + Subject: Re: Sort grammar bug + Date: Sun, 02 Nov 1997 12:47:51 +0000 + Branch: win32/perl + ! t/op/sort.t toke.c +____________________________________________________________________________ +[ 311] By: nick on 1997/11/26 01:42:50 + Log: Win32-ize installperl + Branch: ansiperl + ! installperl +____________________________________________________________________________ +[ 310] By: gsar on 1997/11/26 01:36:39 + Log: Another trivial patch: + From: Gurusamy Sarathy + Message-Id: <199710300245.VAA04244@aatma.engin.umich.edu> + Subject: [PATCH] Re: Why doesn't XSRETURN have STMT_START/STMT_END brackets? + Date: Wed, 29 Oct 1997 21:45:26 -0500 + Branch: win32/perl + ! XSUB.h +____________________________________________________________________________ +[ 309] By: nick on 1997/11/26 01:33:32 + Log: Fixup _55 for Win32: + Missed thread :-> perl_thread changes + Two #define THR (not the same) + K&R style func in hv.c + Branch: ansiperl + ! hv.c win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 308] By: gsar on 1997/11/26 01:30:21 + Log: Sync yet another patch (this one manually edited): + From: Gurusamy Sarathy + Message-Id: <199710290251.VAA14362@aatma.engin.umich.edu> + Subject: [PATCH] Re: local($@) gives core dump + Date: Tue, 28 Oct 1997 21:51:25 -0500 + Branch: win32/perl + ! pp_ctl.c +____________________________________________________________________________ +[ 307] By: gsar on 1997/11/26 01:22:10 + Log: Sync another change from local repository. + From: Gurusamy Sarathy + Message-Id: <199710290316.WAA15888@aatma.engin.umich.edu> + Subject: Re: do_postponed breaks with multiple interpreters + Date: Tue, 28 Oct 1997 22:16:13 -0500 + Branch: win32/perl + ! op.c +____________________________________________________________________________ +[ 306] By: gsar on 1997/11/26 01:17:46 + Log: Sync a change from local repository. + From: Gurusamy Sarathy + Message-Id: <199710290106.UAA11485@aatma.engin.umich.edu> + Subject: [PATCH] Re: Core dump from using sockets w/ system or open(pipe) or "`" + Date: Tue, 28 Oct 1997 20:06:06 -0500 + Branch: win32/perl + ! mg.c +____________________________________________________________________________ +[ 305] By: nick on 1997/11/26 00:50:10 + Log: Integrate mainline as of _55 + Branch: ansiperl + +> emacs/ptags + !> (integrate 36 files) +____________________________________________________________________________ +[ 304] By: gsar on 1997/11/26 00:27:57 + Log: Various changes to make it build cleanly and pass all tests: + - needed to run `perl embed.pl` + - use PERL_CORE instead of PERLDLL in places that do mean PERL_CORE + - fix prototypes for a few declarations (Borland is finally quiet) + - move declaration of Mymalloc etc to perl.h (since win32 and other + ports may #define malloc themselves, to let extensions bind to + the version that perl used) + - move struct reg_data into a public header file, since it is + referenced in a public datatype + - win32 makefile fixes + - fix remaining s/thread/perl_thread/ + Branch: win32/perl + ! EXTERN.h embed.h ext/DynaLoader/dlutils.c + ! ext/SDBM_File/sdbm/sdbm.h hv.c perl.h proto.h regcomp.h + ! regexp.h win32/Makefile win32/dl_win32.xs win32/makefile.mk + ! win32/win32.h win32/win32iop.h win32/win32thread.c +____________________________________________________________________________ +[ 303] By: gsar on 1997/11/25 20:57:31 + Log: Fixup the places where the automatic merge got it wrong. + Previous change (#302) was just a normal integration--ignore the + "reverse" in there. + Branch: win32/perl + ! op.c perl.h +____________________________________________________________________________ +[ 302] By: gsar on 1997/11/25 20:32:12 + Log: reverse integrate mainline + Branch: win32/perl + +> emacs/ptags + !> (integrate 896 files) + +---------------- +Version 5.004_55 +---------------- + +____________________________________________________________________________ +[ 301] By: mbeattie on 1997/11/25 17:59:53 + Log: Fix minor thinkos in hv.c and pp_ctl.c. This is 5.004_55. + Branch: perl + ! hv.c pp_ctl.c +____________________________________________________________________________ +[ 300] By: mbeattie on 1997/11/25 16:29:36 + Log: Add t/avhv.t to MANIFEST and bump patchlevel.h to 55. + Branch: perl + ! MANIFEST patchlevel.h +____________________________________________________________________________ +[ 299] By: mbeattie on 1997/11/25 15:59:16 + Log: Move malloc_mutex initialisation/destruction: + Subject: patch to 5.004_54 for pthreads with Perl's malloc + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Branch: perl + ! malloc.c os2/os2.c os2/os2ish.h perl.c perl.h plan9/plan9ish.h + ! unixish.h vms/vmsish.h +____________________________________________________________________________ +[ 298] By: mbeattie on 1997/11/25 15:49:22 + Log: Make hv_ functions cope better with 'm'-magic: + Subject: [5.004_54] Another neglected patch + Date: Fri, 21 Nov 1997 22:28:17 -0500 + From: Owen Taylor + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 297] By: mbeattie on 1997/11/25 15:47:36 + Log: Fix typo in Thread.xs. + Branch: perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 296] By: mbeattie on 1997/11/25 15:42:07 + Log: Integrate from ansi branch to mainline. + Branch: perl + !> (integrate 890 files) +____________________________________________________________________________ +[ 295] By: mbeattie on 1997/11/25 14:29:31 + Log: AIX patch for DynaLoader/dl_aix.xs and hints/aix.sh: + Subject: Re: _54 on AIX + Date: Tue, 25 Nov 1997 00:49:52 -0800 (PST) + From: Jarkko Hietaniemi + Branch: perl + ! ext/DynaLoader/dl_aix.xs +____________________________________________________________________________ +[ 294] By: mbeattie on 1997/11/25 14:29:10 + Log: AIX patch for hints/aix.sh: + Subject: Re: _54 on AIX + Date: Tue, 25 Nov 1997 00:49:52 -0800 (PST) + From: Jarkko Hietaniemi + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 291] By: mbeattie on 1997/11/25 14:17:05 + Log: Fix scalar dereference of threadsv variables (e.g. $$_). + Branch: perl + ! op.c op.h +____________________________________________________________________________ +[ 290] By: mbeattie on 1997/11/25 14:16:29 + Log: AIX patch (including Configure support for {sched,pthread}_yield, + pthread initial detach state, renaming perl_thread to perl_os_thread + and struct thread to struct perl_thread): + Subject: Re: _54 on AIX + Date: Thu, 20 Nov 1997 06:10:51 -0800 (PST) + From: Jarkko Hietaniemi + Branch: perl + ! Configure config_h.SH cv.h ext/DB_File/DB_File.xs + ! ext/Thread/Makefile.PL ext/Thread/Thread.pm + ! ext/Thread/Thread.xs fakethr.h hints/aix.sh perl.c perl.h pp.h + ! proto.h sv.h thread.h util.c win32/win32thread.c + ! win32/win32thread.h +____________________________________________________________________________ +[ 289] By: mbeattie on 1997/11/25 12:33:02 + Log: Rename perl_thread to perl_os_thread. + Branch: perl + ! fakethr.h thread.h util.c win32/win32thread.h +____________________________________________________________________________ +[ 288] By: mbeattie on 1997/11/25 12:27:35 + Log: Remove bincompat3 support: + Subject: Re: ANNOUNCE: perl5.004_54 is available + Date: Wed, 19 Nov 1997 08:07:10 -0800 (PST) + From: Jarkko Hietaniemi + Branch: perl + ! Configure INSTALL embed.h global.sym malloc.c +____________________________________________________________________________ +[ 287] By: mbeattie on 1997/11/25 12:23:50 + Log: Emacs/tags update: + Subject: Emacs/tags update for 5.004_54 + Date: Fri, 21 Nov 1997 15:02:09 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + + emacs/ptags + ! MANIFEST Makefile.SH emacs/cperl-mode.el +____________________________________________________________________________ +[ 286] By: nick on 1997/11/23 23:03:56 + Log: Add $$_ test + Branch: ansiperl + ! t/op/ref.t +____________________________________________________________________________ +[ 285] By: gsar on 1997/11/23 08:26:00 + Log: Initial reverse integration of winansi branch. + Branch: win32/perl + !> (integrate 50 files) +____________________________________________________________________________ +[ 284] By: gsar on 1997/11/23 07:32:24 + Log: Add to docs about the BEGIN { shift } feature. Make the change + yet simpler using CvUNIQUE(compcv) instead of subline (Chip's idea). + Branch: win32/perl + ! op.c perly.c perly.y pod/perlfunc.pod vms/perly_c.vms +____________________________________________________________________________ +[ 283] By: nick on 1997/11/22 21:29:30 + Log: Duplicate perl_threadsv + Branch: ansiperl + ! global.sym +____________________________________________________________________________ +[ 282] By: nick on 1997/11/22 21:18:11 + Log: Munge pseudo-Configure stuff to add -thread to archname as + Malcolm seems to think that is way to test for threads. + Update @INC stuffing hackery to have traditional @INC + search order archlib, privlib, sitearch, site. + Branch: ansiperl + ! t/lib/english.t win32/config.bc win32/config_H.bc + ! win32/config_H.vc win32/config_h.PL win32/config_sh.PL + ! win32/makefile.mk win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 281] By: nick on 1997/11/22 19:28:21 + Log: Builds and passes all but english.t on win32 VC++ + Branch: ansiperl + ! global.sym pp_ctl.c win32/Makefile win32/config.vc + ! win32/config_H.vc win32/win32thread.h +____________________________________________________________________________ +[ 280] By: nick on 1997/11/22 18:10:50 + Log: ansiperl builds with Borland C++ again + Branch: ansiperl + ! pp_ctl.c regcomp.c regcomp.h regexec.c toke.c util.c + ! win32/config.bc win32/config_H.bc win32/perlglob.c + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 279] By: nick on 1997/11/22 16:42:51 + Log: Resolve ansiperl against mainline + Branch: ansiperl + !> embed.h ext/Thread/Thread.xs global.sym op.c op.h perl.c + !> perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.c scope.h + !> t/lib/english.t thread.h toke.c util.c +____________________________________________________________________________ +[ 278] By: nick on 1997/11/22 16:30:27 + Log: Resolve ansiperl against win32 + Branch: ansiperl + !> (integrate 55 files) +____________________________________________________________________________ +[ 277] By: gsar on 1997/11/22 09:48:02 + Log: - shift() inside BEGIN|END|INIT now shifts @ARGV instead of @_ + - added a test for the above + - fixed up perly.c.diff and vms/perl_c.vms for above and added the + ansification hunks + Branch: win32/perl + ! op.c perly.c perly.c.diff perly.y t/op/misc.t vms/perly_c.vms +____________________________________________________________________________ +[ 276] By: gsar on 1997/11/22 07:24:01 + Log: Generic change in win32 branch: don't just turn on CRIPPLED_CC + when USE_THREADS. GCC for instance, can do without macros that use + globals. Instead, selectively re#define only those macros + that use globals to their functional equivalents. Tests 100% on + Solaris/gcc (after `chmod +x t/op/nothread.t t/lib/thread.t` (hint,hint)). + Branch: win32/perl + ! perl.h sv.h +____________________________________________________________________________ +[ 275] By: gsar on 1997/11/22 05:27:04 + Log: Integrate mainline. + Branch: win32/perl + +> ext/Thread/die.t ext/Thread/die2.t t/op/avhv.t + - lib/Class/Fields.pm lib/ISA.pm + !> (integrate 41 files) +____________________________________________________________________________ +[ 274] By: mbeattie on 1997/11/21 18:28:22 + Log: $_ is now per-thread (rather a lot of changes). Only tested under + *-linux-thread at the moment. + Branch: perl + ! embed.h ext/Thread/Thread.xs global.sym op.c op.h perl.c + ! perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.c scope.h + ! t/lib/english.t thread.h toke.c util.c +____________________________________________________________________________ +[ 273] By: mbeattie on 1997/11/21 10:31:29 + Log: Filter patch to toke.c: + Subject: Tiny core patch for source filters + Date: Thu, 20 Nov 1997 23:12:09 +0000 (GMT) + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 272] By: nick on 1997/11/21 00:54:43 + Log: Basic integrate of lastest perl into ansiperl + Branch: ansiperl + +> ext/Thread/die.t ext/Thread/die2.t t/op/avhv.t + - lib/Class/Fields.pm lib/ISA.pm + ! win32/win32.c win32/win32.h + !> (integrate 57 files) +____________________________________________________________________________ +[ 271] By: mbeattie on 1997/11/20 12:12:00 + Log: Initial stab at IRIX configuration support for threading. Manually + applied parts of following patches: + Subject: Perl 5.004_54 on IRIX + Date: Wed, 19 Nov 1997 18:37:14 +0200 (EET) + From: Jarkko Hietaniemi + Subject: Re: Perl 5.004_54 on IRIX + Date: 19 Nov 1997 17:10:17 -0800 + From: Scott Henry + Branch: perl + ! README.threads hints/irix_6.sh hints/irix_6_0.sh + ! hints/irix_6_1.sh perl.h +____________________________________________________________________________ +[ 270] By: mbeattie on 1997/11/19 17:45:37 + Log: The new jumbo regexp stuff did SSPUSHINT on a char* instead of + SSPUSHPTR causing Alpha to core dump in pat.t. While fixing it, + also fixed two instances of referring to SVs after destruction. + Branch: perl + ! regcomp.c regexec.c +____________________________________________________________________________ +[ 269] By: mbeattie on 1997/11/19 15:33:23 + Log: avhv_keys under Digital UNIX made avhv.t fail because *keysp was + changed by mg_get(*keysp) (!). Introducing a new local variable + fixed it but I don't know if it's a compiler problem or some + other corruption happening elsewhere. + Branch: perl + ! av.c +____________________________________________________________________________ +[ 268] By: mbeattie on 1997/11/19 11:39:49 + Log: Let Configure sort out get{host,net}byaddr* prototypes: + Subject: [PATCH] 5.004_54: little something for + get{hos,ne}tbyaddr protos (Configure, config_h.SH, pp_sys.c) + Date: Tue, 18 Nov 1997 19:08:19 +0200 (EET) + From: Jarkko Hietaniemi + Branch: perl + ! Configure config_h.SH pp_sys.c +____________________________________________________________________________ +[ 267] By: mbeattie on 1997/11/19 11:04:15 + Log: Jumbo regexp patch applied (with minor fix-up tweaks): + Subject: Version 7 of Jumbo RE patch available + Date: Sun, 16 Nov 1997 00:29:39 -0500 (EST) + From: Ilya Zakharevich + Branch: perl + ! MANIFEST dump.c embed.h global.sym mg.c op.c op.h perl.c + ! perl.h pod/perlre.pod pp.c pp_ctl.c pp_hot.c proto.h regcomp.c + ! regcomp.h regexec.c regexp.h sv.c t/op/misc.t t/op/pat.t + ! t/op/re_tests t/op/regexp.t t/op/split.t t/op/subst.t toke.c + ! util.c +____________________________________________________________________________ +[ 266] By: mbeattie on 1997/11/18 17:26:09 + Log: Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked + version of patch: + Subject: tie fake hash patch for 5.004_54 + Date: Sat, 15 Nov 1997 19:18:30 -0500 + From: Joshua Pritikin + Branch: perl + + t/op/avhv.t + ! av.c embed.h global.sym proto.h +____________________________________________________________________________ +[ 265] By: mbeattie on 1997/11/18 16:51:04 + Log: Bring MANIFEST up to date. Add new thread tests. + Branch: perl + + ext/Thread/die.t ext/Thread/die2.t + ! MANIFEST +____________________________________________________________________________ +[ 264] By: mbeattie on 1997/11/18 16:41:27 + Log: magic_setisa enhanced to update %FIELDS automatically when @ISA + is assigned to. Added tests to t/op/array.t. magic_setisa now + warns about including non-existent packages in @ISA when -w is on. + Branch: perl + - lib/Class/Fields.pm lib/ISA.pm + ! mg.c t/op/array.t +____________________________________________________________________________ +[ 263] By: mbeattie on 1997/11/18 16:38:57 + Log: Fix typo in win32 -> mainline integration. + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 262] By: mbeattie on 1997/11/18 11:56:09 + Log: Integrate win32 branch back into mainline. + Branch: perl + - win32/win32io.c win32/win32io.h + ! op.c + !> (integrate 30 files) +____________________________________________________________________________ +[ 261] By: gsar on 1997/11/18 00:14:02 + Log: Export our own FD_SET() et al to complete sockets-as-handles pretense. + Branch: win32/perl + ! win32/config.bc win32/config.vc win32/config_H.bc + ! win32/config_H.vc win32/include/sys/socket.h win32/win32sck.c +____________________________________________________________________________ +[ 260] By: nick on 1997/11/16 23:16:16 + Log: Generic file changes for MYMALLOC + Branch: ansiperl + ! miniperlmain.c perl.c +____________________________________________________________________________ +[ 259] By: nick on 1997/11/16 23:14:36 + Log: MYMALLOC for Win32: + 1. Initialize malloc_mutex before it is used (all platforms!) + 2. Adjust #ifdef muddle to allow MYMALLOC and win32_ to coexist + 3. Tweak win32/config*.* to define MYMALLOC + 4. Provide sbrk() in terms of VirtualAlloc(). + + Also fixup -MT (perl95) build to handle Perl_current_thread + via call to DLL (as though an extension). + Branch: ansiperl + ! win32/Makefile win32/config.bc win32/config.vc + ! win32/config_H.bc win32/config_H.vc win32/makedef.pl + ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32thread.h +____________________________________________________________________________ +[ 258] By: nick on 1997/11/15 20:42:28 + Log: Implement dTHR via __declspec(thread) - part 2 + Branch: ansiperl + ! win32/makedef.pl win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 257] By: nick on 1997/11/15 19:52:53 + Log: Use __declspec(thread) var rather tha TslAlloc & co. + Branch: ansiperl + ! win32/makedef.pl win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 256] By: gsar on 1997/11/15 02:58:09 + Log: Add #include guard in Thread.xs so it will build even under + no USE_THREADS (for win32). This was missed because of edit + w/o checkout perforce kludge. + Branch: win32/perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 255] By: nick on 1997/11/15 00:33:46 + Log: Integrate mainline (5.004_54?) into ansiperl + Branch: ansiperl + !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs + !> ext/Thread/Thread/Specific.pm ext/Thread/join.t + !> ext/Thread/specific.t global.sym lib/fields.pm mg.c op.c + !> perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c proto.h scope.c + !> t/io/pipe.t t/lib/io_pipe.t t/op/magic.t thread.h +____________________________________________________________________________ +[ 254] By: nick on 1997/11/15 00:25:26 + Log: Interate win32 into ansiperl + Branch: ansiperl + +> ext/Thread/Thread/Specific.pm ext/Thread/specific.t + +> lib/fields.pm + !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs + !> ext/Thread/join.t global.sym mg.c op.c perl.c perl.h pp_ctl.c + !> pp_hot.c pp_sys.c proto.h scope.c t/io/pipe.t t/lib/io_pipe.t + !> t/op/magic.t thread.h win32/Makefile win32/config.bc + !> win32/config.vc win32/config_sh.PL win32/makefile.mk +____________________________________________________________________________ +[ 253] By: gsar on 1997/11/14 22:04:58 + Log: Integrate mainline changes into win32 branch. Now would be a good time + to reverse integrate the win32 branch into mainline. + Branch: win32/perl + +> ext/Thread/Thread/Specific.pm ext/Thread/specific.t + +> lib/fields.pm + !> MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs + !> ext/Thread/join.t global.sym mg.c op.c perl.c perl.h pp_ctl.c + !> pp_hot.c pp_sys.c proto.h scope.c t/io/pipe.t t/lib/io_pipe.t + !> t/op/magic.t thread.h + +---------------- +Version 5.004_54 +---------------- + +____________________________________________________________________________ +[ 252] By: mbeattie on 1997/11/14 15:07:19 + Log: Two more delays added to test suite to help *-solaris-thread. + Branch: perl + ! t/io/pipe.t t/lib/io_pipe.t +____________________________________________________________________________ +[ 251] By: mbeattie on 1997/11/14 15:05:57 + Log: Remove stale code from Thread.xs. + Branch: perl + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 250] By: mbeattie on 1997/11/14 10:12:40 + Log: Add delay to signal handling in t/op/magic.t. (Solaris with pthreads + doesn't run handlers for self-sent signals until kill has returned.) + Branch: perl + ! t/op/magic.t +____________________________________________________________________________ +[ 249] By: gsar on 1997/11/14 05:14:44 + Log: Fix various details in win32 makefiles and Config.pm setup. + - ldflags is set for both compilers now + - extensions list is now correct + - delete perl95.exe on distclean + - cf_time now gets updated (once) + - ccdlflags is set for Borland + - fix startperl so dprofpp works + Branch: win32/perl + ! win32/Makefile win32/config.bc win32/config.vc + ! win32/config_sh.PL win32/makefile.mk +____________________________________________________________________________ +[ 248] By: mbeattie on 1997/11/13 18:01:27 + Log: Rewrite thread return code to distinguish between ordinary return + and die() and make join propagate the die. Add tiny method eval + which just does "return eval { shift->join; }". Add Thread::Specific + class for access to thread specific user data along with specific.t. + Rename Class to classname throughout Thread.xs for consistency. + Fix pp_specific to pp_threadsv in global.sym. Add support to + pp_entersub in pp_hot.c to lock stash for static locked methods. + Branch: perl + + ext/Thread/Thread/Specific.pm ext/Thread/specific.t + + lib/fields.pm + ! MANIFEST embed.h ext/Thread/Thread.pm ext/Thread/Thread.xs + ! ext/Thread/join.t global.sym mg.c pp_hot.c thread.h +____________________________________________________________________________ +[ 247] By: mbeattie on 1997/11/13 14:13:30 + Log: Change CONTEXT to PERL_CONTEXT throughout source (since the #define + to avoid the Digital UNIX clash no longer works). Changed the #ifdef + in pp_sys.c for whether getnet* function get protoyped (since the + default had a broken prototype for getnetbyaddr). + Branch: perl + ! mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c proto.h + ! scope.c thread.h +____________________________________________________________________________ +[ 246] By: nick on 1997/11/13 02:44:40 + Log: Integrate Win32 branch + Branch: ansiperl + - configure ext/util/extliblist win32/bin/pl2bat.bat + - win32/bin/search.bat win32/bin/test.bat win32/bin/webget.bat + - win32/config.H win32/config.w32 win32/win32io.c + - win32/win32io.h + !> (integrate 905 files) +____________________________________________________________________________ +[ 245] By: nick on 1997/11/13 00:47:54 + Log: Integrate (-ay) win32 branch at its creation to + establish and ancestor as per perkforce technote #9 + Branch: ansiperl + +> configure ext/util/extliblist win32/bin/pl2bat.bat + +> win32/bin/search.bat win32/bin/test.bat win32/bin/webget.bat + +> win32/config.H win32/config.w32 + !> (integrate 859 files) +____________________________________________________________________________ +[ 244] By: gsar on 1997/11/12 22:26:39 + Log: More cleanups of win32/win32*.[ch] files. win32/win32iop.h now + contains the all the declarations and macros for the win32io layer. + New std-ish functions are exported now. All win32-specific exported + functions begin with "win32_" consistently. win32 version of + init_os_extras() is now exported, so embedders can get the in-core + xsubs. + Branch: win32/perl + ! dosish.h win32/makedef.pl win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 243] By: gsar on 1997/11/12 07:41:52 + Log: Really delete deleted files. + Branch: win32/perl + - win32/win32io.c win32/win32io.h +____________________________________________________________________________ +[ 242] By: gsar on 1997/11/12 07:40:54 + Log: Egregious IOsubsystem code excised. Phew, what a relief! Two + files (win32/win32io.[ch]) completely removed, as are all traces + of them in makefiles and MANIFEST. RunPerl() retains the void* arg + for later. Various myfoo() things regularized to my_foo(). CPP not + required anymore to create a perl binary :) + Branch: win32/perl + ! MANIFEST win32/Makefile win32/makedef.pl win32/makefile.mk + ! win32/perllib.c win32/runperl.c win32/win32.c win32/win32.h + ! win32/win32io.c win32/win32io.h win32/win32iop.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 241] By: gsar on 1997/11/12 05:31:28 + Log: Fix various win32 code blemishes: + - s/stolen/win32/g + - s/(CROAK|WARN)/lc($1)/eg + - remove deadcode from most places + Branch: win32/perl + ! win32/makedef.pl win32/win32.c win32/win32io.c + ! win32/win32iop.h +____________________________________________________________________________ +[ 240] By: gsar on 1997/11/12 04:36:29 + Log: Carry over changes in ansiperl branch. Win32 branch is now + the leading edge. + Branch: win32/perl + ! embed.h global.sym perl.c win32/win32thread.c + ! win32/win32thread.h +____________________________________________________________________________ +[ 239] By: gsar on 1997/11/12 03:39:57 + Log: Add missing win32_closesocket() and export it (extension writers' complaint). + Branch: win32/perl + ! win32/include/sys/socket.h win32/makedef.pl win32/win32sck.c +____________________________________________________________________________ +[ 238] By: gsar on 1997/11/12 03:25:17 + Log: Clean up win32/win32sck.c (runtime load of Winsock now gone, it can be + done cleaner, if really needed (perhaps only for efficiency reasons?)). + Redundant EXTERN_C definitions and related warnings fixed. + Branch: win32/perl + ! miniperlmain.c perl.h win32/perllib.c win32/win32io.c + ! win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 237] By: nick on 1997/11/12 02:45:15 + Log: Fixup Win32 + - #undef start_env before re-#defining it + - change pp_specific pp_threadsv in global.sym + - re-build embed.h + - avoid HAVE_THREAD_INTERN - we don't and empty struct + is a pain. If we did have it it would contain cached + values of things we can only get at _IN_ the thread + so new_struct_thread is wrong place to call it. + - add new macro SET_THREAD_SELF - we must (in main thread) + define in win32thread.h, support in win32thread.c, + test and call in perl.c + Branch: ansiperl + ! embed.h global.sym perl.c thread.h win32/win32thread.c + ! win32/win32thread.h +____________________________________________________________________________ +[ 236] By: nick on 1997/11/12 01:54:23 + Log: Integrate mainline after it integrated us. + Accepted 'theirs' everywhere - so two branches should + now point to same files again. + Almost all of these were what was suggested, others were + whitespace diffs. A few dubious spots which we will now + go fix. + Branch: ansiperl + !> embed.h ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs + !> ext/Opcode/Opcode.pm ext/Thread/Thread.xs interp.sym mg.c op.c + !> opcode.h opcode.pl perl.c perl.h pp.c pp_ctl.c pp_sys.c t/TEST + !> t/lib/safe2.t t/lib/thread.t t/op/nothread.t thread.h toke.c + !> util.c +____________________________________________________________________________ +[ 235] By: gsar on 1997/11/12 01:22:26 + Log: Minor tweaks to add a thread_intern struct that should ultimately + contain all the win32-specific statics. + Win32 branch now passes all tests with or w/o USE_THREADS. + Branch: win32/perl + ! embed.h perl.c win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 234] By: gsar on 1997/11/11 23:08:54 + Log: Initial (untested) integration of mainline changes. + Branch: win32/perl + - configure + !> (integrate 89 files) +____________________________________________________________________________ +[ 233] By: mbeattie on 1997/11/11 18:07:30 + Log: Typo in thread.h: ADD_THREAD_INTERN should be HAVE_THREAD_INTERN + Branch: perl + ! thread.h +____________________________________________________________________________ +[ 232] By: mbeattie on 1997/11/11 17:49:12 + Log: t/TEST (reverted to @229 version) should have been included in the + previous change (231) but my way of recovering it didn't work + properly. The change 231 comments about successful tests applies + to this t/TEST (i.e. as of this change). + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 231] By: mbeattie on 1997/11/11 17:46:59 + Log: Fix up ansiperl integration. Back to passing all expected tests + with usethreads. Untested with non-threaded perl. + Branch: perl + ! embed.h ext/DB_File/DB_File.xs ext/GDBM_File/GDBM_File.xs + ! perl.c perl.h pp.c t/lib/thread.t t/op/nothread.t util.c +____________________________________________________________________________ +[ 230] By: mbeattie on 1997/11/11 16:36:22 + Log: Initial integration of ansi branch into mainline (untested). + Branch: perl + +> t/lib/thread.t t/op/nothread.t thread.sym + - configure + !> (integrate 84 files) +____________________________________________________________________________ +[ 229] By: mbeattie on 1997/11/11 15:20:43 + Log: Change name of OP_SPECIFIC to OP_THREADSV. Fixed perl_get_sv when + getting per-thread magicals. Fixed thr->errsv initialisation. + Branch: perl + ! ext/Opcode/Opcode.pm op.c opcode.h opcode.pl perl.c pp.c + ! t/lib/safe2.t toke.c +____________________________________________________________________________ +[ 228] By: mbeattie on 1997/11/11 12:48:26 + Log: Fix up $@ (ERRSV now refers to GvSV(errgv) for non-threaded perl and + thr->errsv for threaded perl). Fix pp_tie and pp_dbmopen to use + GvCV(gv) instead of gv so AUTOLOAD stuff works. All tests now pass + again for non-threaded perl. Enhanced perl_get_sv to return + per-thread magicals where necessary for threaded perl. + Branch: perl + ! embed.h ext/Thread/Thread.xs interp.sym mg.c op.c perl.c + ! perl.h pp_ctl.c pp_sys.c thread.h toke.c util.c +____________________________________________________________________________ +[ 227] By: mbeattie on 1997/11/11 11:00:02 + Log: hashlock bug. + + Jobs fixed ... + + hashlock fixed on 1997/11/11 by mbeattie@localhost + + Subject: [perl5.004_53; patch] Another hash-locking fix + Date: 23 Oct 1997 14:13:55 -0400 + From: Owen Taylor + Branch: bugs + + hashlock +____________________________________________________________________________ +[ 226] By: gsar on 1997/11/11 02:11:23 + Log: Slightly more refined lock() keyword recognition (using %INC). + Branch: win32/perl + ! toke.c +____________________________________________________________________________ +[ 225] By: gsar on 1997/11/11 00:26:09 + Log: "weak" lock keyword (hardcoded initial implementation) now works. + if not defined(&Thread::join) and defined(&__PACKAGE__::lock), 'lock' + is recognized as a sub, a regular keyword otherwise. Could be + generalized by storing a flag for every op in OP struct, and turning + the flag off when Thread.xs loads. + Branch: win32/perl + ! toke.c +____________________________________________________________________________ +[ 224] By: gsar on 1997/11/10 22:59:55 + Log: Merge a patch in preparation for "weak keywords": + From: Gurusamy Sarathy + Message-Id: <199710080618.CAA23899@aatma.engin.umich.edu> + Subject: [PATCH] global overrides for keywords + Date: Wed, 08 Oct 1997 02:18:23 -0400 + Branch: win32/perl + ! embed.h interp.sym perl.c perl.h toke.c +____________________________________________________________________________ +[ 223] By: gsar on 1997/11/10 22:41:31 + Log: Remove runlevel. It was used to count how many runops() calls + we were in the process of executing, and longjmp() to the topmost + one (if not already there). We use a null top_env->je_prev + to distinguish that now. + Branch: win32/perl + ! embed.h interp.sym perl.h pp_ctl.c run.c thread.h util.c +____________________________________________________________________________ +[ 222] By: gsar on 1997/11/10 04:47:48 + Log: Win32 branch now contains all non-ansification changes in ansiperl branch. + USE_THREADS case builds and passes all tests using both compilers. + Additional tweaks: + - fixup win32/makedef.pl to skip more symbols for non-thread build. + - sync win32/Makefile with win32/makefile.mk + >>>Non-thread build fails a lot of tests.<<< + Branch: win32/perl + + thread.sym + ! MANIFEST ext/Thread/Thread.xs perl.c perl.h pp_sys.c sv.c + ! util.c win32/Makefile win32/config.bc win32/config_H.bc + ! win32/makedef.pl win32/makefile.mk +____________________________________________________________________________ +[ 221] By: gsar on 1997/11/10 00:57:53 + Log: Initial (untested) merge of all non-ansi changes on ansiperl branch + into win32 branch. + Branch: win32/perl + + t/lib/thread.t t/op/nothread.t + ! MANIFEST embed.h ext/Opcode/Opcode.pm global.sym interp.sym + ! perl.c proto.h sv.h t/lib/english.t t/op/misc.t thread.h + ! 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/win32.c win32/win32.h win32/win32io.c + ! win32/win32io.h win32/win32iop.h win32/win32sck.c + ! win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 220] By: gsar on 1997/11/09 22:44:41 + Log: Integrate latest mainline into win32 branch. + Branch: win32/perl + +> win32/win32thread.c win32/win32thread.h + !> (integrate 39 files) +____________________________________________________________________________ +[ 219] By: nick on 1997/11/09 21:46:06 + Log: Conditionalize english.t, + Enhance times() for NT, + (Failed) attempt to implement alarm(), + Fixed config.h dependancy in makefile.mk + Branch: ansiperl + ! t/lib/english.t win32/config.bc win32/config_H.bc + ! win32/makefile.mk win32/win32.c +____________________________________________________________________________ +[ 218] By: nick on 1997/11/09 15:38:00 + Log: Dick Hardt's patch for build on Alpha + Branch: ansiperl + ! win32/Makefile +____________________________________________________________________________ +[ 217] By: nick on 1997/11/09 03:31:20 + Log: MakeMaker not in vofig noise fix for dmake + Branch: ansiperl + ! win32/config.bc win32/makefile.mk +____________________________________________________________________________ +[ 216] By: nick on 1997/11/09 03:15:06 + Log: Fix 'anydbm.t' - if the gv is passed 1st call to inherited + TIEHASH works, but 2nd call (after db is closed, attempt + to reopen) tries to AUTOLOAD TIEHASH rather than using + cached value. + Branch: ansiperl + ! pp_sys.c +____________________________________________________________________________ +[ 215] By: nick on 1997/11/08 16:41:24 + Log: Cleanup MakeMaker 'not in config' noise + Branch: ansiperl + ! win32/Makefile win32/config.vc +____________________________________________________________________________ +[ 214] By: nick on 1997/11/08 15:07:24 + Log: Remove 'configure' leaving configure.gnu and Configure + Win32 ignores case and keeps trying to update + repository copy of 'configure' or 'Configure' with + the other. + Branch: ansiperl + - configure + ! MANIFEST +____________________________________________________________________________ +[ 213] By: nick on 1997/11/08 15:03:39 + Log: Get threads working again on Win32 + Root cause of fail was init_thread_intern() in + new_struct_thread() (which is called in parent thread) + clobbering dTHR of parent thread. + It is doubtfull if setting 'self' in new_struct_thread() + is 'right' but left in for now. + Branch: ansiperl + ! ext/Thread/Thread.xs perl.c thread.h util.c win32/Makefile + ! win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 212] By: nick on 1997/11/08 00:34:03 + Log: Add :base_thread to :default in Opcode.pm + This allows lib/safe.t to pass when threaded. + It is unclear if 'lock' should be safe as it allows + denial of service attack, but could not figure out + how to add just 'specific' (sic) to :default + without triggering 'already tagged' warning noise. + Branch: ansiperl + ! ext/Opcode/Opcode.pm win32/makefile.mk +____________________________________________________________________________ +[ 211] By: nick on 1997/11/07 23:59:31 + Log: Merge changes as of 18:00 CST + Branch: ansiperl + !> op.c pp.c pp_sys.c thread.h util.c +____________________________________________________________________________ +[ 210] By: nick on 1997/11/07 23:52:35 + Log: Reverse integrate Malcolm's chanes into local + repository, then import result back into my view + of Malcolm's repository. + Builds and passes (most) tests with GNU C++/Solaris + and Borland C++, Win32. + Branch: ansiperl + ! doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c + ! interp.sym mg.c op.c opcode.h opcode.pl patchlevel.h perl.c + ! perl.h pp.c pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c + ! thread.h toke.c util.c win32/makefile.mk +____________________________________________________________________________ +[ 209] By: mbeattie on 1997/11/07 18:12:36 + Log: Change pp_tie and pp_dbmopen to use perl_call_sv instead of a + DIY pp_entersub (in preparation for AUTOLOAD change). dbmopen + not tested. ofslen now maps to thr->Tofslen in thread.h. Added + missing #ifdef USE_THREADS around some DEBU_L statements in die(). + Building without USE_THREADS fails quite a lot of tests. It looks + as though the move to per-thread magicals must be missing some + #ifdef USE_THREADS. + Branch: perl + ! op.c pp.c pp_sys.c thread.h util.c +____________________________________________________________________________ +[ 208] By: nick on 1997/11/07 01:37:28 + Log: Raw integrate of latest perl + Branch: ansiperl + ! t/TEST + !> README.threads Todo.5.005 embed.h ext/Opcode/Opcode.pm + !> ext/Thread/Thread.xs global.sym gv.c interp.sym op.c op.h + !> perl.c perl.h pp.c pp_ctl.c pp_hot.c proto.h scope.h sv.h + !> thread.h toke.c util.c +____________________________________________________________________________ +[ 207] By: mbeattie on 1997/11/06 14:58:00 + Log: Update README.threads and Todo.5.005. + Branch: perl + ! README.threads Todo.5.005 +____________________________________________________________________________ +[ 206] By: mbeattie on 1997/11/06 14:37:37 + Log: Remove #ifdef DEPRECATED stuff: newXSUB, pp_entersubr, FREE_TMPS(). + Branch: perl + ! op.c pp_ctl.c proto.h scope.h +____________________________________________________________________________ +[ 205] By: mbeattie on 1997/11/06 14:31:38 + Log: Per-thread magicals now stored in their own thr->magicals and keyed + more directly. cvcache and oursv become ordinary struct thread + fields instead of #defined thr->Tfoo ones. SvREFCNT_inc now checks + for 0 again. Main thread initialisation done by new function + init_main_thread instead of (now fixed) new_struct_thread. + + Jobs fixed ... + + jmpenv fixed on 1997/11/06 by mbeattie@localhost + + Subject: [perl5.004_53; patch] eval's and threads + Date: 23 Oct 1997 23:59:19 -0400 + From: Owen Taylor + Branch: bugs + + jmpenv + Branch: perl + ! embed.h ext/Thread/Thread.xs global.sym gv.c op.c perl.c + ! pp_ctl.c pp_hot.c proto.h sv.h thread.h toke.c util.c +____________________________________________________________________________ +[ 204] By: mbeattie on 1997/11/05 17:18:18 + Log: Per-thread magicals mostly working (and localisable). Now getting + intermittent occasional "Use of uninitialized value" warnings + which may be due to some op flag black magic I've broken. + Branch: perl + ! embed.h ext/Opcode/Opcode.pm ext/Thread/Thread.xs gv.c + ! interp.sym op.c op.h perl.c perl.h pp.c thread.h toke.c util.c +____________________________________________________________________________ +[ 203] By: nick on 1997/11/05 01:04:10 + Log: Builds C++ Borland, MSVC++ (Win32) and GCC++ (Solaris) + Branch: ansiperl + ! XSUB.h doio.c doop.c embed.h ext/SDBM_File/sdbm/sdbm.h + ! ext/Thread/Thread.xs global.sym gv.c hv.c interp.sym mg.c + ! miniperlmain.c op.c op.h opcode.h opcode.pl patchlevel.h + ! perl.c perl.h pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h + ! sv.c sv.h taint.c thread.h toke.c util.c win32/Makefile + ! win32/config.vc win32/config_H.vc win32/makedef.pl + ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32io.c win32/win32io.h win32/win32iop.h + ! win32/win32sck.c win32/win32thread.h +____________________________________________________________________________ +[ 202] By: nick on 1997/11/05 00:50:27 + Log: Compile(d) at least once with threads on win32 + but did not work + Branch: ansiperl + ! embed.h perl.c thread.h +____________________________________________________________________________ +[ 201] By: nick on 1997/11/05 00:32:13 + Log: Trivial integrate + Branch: ansiperl + !> patchlevel.h +____________________________________________________________________________ +[ 200] By: mbeattie on 1997/11/04 12:06:09 + Log: Up patchlevel to 5.004_54 (I missed _53 for the last release). + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 199] By: nick on 1997/11/01 00:18:52 + Log: Integrate mainline @ 18:15 CST 31 Oct 1997 + Branch: ansiperl + !> doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c + !> interp.sym mg.c op.c opcode.h opcode.pl perl.c perl.h pp.c + !> pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c thread.h toke.c + !> util.c +____________________________________________________________________________ +[ 198] By: nick on 1997/11/01 00:08:33 + Log: win32thread.* not in MANIFEST which has muddled moving + back and forth between depots. + Branch: ansiperl + ! MANIFEST win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 197] By: nick on 1997/11/01 00:02:49 + Log: Test changes + Branch: ansiperl + + t/lib/thread.t t/op/nothread.t thread.sym + ! MANIFEST +____________________________________________________________________________ +[ 196] By: nick on 1997/10/31 23:54:01 + Log: Further ANSI changes now builds and passes (most) tests + with gcc -x c++. + Branch: ansiperl + ! INTERN.h embed.h ext/DynaLoader/dl_dlopen.xs + ! ext/Fcntl/Fcntl.xs ext/GDBM_File/GDBM_File.xs ext/IO/IO.xs + ! ext/Opcode/Opcode.xs ext/POSIX/POSIX.xs + ! ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/pair.c + ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h + ! ext/SDBM_File/sdbm/util.c ext/Socket/Socket.xs + ! ext/Thread/Thread.xs ext/attrs/attrs.xs global.sym perl.h + ! perly.c sv.c t/lib/english.t t/op/misc.t thread.h util.c + ! win32/Makefile win32/makedef.pl win32/makefile.mk x2p/a2p.c + ! x2p/a2p.h x2p/a2py.c x2p/hash.c x2p/str.c x2p/util.c + ! x2p/walk.c +____________________________________________________________________________ +[ 195] By: mbeattie on 1997/10/31 18:05:31 + Log: Half way through moving per-thread magicals into per-thread fields + and the associated new OP_SPECIFIC and find_thread_magical stuff. + perl will compile but plenty of the magicals are still broken. + Branch: perl + ! doop.c embed.h ext/Thread/Thread.xs global.sym gv.c hv.c + ! interp.sym mg.c op.c opcode.h opcode.pl perl.c perl.h pp.c + ! pp_ctl.c pp_sys.c proto.h sv.c sv.h taint.c thread.h toke.c + ! util.c +____________________________________________________________________________ +[ 194] By: nick on 1997/10/31 01:43:49 + Log: Convert miniperl sources to ANSI C. Several passes of + GNU C's 'protoize' plus a few hand edits. + Will compile miniperl with gcc -x c++ (i.e. treat .c a C++ files) + Does not link seems gcc's C++ does not define a symbol for + const char foo[] = "...."; + i.e. with empty []. + Branch: ansiperl + ! av.c deb.c doio.c doop.c dump.c gv.c hv.c malloc.c mg.c + ! miniperlmain.c op.c perl.c perl.h perlio.c perly.y pp.c + ! pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c + ! sv.c taint.c toke.c universal.c util.c +____________________________________________________________________________ +[ 193] By: nick on 1997/10/30 03:00:01 + Log: Make the ansi branch + Branch: ansiperl + +> (branch 907 files) +____________________________________________________________________________ +[ 192] By: nick on 1997/10/30 02:48:17 + Log: Oneperl builds with THREADS/THISPTR Borland + Manualy inserted Sarathy's new COND_XXXXX from his mail. + Manual change if Tself -> self as was easier than resolve :-( + Two aTHIS's in op.c + Branch: oneperl + ! embed.h op.c thread.h thread.sym win32/makefile.mk + ! win32/win32thread.h +____________________________________________________________________________ +[ 191] By: nick on 1997/10/30 01:54:50 + Log: Raw resolve of latest sources with oneperl + Branch: oneperl + !> Todo.5.005 ext/Thread/Thread.xs fakethr.h op.c op.h opcode.h + !> opcode.pl perl.c thread.h win32/win32thread.c + !> win32/win32thread.h +____________________________________________________________________________ +[ 190] By: mbeattie on 1997/10/29 14:39:54 + Log: Remove global macro "self". Change thr->Tself to thr->self. + Branch: perl + ! ext/Thread/Thread.xs fakethr.h perl.c thread.h + ! win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 189] By: mbeattie on 1997/10/29 12:49:01 + Log: Add to Todo: compiler with fake SvCUR in comppad_name entries. + Branch: perl + ! Todo.5.005 +____________________________________________________________________________ +[ 188] By: mbeattie on 1997/10/29 12:45:32 + Log: Add pp_lock knowledge to compiler + Branch: perlext + ! Compiler/ccop.c Compiler/ccop.h +____________________________________________________________________________ +[ 187] By: mbeattie on 1997/10/29 12:45:02 + Log: Change peep() to optimise away unneeded rv2av in lval->[] and lval->{} + Branch: perl + ! op.c +____________________________________________________________________________ +[ 186] By: mbeattie on 1997/10/29 12:43:36 + Log: Move compiler OP class information into opcode.pl. + Branch: perl + ! op.h opcode.h opcode.pl +____________________________________________________________________________ +[ 185] By: nick on 1997/10/26 22:52:05 + Log: Split failing test in op/misc.t into op/nothread.t + so all tests can be passed where they apply. + Cleanup other two cases of THREADS/THISPTR. + Conditional compile option for CriticalSection's on Win32 + Branch: oneperl + + t/op/nothread.t + ! sv.h t/op/misc.t win32/Makefile win32/makedef.pl + ! win32/win32thread.h +____________________________________________________________________________ +[ 184] By: nick on 1997/10/26 19:42:00 + Log: USE_THISPTR fixes for CRIPPLED_CC (implied by threads) + Branch: oneperl + ! embed.h global.sym proto.h sv.c sv.h toke.c +____________________________________________________________________________ +[ 183] By: nick on 1997/10/26 18:31:58 + Log: Make USE_THREADS imply CRIPPLED_CC. + This avoids most of the uses of 'Sv' and hence many needs of + dTHR in extension code. + With this change Data::Dumper builds as-is + and Tk only needs four tweaks: + 1. Obscure dump-stack case which really needs dTHR + 2. A curcop in error-message code + 3. Two cases of SAVETMPS + 4. A curcop == &compiling which is probably not required. + IMHO the SAVETMPS case is only one which merits further automation. + Branch: oneperl + ! embed.h global.sym perl.h sv.c win32/Makefile win32/makedef.pl +____________________________________________________________________________ +[ 182] By: nick on 1997/10/26 16:31:58 + Log: Change dSP to imply dTHR for extension source compatibility + introduce djSP (Declare Just SP) for use in perl sources + and thread-aware extensions. Use latter. + Branch: oneperl + ! XSUB.h doio.c doop.c ext/Thread/Thread.xs gv.c mg.c perl.c + ! pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c sv.c +____________________________________________________________________________ +[ 181] By: nick on 1997/10/26 00:39:57 + Log: More tests + Branch: oneperl + ! t/lib/thread.t +____________________________________________________________________________ +[ 180] By: nick on 1997/10/25 22:18:27 + Log: Use return of THREAD_CREATE() - add basic thread test + Branch: oneperl + + t/lib/thread.t + ! ext/Thread/Thread.xs +____________________________________________________________________________ +[ 179] By: nick on 1997/10/25 21:25:23 + Log: Builds with no thread/this + Branch: oneperl + ! ext/Thread/Thread.xs t/lib/english.t win32/makedef.pl + ! win32/win32thread.c +____________________________________________________________________________ +[ 178] By: nick on 1997/10/25 18:28:03 + Log: Cleanup dead #ifdef branch introduced by scruffy merging. + Branch: oneperl + ! perl.c +____________________________________________________________________________ +[ 177] By: nick on 1997/10/25 18:11:33 + Log: Basic integrate of oneperl with threads, passes + tests THISPTR+THREADs - win32/win32thread.* needed + changes (where did they come from)? + Branch: oneperl + ! embed.h ext/Thread/Thread.xs perl.h thread.h win32/Makefile + ! win32/makedef.pl win32/win32thread.c win32/win32thread.h +____________________________________________________________________________ +[ 176] By: nick on 1997/10/25 17:05:52 + Log: Onepel builds THISPTR no threads + Branch: oneperl + ! ext/Thread/Thread.xs thread.h win32/makedef.pl +____________________________________________________________________________ +[ 175] By: nick on 1997/10/25 16:40:10 + Log: Integrate oneperl with new style JOIN etc. macros + Branch: oneperl + +> win32/win32thread.c win32/win32thread.h + !> Todo.5.005 ext/POSIX/POSIX.xs ext/Thread/Thread.xs fakethr.h + !> global.sym gv.c hv.c mg.c op.c opcode.h opcode.pl perl.c + !> perl.h pp.c pp_hot.c sv.h thread.h vms/descrip.mms + !> vms/gen_shrfls.pl vms/vms.c vms/vmsish.h win32/Makefile + !> win32/makefile.mk +____________________________________________________________________________ +[ 174] By: mbeattie on 1997/10/24 17:14:00 + Log: Remove xcv_condp CV field which is no longer used. + Branch: perl + ! sv.h +____________________________________________________________________________ +[ 173] By: mbeattie on 1997/10/24 14:36:09 + Log: Patches for VMS [Dan Sugalski] + Branch: bugs + + vms2 + Branch: perl + ! ext/POSIX/POSIX.xs vms/descrip.mms vms/gen_shrfls.pl vms/vms.c + ! vms/vmsish.h +____________________________________________________________________________ +[ 172] By: mbeattie on 1997/10/24 13:50:59 + Log: Improve internal threading API. Introduce win32/win32thread.[ch] + to use new API and patch win32 makefile stuff a little. + Branch: perl + + win32/win32thread.c win32/win32thread.h + ! Todo.5.005 ext/Thread/Thread.xs fakethr.h global.sym gv.c hv.c + ! perl.c perl.h thread.h win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 171] By: mbeattie on 1997/10/23 14:00:27 + Log: Fix pp_hot.c:get_db_sub core dump when perl debugger used. + + Jobs fixed ... + + get_db_sub fixed on 1997/10/23 by mbeattie@squash + + Subject: [perl5.004_53] Debugger crash (patch) + Date: Thu, 16 Oct 1997 22:03:09 -0400 + From: Owen Taylor + Branch: bugs + + get_db_sub + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 170] By: mbeattie on 1997/10/23 09:22:40 + Log: Fix refcounts for lock/magic_mutexfree. Make OP_LOCK auto-ref + its argument using ck_rfun as OP_DEFINED. Make pp_lock return + a ref to its argument for AV, HV, CV. + Branch: perl + ! mg.c op.c opcode.h opcode.pl pp.c pp_hot.c +____________________________________________________________________________ +[ 169] By: gsar on 1997/10/21 03:49:25 + Log: With these fixes, oneperl builds THISPTR && THREADS under both win32 compilers: + - Fixup static functions that were missing aTHIS. + - s/extern/EXT/ in dTHR macro, or Borland CC croaks. + - Removed static functions from global.sym. + - Typo in perl.h. + - Additions to makefile.mk. + Branch: oneperl + ! embed.h embed.pl global.sym op.c perl.h pp_ctl.c toke.c + ! win32/makefile.mk +____________________________________________________________________________ +[ 168] By: nick on 1997/10/20 02:47:18 + Log: Passes expected tests with -DUSE_THREADS with/without -DUSE_THISPTR + Branch: oneperl + ! embed.h ext/Thread/Thread.xs mg.c pp.c pp_hot.c proto.h + ! scope.h thread.h +____________________________________________________________________________ +[ 167] By: nick on 1997/10/20 01:03:00 + Log: Add missing aTHIS in cast + Branch: oneperl + ! win32/dl_win32.xs +____________________________________________________________________________ +[ 166] By: nick on 1997/10/20 00:44:42 + Log: Builds and passes test with -DUSE_THISPTR + Branch: oneperl + ! ext/Thread/Thread.xs win32/Makefile win32/makedef.pl + ! win32/perllib.c +____________________________________________________________________________ +[ 165] By: nick on 1997/10/19 21:45:36 + Log: Oneperl runs miniperl with THISPTR (Win32 threading patch included) + Branch: oneperl + ! embed.h ext/Thread/Thread.xs global.sym interp.sym perl.c + ! perl.h t/TEST thread.h win32/Makefile win32/makedef.pl + ! win32/makefile.mk win32/perllib.c +____________________________________________________________________________ +[ 164] By: nick on 1997/10/19 20:09:13 + Log: oneperl compiles (but fails) with -DUSE_THISPTR + Branch: oneperl + ! av.c embed.h mg.c perl.c perl.h pp.c pp_ctl.c pp_hot.c + ! pp_sys.c proto.h regexec.c sv.c thread.h thread.sym util.c + ! win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 163] By: nick on 1997/10/19 16:46:09 + Log: Builds on NT4 without THISPTR or THREADS, passes all tests + Branch: oneperl + ! embed.h perl.h thread.h vars.h +____________________________________________________________________________ +[ 162] By: nick on 1997/10/19 14:42:16 + Log: Dubious merge of oneperl's variable and struct thread + Branch: oneperl + !> perl.h thread.h +____________________________________________________________________________ +[ 161] By: nick on 1997/10/18 18:05:13 + Log: integrate all but perl.h/thread.h + Branch: oneperl + +> Todo.5.005 perlio.sym + !> (integrate 98 files) +____________________________________________________________________________ +[ 160] By: nick on 1997/10/18 03:49:27 + Log: Integrate rest of sub-dirs into oneperl + Branch: oneperl + +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README + +> ext/Thread/Thread.pm ext/Thread/Thread.xs + +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm + +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t + +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t + +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t + +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t + +> ext/Thread/unsync3.t ext/Thread/unsync4.t hints/newsos4.sh + +> hints/os390.sh + - ext/util/extliblist + !> (integrate 425 files) +____________________________________________________________________________ +[ 159] By: nick on 1997/10/18 03:20:11 + Log: Integrate (accept) t and win32 into oneperl + Branch: oneperl + +> t/lib/dosglob.t win32/bin/pl2bat.pl win32/bin/runperl.pl + +> win32/bin/search.pl win32/bin/webget.pl win32/config.bc + +> win32/config.vc win32/config_H.bc win32/config_H.vc + +> win32/makefile.mk + !> (integrate 188 files) +____________________________________________________________________________ +[ 158] By: nick on 1997/10/18 03:12:59 + Log: Integrate lib/... into oneperl + Branch: oneperl + +> lib/File/DosGlob.pm lib/base.pm lib/chat2.pl + !> (integrate 138 files) +____________________________________________________________________________ +[ 157] By: nick on 1997/10/18 02:55:53 + Log: Make lib/Bundle/CPAN.pm text in oneperl too. + Branch: oneperl + ! lib/Bundle/CPAN.pm +____________________________________________________________________________ +[ 156] By: nick on 1997/10/18 02:52:44 + Log: Make lib/Bundle/CPAN.pm a text file + Branch: perl + ! lib/Bundle/CPAN.pm +____________________________________________________________________________ +[ 155] By: nick on 1997/10/18 02:33:02 + Log: Some weirdness in the intgrate process + Branch: oneperl + - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat + - win32/bin/webget.bat win32/config.H win32/config.w32 +____________________________________________________________________________ +[ 153] By: nick on 1997/10/18 02:29:16 + Log: Let us try all the pure integrate stuff + Branch: oneperl + !> (integrate 647 files) +____________________________________________________________________________ +[ 152] By: nick on 1997/10/18 02:13:35 + Log: Get more sub directories out of the way. + Branch: oneperl + !> (integrate 92 files) +____________________________________________________________________________ +[ 151] By: nick on 1997/10/18 02:05:41 + Log: Integrate hints + Branch: oneperl + !> (integrate 68 files) +____________________________________________________________________________ +[ 150] By: nick on 1997/10/18 01:57:20 + Log: Try reopening some non-contravertial files + Branch: oneperl + !> x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h + !> x2p/a2p.pod x2p/a2p.y x2p/a2py.c x2p/cflags.SH + !> x2p/find2perl.PL x2p/hash.c x2p/hash.h x2p/proto.h x2p/s2p.PL + !> x2p/str.c x2p/str.h x2p/util.c x2p/util.h x2p/walk.c +____________________________________________________________________________ +[ 144] By: gsar on 1997/10/16 22:26:07 + Log: Merge changes to Thread and add makefile fixups to accomodate Thread + build. Once again, builds and runs all Thread tests using either + compiler. + Branch: win32/perl + ! embed.h ext/Thread/Thread.xs interp.sym perl.c win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 143] By: gsar on 1997/10/16 20:45:58 + Log: A quick merge of latest mainline. + Branch: win32/perl + +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README + +> ext/Thread/Thread.pm ext/Thread/Thread.xs + +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm + +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t + +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t + +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t + +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t + +> ext/Thread/unsync3.t ext/Thread/unsync4.t hints/os390.sh + +> lib/base.pm t/lib/dosglob.t + - ext/util/extliblist + !> (integrate 134 files) + +---------------- +Version 5.004_53 +---------------- + +____________________________________________________________________________ +[ 142] By: mbeattie on 1997/10/16 16:52:55 + Log: Add newly moved perl/ext/Thread/... files to MANIFEST. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 141] By: mbeattie on 1997/10/16 16:42:13 + Log: Move perlext/Thread into perl/ext/Thread. + Branch: perl + +> ext/Thread/Makefile.PL ext/Thread/Notes ext/Thread/README + +> ext/Thread/Thread.pm ext/Thread/Thread.xs + +> ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm + +> ext/Thread/create.t ext/Thread/io.t ext/Thread/join.t + +> ext/Thread/join2.t ext/Thread/list.t ext/Thread/lock.t + +> ext/Thread/queue.t ext/Thread/sync.t ext/Thread/sync2.t + +> ext/Thread/typemap ext/Thread/unsync.t ext/Thread/unsync2.t + +> ext/Thread/unsync3.t ext/Thread/unsync4.t + ! Configure + Branch: perlext + - Thread/Makefile.PL Thread/Notes Thread/README Thread/Thread.pm + - Thread/Thread.xs Thread/Thread/Queue.pm + - Thread/Thread/Semaphore.pm Thread/create.t Thread/io.t + - Thread/join.t Thread/join2.t Thread/list.t Thread/lock.t + - Thread/queue.t Thread/sync.t Thread/sync2.t Thread/typemap + - Thread/unsync.t Thread/unsync2.t Thread/unsync3.t + - Thread/unsync4.t +____________________________________________________________________________ +[ 140] By: mbeattie on 1997/10/16 16:26:53 + Log: Correct threads_mutex locking in main thread destruction. + Add per-interp thrsv to hold SV struct thread for main thread. + Move Thread.xs MUTEX_DESTROY from end of threadstart to remove_thread. + Add Thread/list.t test of Thread->list method. + Let Thread::Semaphore methods up and down take an extra argument. + Branch: perl + ! embed.h interp.sym perl.c perl.h thread.h + Branch: perlext + + Thread/list.t + ! Thread/Thread.xs Thread/Thread/Semaphore.pm +____________________________________________________________________________ +[ 139] By: mbeattie on 1997/10/16 14:01:11 + Log: Fix up merge with 5.004_04. + Branch: perl + ! op.c perl.c t/lib/dosglob.t +____________________________________________________________________________ +[ 138] By: TimBunce on 1997/10/16 12:58:22 + Log: Fix-up PerForce type for t/lib/dosglob.t from text to xtext + Branch: maint-5.004/perl + ! t/lib/dosglob.t +____________________________________________________________________________ +[ 137] By: mbeattie on 1997/10/16 11:09:25 + Log: Merge maint-5.004 branch (5.004_04) with mainline. + Branch: perl + +> hints/os390.sh lib/base.pm t/lib/dosglob.t + - ext/util/extliblist + !> (integrate 132 files) +____________________________________________________________________________ +[ 135] By: gsar on 1997/10/15 21:46:05 + Log: Win32 changes over 5.004_52: + - rearranged MUTEX_LOCK()s in perl_destroy so that we don't call it + on an already locked mutex. + - other minor tweaks. + Now builds and runs win32-version of Thread_52, passing all tests. + Branch: win32/perl + ! perl.c proto.h thread.h +____________________________________________________________________________ +[ 134] By: gsar on 1997/10/15 18:19:31 + Log: fixup makefile.mk conflict. + Branch: win32/perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 133] By: gsar on 1997/10/15 18:02:46 + Log: Integrated latest changes from mainline into win32. + Branch: win32/perl + +> fakethr.h + !> MANIFEST Porting/makerel Porting/patchls README.threads + !> Todo.5.005 perl.c pp_hot.c thread.h util.c win32/config.bc + !> win32/config.vc win32/config_H.bc win32/config_H.vc + !> win32/makefile.mk + +---------------- +Version 5.004_52 +---------------- + +____________________________________________________________________________ +[ 132] By: mbeattie on 1997/10/15 17:02:38 + Log: Remove out-of-date test Thread/cond.t. + Branch: perlext + - Thread/cond.t +____________________________________________________________________________ +[ 131] By: mbeattie on 1997/10/15 16:57:45 + Log: Finish thread state machine: fixes global destruction of threads, + detaching, joining etc. Alter FAKE_THREADS-specific fields to use + new HAVE_THREAD_INTERN stuff. Updates docs. Various fixes to + Thread.xs. + Branch: perl + ! MANIFEST README.threads Todo.5.005 perl.c util.c + Branch: perlext + ! Thread/Thread.xs Thread/queue.t +____________________________________________________________________________ +[ 130] By: mbeattie on 1997/10/15 16:55:10 + Log: Add HAVE_THREAD_INTERN for platform-dependent struct thread additions. + Fix ThrSETSTATE not to lock t->mutex itself. + Branch: perl + ! fakethr.h thread.h +____________________________________________________________________________ +[ 129] By: mbeattie on 1997/10/15 16:53:35 + Log: Remove stale code from pp_entersub which breaks sub ownership locks. + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 128] By: TimBunce on 1997/10/15 15:55:26 + Log: Maintenance 5.004_04 changes + Branch: maint-5.004/perl + + hints/os390.sh lib/base.pm t/lib/dosglob.t + - ext/util/extliblist + ! Changes Configure INSTALL MANIFEST Makefile.SH Porting/makerel + ! Porting/patchls Porting/pumpkin.pod README.vms av.c configpm + ! doop.c eg/sysvipc/ipcsem emacs/cperl-mode.el embed.h + ! ext/DynaLoader/DynaLoader.pm ext/IO/lib/IO/Socket.pm + ! ext/util/make_ext global.sym gv.c hints/bsdos.sh + ! hints/dec_osf.sh hints/dynixptx.sh hints/irix_6.sh + ! hints/linux.sh hints/machten.sh hints/os2.sh hints/qnx.sh hv.c + ! installperl lib/AutoLoader.pm lib/CPAN.pm + ! lib/CPAN/FirstTime.pm lib/Carp.pm lib/Cwd.pm lib/English.pm + ! lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/xsubpp + ! lib/File/DosGlob.pm lib/File/Find.pm lib/FileHandle.pm + ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/Math/Complex.pm + ! lib/Sys/Hostname.pm lib/Sys/Syslog.pm lib/Test/Harness.pm + ! lib/Time/Local.pm lib/autouse.pm lib/blib.pm + ! lib/diagnostics.pm lib/getopt.pl lib/perl5db.pl lib/vars.pm + ! makedepend.SH malloc.c mg.c miniperlmain.c myconfig op.c + ! opcode.h os2/Changes os2/OS2/REXX/Makefile.PL + ! os2/OS2/REXX/REXX.pm os2/os2.c patchlevel.h perl.c perl.h + ! perly.c perly.fixer perly.y pod/perl.pod pod/perlapio.pod + ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + ! pod/perlguts.pod pod/perlipc.pod pod/perlop.pod + ! pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod + ! pod/perltrap.pod pod/perlvar.pod pod/perlxs.pod pp.c pp_ctl.c + ! pp_hot.c pp_sys.c proto.h regcomp.c regexec.c scope.c sv.c + ! t/TEST t/comp/proto.t t/lib/complex.t t/lib/io_sock.t + ! t/lib/io_udp.t t/op/glob.t t/op/method.t t/op/misc.t + ! t/op/ref.t t/op/runlevel.t t/op/split.t t/op/sprintf.t + ! t/op/subst.t t/op/taint.t t/pragma/locale.t taint.c toke.c + ! unixish.h util.c utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL + ! utils/perldoc.PL vms/perly_c.vms vms/vms.c vms/vmsish.h + ! win32/Makefile win32/config_H.bc win32/config_H.vc + ! win32/makefile.mk win32/pod.mak win32/win32.c win32/win32io.c + ! win32/win32sck.c x2p/Makefile.SH x2p/util.c +____________________________________________________________________________ +[ 127] By: mbeattie on 1997/10/15 10:00:18 + Log: Added fakethr.h. + Branch: perl + + fakethr.h +____________________________________________________________________________ +[ 126] By: mbeattie on 1997/10/15 09:50:57 + Log: pthread_condattr_init in thread.h for OLD_PTHREADS_API. + Branch: perl + ! thread.h +____________________________________________________________________________ +[ 125] By: mbeattie on 1997/10/15 09:09:24 + Log: Started rewriting thread state machine. + Branch: perl + ! perl.c thread.h + Branch: perlext + ! Thread/Thread.xs +____________________________________________________________________________ +[ 124] By: gsar on 1997/10/14 00:23:15 + Log: Remove spurious extra MUTEX_LOCK in pp_entersub(). Now builds and passes + tests in win32 version of latest perlext/Thread. + Branch: win32/perl + ! pp_hot.c +____________________________________________________________________________ +[ 123] By: gsar on 1997/10/13 23:18:38 + Log: Initial merge of win32 threads patch. + Branch: win32/perl + ! embed.h global.sym interp.sym perl.c perl.h pp_hot.c thread.h + ! win32/Makefile win32/makedef.pl win32/makefile.mk + ! win32/perllib.c win32/pod.mak win32/win32.h +____________________________________________________________________________ +[ 122] By: gsar on 1997/10/10 20:58:40 + Log: Integrated changes on mainline into the win32 branch. Had to set + P4USER=mbeattie for the resolve step (due to the presence of newly + branched files that had not been submitted?) + Branch: win32/perl + +> Porting/makerel Porting/patchls README.threads Todo.5.005 + +> ext/attrs/Makefile.PL ext/attrs/attrs.pm ext/attrs/attrs.xs + +> hints/newsos4.sh lib/File/DosGlob.pm lib/chat2.pl perlio.sym + +> win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl + +> win32/bin/webget.pl win32/config.bc win32/config.vc + +> win32/config_H.bc win32/config_H.vc win32/makefile.mk + - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat + - win32/bin/webget.bat win32/config.H win32/config.w32 + ! thread.h + !> (integrate 858 files) +____________________________________________________________________________ +[ 121] By: mbeattie on 1997/10/10 17:23:41 + Log: Tweak a few Thread tests. + Branch: perlext + + Thread/join2.t + ! Thread/io.t Thread/sync2.t +____________________________________________________________________________ +[ 120] By: mbeattie on 1997/10/10 17:22:46 + Log: Rewrite thread destruction system using linked list of threads. + Still not completely done. Add methods self, equal, flags, list + to Thread.xs. Add Thread_MAGIC_SIGNATURE check to typemap. + Branch: perl + ! perl.c perl.h thread.h + Branch: perlext + ! Thread/Thread.xs Thread/typemap +____________________________________________________________________________ +[ 119] By: mbeattie on 1997/10/10 17:19:55 + Log: Fix up locking/synchronisation for pp_entersub. + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 118] By: mbeattie on 1997/10/10 09:55:32 + Log: Put back entries in MANIFEST for the four now-returned win32/* files + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 117] By: mbeattie on 1997/10/10 08:12:23 + Log: Took out mystack_foo for good, fixed up interp.sym and win32/makedef.pl + Branch: perl + ! Todo.5.005 embed.h interp.sym perl.h win32/makedef.pl +____________________________________________________________________________ +[ 116] By: mbeattie on 1997/10/08 15:41:08 + Log: Add missing sig_pipe definition to Thread.xs. + Branch: perlext + ! Thread/Thread.xs +____________________________________________________________________________ +[ 115] By: mbeattie on 1997/10/08 15:40:46 + Log: Fix up 5.004_03 merge: remove missing win32 files from MANIFEST, + add missing dTHR; to new function unwind_handler_stack() in mg.c + and bump patchlevel.h to 5.004_52. + Branch: perl + ! MANIFEST mg.c patchlevel.h +____________________________________________________________________________ +[ 114] By: mbeattie on 1997/10/08 10:19:27 + Log: Merge maint-5.004 branch (5.004_03) with mainline. + MANIFEST is out of sync. + Branch: perl + +> win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl + +> win32/bin/webget.pl + - win32/bin/pl2bat.bat win32/bin/search.bat win32/bin/test.bat + - win32/bin/webget.bat + !> (integrate 168 files) +____________________________________________________________________________ +[ 113] By: mbeattie on 1997/10/05 17:52:49 + Log: Move init of global mutexes/cond vars earlier. + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 112] By: nick on 1997/10/04 15:25:28 + Log: Add perl.sym to MANIFEST + Branch: oneperl + ! MANIFEST +____________________________________________________________________________ +[ 111] By: nick on 1997/10/04 15:23:37 + Log: Missing file + Branch: oneperl + + perl.sym +____________________________________________________________________________ +[ 110] By: nick on 1997/10/04 13:04:26 + Log: Now builds the extensions as well + Passes all tests + Branch: oneperl + ! XSUB.h embed.pl ext/DynaLoader/dlutils.c ext/Opcode/Opcode.xs + ! mg.c op.c perl.c pp_ctl.c pp_hot.c pp_sys.c proto.h sv.c + ! toke.c util.c writemain.SH +____________________________________________________________________________ +[ 109] By: nick on 1997/10/04 12:02:14 + Log: Odd checkin issue + Branch: oneperl + ! dump.c global.sym gv.c hv.c malloc.c mg.c op.c opcode.h perl.c + ! perly.c perly.c.diff perly.h perly.y pp.c pp_hot.c pp_sys.c + ! proto.h scope.c sv.c toke.c universal.c util.c vms/perly_c.vms + ! vms/perly_h.vms writemain.SH +____________________________________________________________________________ +[ 108] By: nick on 1997/10/04 11:12:52 + Log: Added lots of (missing) prototypes (ckprotos is util to check) + Fixed missing aTHIS flagged by above. + -DUSE_THISPTR passes minitest! + Branch: oneperl + + ckprotos + ! dump.c global.sym gv.c hv.c malloc.c mg.c op.c opcode.h perl.c + ! perly.c perly.c.diff perly.h perly.y pp.c pp_hot.c pp_sys.c + ! proto.h scope.c sv.c toke.c universal.c util.c vms/perly_c.vms + ! vms/perly_h.vms +____________________________________________________________________________ +[ 107] By: nick on 1997/10/03 22:36:52 + Log: .y muddle fixup - will get this sorted oneday ... + Branch: oneperl + ! miniperlmain.c perly.c perly.c.diff perly.h vms/perly_c.vms + ! vms/perly_h.vms +____________________________________________________________________________ +[ 106] By: mbeattie on 1997/10/03 17:12:33 + Log: Remove last traces of "tokenbuf as temp buffer" and removed it + from struct thread. Added missing thr->Tfoo defines for statbuf + and timesbuf and removed unused Tbuf field. + Branch: perl + ! doio.c mg.c perl.c pp_sys.c sv.c thread.h +____________________________________________________________________________ +[ 105] By: nick on 1997/10/03 15:56:50 + Log: dTHIS -> hasTHIS, dTHR -> dTHR; builds without THISPTR with/without USE_THREADS + Branch: oneperl + ! XSUB.h av.c deb.c doio.c doop.c dump.c embed.pl global.sym + ! gv.c hv.c mg.c op.c perl.c perl.h perlio.c perly.c pp.c pp.h + ! pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c + ! sv.c taint.c thread.h toke.c universal.c util.c +____________________________________________________________________________ +[ 104] By: mbeattie on 1997/10/03 15:23:25 + Log: Back out sv_bless3 change which made pp_bless zap '~'-magic. + Branch: perl + ! global.sym pp.c proto.h sv.c +____________________________________________________________________________ +[ 103] By: mbeattie on 1997/10/03 15:17:39 + Log: Fixed sv_mutex locking for new_SV, del_SV and nice_chunks. + Branch: perl + ! av.c hv.c perl.h sv.c +____________________________________________________________________________ +[ 102] By: mbeattie on 1997/10/03 11:53:51 + Log: Reliable thread signal handling. + Branch: perl + ! global.sym mg.c perl.c perl.h + Branch: perlext + ! Thread/Thread.xs +____________________________________________________________________________ +[ 101] By: nick on 1997/10/02 20:43:17 + Log: Cleanup perly.y stuff + Branch: oneperl + ! embed.h perly.c perly.c.diff vms/perly_c.vms vms/perly_h.vms +____________________________________________________________________________ +[ 100] By: nick on 1997/10/02 18:54:08 + Log: Compiles with less invasive aTHIS adding + Branch: oneperl + + nothis.sym + ! MANIFEST XSUB.h av.c cop.h deb.c doio.c doop.c dump.c embed.h + ! embed.pl global.sym gv.c gv.h handy.h hv.c hv.h mg.c op.c op.h + ! opcode.h perl.c perl.h perlio.c perlsdio.h perly.c + ! perly.c.diff perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c + ! proto.h regcomp.c regcomp.h regexec.c run.c scope.c scope.h + ! sv.c sv.h t/op/sort.t taint.c thread.h toke.c universal.c + ! util.c vars.h + +---------------- +Version 5.004_51 +---------------- + +____________________________________________________________________________ +[ 99] By: mbeattie on 1997/10/02 17:23:48 + Log: Added Thread/queue.t. + Branch: perlext + + Thread/queue.t +____________________________________________________________________________ +[ 98] By: mbeattie on 1997/10/02 17:19:44 + Log: Bumped patchlevel to 51. Updated Todo.5.005. + Branch: perl + ! Todo.5.005 patchlevel.h +____________________________________________________________________________ +[ 97] By: mbeattie on 1997/10/02 17:07:47 + Log: Update README.threads amd Thread/README + Branch: perl + ! README.threads + Branch: perlext + ! Thread/README +____________________________________________________________________________ +[ 96] By: mbeattie on 1997/10/02 16:58:47 + Log: Configure -Dusethreads hints for dec_osf and solaris_2 and + fix sv_bless3 prototype. + Branch: perl + ! hints/dec_osf.sh hints/solaris_2.sh sv.c +____________________________________________________________________________ +[ 95] By: mbeattie on 1997/10/02 16:50:21 + Log: Fixed broken typemap for Thread. + Branch: perlext + ! Thread/typemap +____________________________________________________________________________ +[ 94] By: mbeattie on 1997/10/02 16:34:03 + Log: Fix pod text in Lint.pm for private-names option. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 93] By: mbeattie on 1997/10/02 13:44:46 + Log: Add Todo.5.005 to MANIFEST and submit remade embed.h. + Branch: perl + ! MANIFEST embed.h +____________________________________________________________________________ +[ 92] By: mbeattie on 1997/10/02 13:27:10 + Log: Add Todo.5.005 + Branch: perl + + Todo.5.005 +____________________________________________________________________________ +[ 91] By: nick on 1997/10/01 20:23:38 + Log: Raw _T# trial + Branch: oneperl + ! embed.h embed.pl proto.h sv.c +____________________________________________________________________________ +[ 90] By: nick on 1997/10/01 18:22:03 + Log: THIS + new sort stuff + Branch: oneperl + ! miniperlmain.c perl.c pp_ctl.c proto.h util.c +____________________________________________________________________________ +[ 89] By: nick on 1997/10/01 18:03:05 + Log: qsort cleanup - now tailored to perl's use and 'this' aware. + Branch: oneperl + ! pp_ctl.c proto.h util.c +____________________________________________________________________________ +[ 88] By: mbeattie on 1997/10/01 17:04:12 + Log: Start of Configure support for -Dusethreads plus associated + Linux hints. + Branch: perl + ! Configure hints/linux.sh +____________________________________________________________________________ +[ 87] By: mbeattie on 1997/10/01 17:03:34 + Log: Move runops_foo prototypes from proto.h to early in perl.h. + Branch: perl + ! perl.h proto.h +____________________________________________________________________________ +[ 86] By: nick on 1997/09/30 19:15:21 + Log: Debug hackery to thread.h - temporary + Quick-fix qsort() replacement - more to come. + Branch: oneperl + ! thread.h util.c +____________________________________________________________________________ +[ 85] By: mbeattie on 1997/09/30 15:50:27 + Log: Added Lint option regexp-variables. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 84] By: mbeattie on 1997/09/30 15:11:07 + Log: Merge maint-5.004 branch (5.004_01) with mainline. + Branch: perl + +> Porting/makerel Porting/patchls hints/newsos4.sh + +> lib/File/DosGlob.pm lib/chat2.pl perlio.sym win32/config.bc + +> win32/config.vc win32/config_H.bc win32/config_H.vc + +> win32/makefile.mk + - win32/config.H win32/config.w32 + !> (integrate 109 files) +____________________________________________________________________________ +[ 83] By: TimBunce on 1997/09/30 14:27:09 + Log: Maintenance 5.004_03 changes (addendum) + Branch: maint-5.004/perl + - win32/bin/search.bat +____________________________________________________________________________ +[ 82] By: TimBunce on 1997/09/30 14:11:29 + Log: Maintenance 5.004_03 changes + Branch: maint-5.004/perl + + win32/bin/pl2bat.pl win32/bin/runperl.pl win32/bin/search.pl + + win32/bin/webget.pl + - win32/bin/pl2bat.bat win32/bin/runperl.bat win32/bin/test.bat + - win32/bin/webget.bat + ! Changes Configure MANIFEST Makefile.SH Porting/makerel + ! ext/DynaLoader/DynaLoader.pm hints/hpux.sh hints/linux.sh + ! hints/sco.sh hints/sunos_4_1.sh installhtml lib/CPAN.pm + ! lib/ExtUtils/MM_Unix.pm lib/FileCache.pm lib/Math/Complex.pm + ! lib/Math/Trig.pm lib/blib.pm os2/diff.configure patchlevel.h + ! perl.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + ! pod/perlop.pod pod/perlre.pod pod/perlrun.pod pod/pod2man.PL + ! pp_ctl.c pp_sys.c t/lib/complex.t t/pragma/locale.t toke.c + ! utils/perlbug.PL win32/Makefile win32/makefile.mk + ! win32/win32.c +____________________________________________________________________________ +[ 81] By: TimBunce on 1997/09/30 13:17:27 + Log: Maintenance 5.004_02 changes + Branch: maint-5.004/perl + + win32/bin/runperl.bat + ! Changes Configure INSTALL MANIFEST Makefile.SH Porting/patchls + ! README.os2 README.win32 Todo XSUB.h av.c configpm doio.c + ! dosish.h embed.h ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + ! ext/DB_File/typemap ext/GDBM_File/typemap ext/IO/IO.xs + ! ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm + ! ext/IO/lib/IO/Socket.pm ext/NDBM_File/typemap + ! ext/ODBM_File/ODBM_File.xs ext/POSIX/POSIX.xs + ! ext/SDBM_File/typemap global.sym gv.c hints/cxux.sh + ! hints/os2.sh hints/sunos_4_1.sh hints/svr4.sh installhtml + ! lib/Bundle/CPAN.pm lib/CPAN.pm lib/CPAN/FirstTime.pm + ! lib/CPAN/Nox.pm lib/Carp.pm lib/Class/Struct.pm + ! lib/Exporter.pm lib/ExtUtils/Command.pm lib/ExtUtils/Embed.pm + ! lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + ! lib/ExtUtils/xsubpp lib/File/Compare.pm lib/File/Copy.pm + ! lib/File/Find.pm lib/File/Path.pm lib/FileHandle.pm + ! lib/I18N/Collate.pm lib/IPC/Open3.pm lib/Net/hostent.pm + ! lib/Pod/Html.pm lib/Shell.pm lib/Sys/Hostname.pm + ! lib/Sys/Syslog.pm lib/Term/ReadLine.pm lib/Time/Local.pm + ! lib/UNIVERSAL.pm lib/dumpvar.pl lib/ftp.pl lib/perl5db.pl + ! malloc.c mg.c op.c opcode.pl os2/Changes os2/Makefile.SHs + ! os2/diff.configure os2/os2.c os2/os2ish.h patchlevel.h perl.c + ! perl.h pod/perlapio.pod pod/perlbook.pod pod/perldebug.pod + ! pod/perldelta.pod pod/perldiag.pod pod/perlembed.pod + ! pod/perlfunc.pod pod/perlguts.pod pod/perlop.pod + ! pod/perlre.pod pod/perlrun.pod pod/perltoc.pod + ! pod/perltrap.pod pod/perlvar.pod pod/perlxstut.pod + ! pod/pod2man.PL pod/splitpod pp.c pp_ctl.c pp_hot.c pp_sys.c + ! proto.h regcomp.c regexec.c scope.c sv.c t/TEST t/base/lex.t + ! t/comp/cmdopt.t t/comp/term.t t/lib/db-btree.t t/lib/db-hash.t + ! t/lib/db-recno.t t/lib/filehand.t t/lib/gdbm.t t/lib/ndbm.t + ! t/lib/odbm.t t/lib/sdbm.t t/op/local.t t/op/magic.t + ! t/op/pack.t t/op/re_tests t/op/ref.t t/op/regexp.t t/op/stat.t + ! t/op/substr.t t/op/universal.t toke.c universal.c util.c + ! utils/Makefile utils/h2ph.PL utils/perlbug.PL utils/perldoc.PL + ! vms/config.vms vms/descrip.mms vms/ext/filespec.t + ! vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c + ! vms/vmsish.h win32/Makefile win32/bin/pl2bat.bat + ! win32/config.bc win32/config.vc win32/config_H.bc + ! win32/config_H.vc win32/config_h.PL win32/makedef.pl + ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32io.c win32/win32io.h win32/win32iop.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 80] By: nick on 1997/09/29 20:31:43 + Log: Add some prototypes in attempt to flush out errors + Tidy up vars.h usage. + Branch: oneperl + ! av.c embed.h hv.c opcode.h perl.c perl.h perlio.c pp_sys.c + ! proto.h util.c vars.h +____________________________________________________________________________ +[ 79] By: nick on 1997/09/29 17:12:07 + Log: Builds and passes tests without THISPTR + Branch: oneperl + ! MANIFEST global.sym perl.c perl.h vars.h +____________________________________________________________________________ +[ 78] By: mbeattie on 1997/09/29 16:57:23 + Log: Re-introduce the changes from change 68 (runops becomes a + function pointer and sv_bless3 for '~'-magic) which got lost + during the preparation for the maint-merge. + Branch: perl + ! global.sym perl.h pp.c proto.h run.c sv.c +____________________________________________________________________________ +[ 77] By: mbeattie on 1997/09/29 16:44:16 + Log: Start merge with maint-5.004 branch by creating an ancestral + branch point via a fake resolution with the maint-merge branch. + See Perforce Tech Note 9 for details. + Branch: perl + !> (integrate 864 files) +____________________________________________________________________________ +[ 76] By: nick on 1997/09/28 19:04:42 + Log: Code with this pointer compiles (but core dumps) + Branch: oneperl + ! EXTERN.h INTERN.h XSUB.h av.c av.h cop.h cv.h deb.c doio.c + ! doop.c dosish.h dump.c form.h gv.c gv.h handy.h hv.c hv.h + ! keywords.h mg.c mg.h miniperlmain.c nostdio.h op.c op.h + ! opcode.h patchlevel.h perl.c perl.h perlio.c perlio.h + ! perlsdio.h perlsfio.h perly.c perly.c.diff perly.h perly.y + ! pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c + ! regcomp.h regexec.c regexp.h run.c scope.c scope.h sv.c sv.h + ! taint.c thread.h toke.c universal.c unixish.h util.c util.h + ! vars.h +____________________________________________________________________________ +[ 75] By: nick on 1997/09/28 15:45:35 + Log: Quasi sensible starting point for aTHIS addition. + Branch: oneperl + ! perl.c perl.h pp_ctl.c sv.c thread.h toke.c util.c +____________________________________________________________________________ +[ 74] By: nick on 1997/09/28 11:23:32 + Log: Ooops - unwind perly.* stuff for now + Branch: oneperl + ! perly.c perly.h perly.y vms/perly_c.vms vms/perly_h.vms +____________________________________________________________________________ +[ 73] By: nick on 1997/09/28 11:17:23 + Log: Builds and passes all tests again + Branch: oneperl + ! embed.pl ext/DB_File/DB_File.xs gv.c perl.c perl.h perly.y + ! pp.h proto.h thread.sym vms/perly_c.vms vms/perly_h.vms +____________________________________________________________________________ +[ 72] By: nick on 1997/09/28 10:47:01 + Log: Save "important things" before re-try + Branch: oneperl + + vars.h + ! embed.pl thread.h thread.sym +____________________________________________________________________________ +[ 71] By: nick on 1997/09/26 17:47:31 + Log: Basic hacks to build with USE_THISPTR, not yet useful + but builds miniperl and passes minitest with all thread + variables via a _GLOBAL_ thr variable rather than globals. + Now for the local thr variable ... + Branch: oneperl + + thread.sym + ! MANIFEST README.threads XSUB.h av.c cv.h deb.c doio.c doop.c + ! dump.c embed.pl ext/DB_File/DB_File.xs gv.c hints/solaris_2.sh + ! hv.c mg.c op.c perl.c perl.h pp.c pp_ctl.c pp_hot.c pp_sys.c + ! proto.h regcomp.c regexec.c run.c scope.c sv.c thread.h toke.c + ! util.c vms/vms.c +____________________________________________________________________________ +[ 70] By: mbeattie on 1997/09/23 14:29:23 + Log: Branch oneperl from mainline. + Branch: oneperl + +> (branch 871 files) +____________________________________________________________________________ +[ 69] By: mbeattie on 1997/09/22 16:02:37 + Log: struct thread now stored in an SV and uses '~'-magic for access. + Branch: perl + ! thread.h + Branch: perlext + ! Thread/Thread.xs Thread/typemap +____________________________________________________________________________ +[ 68] By: mbeattie on 1997/09/22 16:01:48 + Log: runops becomes a funtion pointer and sv_bless3 created + to avoid pointer forgery with '~'-magic. + Branch: perl + ! global.sym perl.c perl.h pp.c proto.h run.c sv.c +____________________________________________________________________________ +[ 67] By: mbeattie on 1997/09/22 15:45:56 + Log: More fprintf -> PerlIO_printf changes. + Branch: perl + ! perl.c pp_hot.c util.c +____________________________________________________________________________ +[ 66] By: mbeattie on 1997/09/22 15:10:40 + Log: Minor multi-threading patches for VMS. + Branch: perl + ! mg.c thread.h vms/vms.c +____________________________________________________________________________ +[ 65] By: mbeattie on 1997/09/15 14:09:11 + Log: Add undefined-subs option to Lint.pm. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 64] By: mbeattie on 1997/09/10 16:39:41 + Log: Debugging output for lock handling. + Branch: perl + ! mg.c pp.c pp_hot.c util.c +____________________________________________________________________________ +[ 63] By: mbeattie on 1997/09/10 14:49:00 + Log: Move Thread/Semaphore.pm to Thread/Thread/Semaphore.pm + Branch: perlext + +> Thread/Thread/Semaphore.pm + - Thread/Semaphore.pm +____________________________________________________________________________ +[ 62] By: mbeattie on 1997/09/10 14:47:31 + Log: Move Thread/Queue.pm to Thread/Thread/Queue.pm + Branch: perlext + +> Thread/Thread/Queue.pm + - Thread/Queue.pm +____________________________________________________________________________ +[ 61] By: mbeattie on 1997/09/10 13:56:50 + Log: Solaris fixes: delete pad and padname from thread.h and remove + MUTEX_* stuff when malloc.c gets copied to x2p/malloc.c. + Branch: perl + ! thread.h x2p/Makefile.SH + +---------------- +Version 5.004_50 First developer release towards 5.005 +---------------- + +Maintenance of the 5.004 version of perl continues with the 5.004_xx +series, where 'xx' is <= 49. Development of the next version, 5.005, +starts with 5.004_50. + +____________________________________________________________________________ +[ 60] By: mbeattie on 1997/09/09 16:57:41 + Log: Update README.threads to mention -DL. + Branch: perl + ! README.threads +____________________________________________________________________________ +[ 59] By: mbeattie on 1997/09/09 16:49:08 + Log: Add Thread modules Queue.pm and Semaphore.pm + Branch: perlext + + Thread/Queue.pm Thread/Semaphore.pm +____________________________________________________________________________ +[ 58] By: mbeattie on 1997/09/09 16:33:45 + Log: Update README.threads + Branch: perl + ! README.threads +____________________________________________________________________________ +[ 57] By: mbeattie on 1997/09/09 16:26:47 + Log: Add debug info to Thread typemap. + Branch: perlext + ! Thread/typemap +____________________________________________________________________________ +[ 56] By: mbeattie on 1997/09/09 15:04:26 + Log: Rewrite synchronisation of subs/methods and add attrs + extension for specifying 'locked' and 'method' attributes. + Branch: perl + + ext/attrs/Makefile.PL ext/attrs/attrs.pm ext/attrs/attrs.xs + ! MANIFEST cv.h embed.h global.sym op.c perl.c pp.c pp_ctl.c + ! pp_hot.c proto.h sv.c sv.h toke.c + Branch: perlext + ! Thread/Thread.pm Thread/Thread.xs Thread/sync.t Thread/sync2.t +____________________________________________________________________________ +[ 55] By: mbeattie on 1997/09/03 16:34:47 + Log: Add new keyword "lock" to Opcode.pm + Branch: perl + ! ext/Opcode/Opcode.pm +____________________________________________________________________________ +[ 54] By: mbeattie on 1997/09/03 14:44:44 + Log: Run embed.pl and keywords.pl to complete RESTART -> INIT change + Branch: perl + ! embed.h keywords.h +____________________________________________________________________________ +[ 53] By: mbeattie on 1997/09/03 13:52:24 + Log: Add to MANIFEST: README.threads, lib/ISA.pm, lib/Class/Fields.pm + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 52] By: mbeattie on 1997/09/03 13:41:20 + Log: Let Lint private_names catch out-of-package _foo methods. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 51] By: mbeattie on 1997/09/03 13:20:12 + Log: Bump patchlevel.h to 5.004_50 + Branch: perl + ! patchlevel.h +____________________________________________________________________________ +[ 50] By: mbeattie on 1997/09/03 12:31:48 + Log: Make compiler build/work with devel 5.005 + Branch: perlext + ! Compiler/B.xs Compiler/B/Asmdata.pm Compiler/bytecode.h + ! Compiler/bytecode.pl Compiler/byterun.c Compiler/byterun.h +____________________________________________________________________________ +[ 49] By: mbeattie on 1997/09/03 12:28:05 + Log: Rename RESTART to INIT and associated changes + Branch: perl + ! interp.sym keywords.pl op.c perl.c perl.h perly.c perly.y + ! toke.c vms/perly_c.vms +____________________________________________________________________________ +[ 48] By: mbeattie on 1997/09/02 15:54:27 + Log: Added private-names option. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 47] By: mbeattie on 1997/09/02 11:54:55 + Log: For compiler's CC, make PP_EVAL, PP_ENTERTRY work with JMPENV. + Branch: perlext + ! Compiler/cc_runtime.h +____________________________________________________________________________ +[ 46] By: mbeattie on 1997/08/28 19:40:08 + Log: Missing sprintf in try_autoload. + Branch: perlext + ! Compiler/B/C.pm +____________________________________________________________________________ +[ 45] By: mbeattie on 1997/08/13 16:15:25 + Log: Threading fixups for Digital UNIX. + Branch: perl + ! README.threads malloc.c perl.h toke.c +____________________________________________________________________________ +[ 44] By: mbeattie on 1997/08/11 15:46:29 + Log: Assorted changes for multi-threading (now works rather more). + Branch: perl + + README.threads + ! gv.c mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c sv.c thread.h + ! toke.c util.c + Branch: perlext + ! Thread/Makefile.PL Thread/Thread.xs Thread/lock.t + ! Thread/unsync.t +____________________________________________________________________________ +[ 43] By: mbeattie on 1997/08/08 14:11:00 + Log: Made Lint check subs (and -u packages). + Added support for dollar_underscore and implicit $_ in foreach. + Branch: perlext + ! Compiler/B/Lint.pm +____________________________________________________________________________ +[ 42] By: TimBunce on 1997/07/25 17:15:57 + Log: Maintenance 5.004_01 changes + Branch: maint-5.004/perl + + Porting/makerel Porting/patchls hints/newsos4.sh + + lib/File/DosGlob.pm lib/chat2.pl perlio.sym win32/config.bc + + win32/config.vc win32/config_H.bc win32/config_H.vc + + win32/makefile.mk + - win32/config.H win32/config.w32 + ! Changes Configure EXTERN.h INSTALL MANIFEST Makefile.SH + ! Porting/pumpkin.pod README README.win32 doio.c embed.h + ! ext/DynaLoader/dl_aix.xs ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + ! ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL + ! global.sym hints/next_3.sh hints/next_4.sh hints/svr4.sh + ! installhtml installman lib/AutoLoader.pm lib/AutoSplit.pm + ! lib/CGI/Push.pm lib/CPAN.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm + ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + ! lib/ExtUtils/xsubpp lib/Pod/Html.pm lib/Pod/Text.pm + ! lib/Sys/Syslog.pm lib/Term/ReadLine.pm lib/Test/Harness.pm + ! lib/ftp.pl mg.c op.c patchlevel.h perl.c perl.h perl_exp.SH + ! perlio.c pod/checkpods.PL pod/perlbook.pod pod/perldata.pod + ! pod/perldebug.pod pod/perldelta.pod pod/perldiag.pod + ! pod/perlembed.pod pod/perlfaq4.pod pod/perlfaq8.pod + ! pod/perlfaq9.pod pod/perlfunc.pod pod/perlguts.pod + ! pod/perllol.pod pod/perlop.pod pod/perlrun.pod pod/perlsub.pod + ! pod/perltoc.pod pod/perltoot.pod pod/pod2man.PL pod/roffitall + ! pod/splitpod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c + ! regcomp.h regexec.c sv.c t/lib/safe2.t t/op/flip.t + ! t/op/groups.t t/op/magic.t t/op/mkdir.t t/op/re_tests + ! t/op/regexp.t t/op/split.t t/op/stat.t t/op/subst.t + ! t/op/taint.t util.c utils/Makefile utils/h2xs.PL + ! utils/perlbug.PL vms/ext/DCLsym/DCLsym.pm + ! vms/ext/Stdio/Stdio.pm vms/gen_shrfls.pl vms/perlvms.pod + ! win32/Makefile win32/config_sh.PL win32/include/sys/socket.h + ! win32/makedef.pl win32/makeperldef.pl win32/perlglob.c + ! win32/perllib.c win32/win32.c win32/win32.h win32/win32io.c + ! win32/win32io.h win32/win32iop.h win32/win32sck.c +____________________________________________________________________________ +[ 41] By: mbeattie on 1997/07/24 14:57:53 + Log: Start support for fake threads. + pp_lock now returns its argument. + Branch: perl + ! MANIFEST Makefile.SH cv.h op.c opcode.h opcode.pl perl.c + ! perl.h pp.c pp_ctl.c pp_hot.c proto.h sv.h thread.h toke.c + ! util.c + Branch: perlext + ! Thread/Thread.xs +____________________________________________________________________________ +[ 40] By: mbeattie on 1997/07/24 14:55:07 + Log: Add missing reset of eval_owner if doeval() fails to parse. + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 39] By: mbeattie on 1997/07/17 13:35:51 + Log: Fix multiple problems with lexical @_. + Branch: perl + ! cop.h op.c perl.c pp.c pp_ctl.c pp_hot.c t/op/do.t thread.h + ! toke.c +____________________________________________________________________________ +[ 38] By: mbeattie on 1997/07/16 17:02:09 + Log: Change %lx to %x in B::CV::save to prevent some CV + fields becoming 0 in the init section. Add missing + write_back in B::Stackobj::Padsv::load_double to fix + test 22 of op/my.t. + Branch: perlext + ! Compiler/B/C.pm Compiler/B/Stackobj.pm +____________________________________________________________________________ +[ 37] By: mbeattie on 1997/07/10 11:28:16 + Log: Branch win32 developments from main perl branch. + Branch: win32/perl + +> (branch 867 files) +____________________________________________________________________________ +[ 36] By: mbeattie on 1997/07/05 11:58:05 + Log: B::CC::pp_padsv must cope with vivify_ref (5.004) + as well as provide_ref (5.003). + Branch: perlext + ! Compiler/B/C.pm Compiler/B/CC.pm Compiler/NOTES +____________________________________________________________________________ +[ 35] By: mbeattie on 1997/07/05 11:55:18 + Log: Introduce pp_lock. + Branch: perl + ! embed.h global.sym keywords.h keywords.pl opcode.h opcode.pl + ! pp.c pp_ctl.c toke.c +____________________________________________________________________________ +[ 34] By: mbeattie on 1997/07/01 12:24:28 + Log: Support for op in global register (still buggy) + Branch: perl + ! embed.h global.sym gv.c op.c perl.c perl.h pp_ctl.c pp_sys.c + ! proto.h scope.c scope.h thread.h +____________________________________________________________________________ +[ 33] By: mbeattie on 1997/06/24 16:34:24 + Log: Branch lexical warnings from perl branch. + Branch: lexwarn/perl + +> (branch 867 files) +____________________________________________________________________________ +[ 32] By: mbeattie on 1997/06/24 14:33:57 + Log: Branch integration of maint-5.004 from relperl. + Branch: mainline/perl + +> (branch 600 files) + Branch: maint-5.004/perl + +> (branch 864 files) +____________________________________________________________________________ +[ 31] By: mbeattie on 1997/06/20 11:46:50 + Log: corrected bad_type() prototype. + Branch: perl + ! op.c +____________________________________________________________________________ +[ 30] By: mbeattie on 1997/06/12 12:38:05 + Log: Tweak README. + Branch: perlext + ! Thread/README +____________________________________________________________________________ +[ 29] By: mbeattie on 1997/06/12 12:34:59 + Log: Document -m option of CC backend. + Branch: perlext + ! Compiler/NOTES +____________________________________________________________________________ +[ 28] By: mbeattie on 1997/06/12 12:25:05 + Log: Support sysseek introduced in 5.004. + Branch: perlext + ! Compiler/ccop.c Compiler/ccop.h +____________________________________________________________________________ +[ 27] By: mbeattie on 1997/06/05 14:20:51 + Log: More fixups for thrperl integration. + Branch: perl + ! ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + ! ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm + ! ext/Opcode/Opcode.xs gv.c hv.c mg.c op.c perl.c perly.c + ! perly.y pp.c pp_ctl.c run.c scope.c sv.c sv.h thread.h toke.c + ! util.c +____________________________________________________________________________ +[ 25] By: mbeattie on 1997/05/28 15:11:24 + Log: Fixups for thrperl integration. + Branch: perl + ! embed.h keywords.h op.c opcode.h perl.c util.c +____________________________________________________________________________ +[ 24] By: mbeattie on 1997/05/26 20:10:42 + Log: Integrate thrperl 5.003->5.004. + Branch: perl + +> thread.h + !> (integrate 33 files) +____________________________________________________________________________ +[ 23] By: mbeattie on 1997/05/26 11:45:39 + Log: Fix ppname when saving subs. + Branch: perlext + ! Compiler/B/C.pm +____________________________________________________________________________ +[ 22] By: mbeattie on 1997/05/26 11:45:03 + Log: -mFoo option now forces -uFoo. + Branch: perlext + ! Compiler/B/CC.pm +____________________________________________________________________________ +[ 21] By: mbeattie on 1997/05/26 11:43:37 + Log: Put back objsym/savesym (used by walkoptree_exec). + Branch: perlext + ! Compiler/B.pm +____________________________________________________________________________ +[ 20] By: mbeattie on 1997/05/26 11:38:45 + Log: Add avhv_store_ent. Add missing avhv_* to global.sym. + Branch: perl + ! av.c global.sym +____________________________________________________________________________ +[ 19] By: mbeattie on 1997/05/25 21:19:38 + Log: Fix up integration 5.003->5.004. + Branch: perl + + lib/Class/Fields.pm lib/ISA.pm + ! av.c ext/DB_File/DB_File.xs perl.c pp.c pp_hot.c proto.h + ! toke.c +____________________________________________________________________________ +[ 18] By: mbeattie on 1997/05/25 10:31:21 + Log: First stab at 5.003 -> 5.004 integration. + Branch: perl + +> (branch 291 files) + - Changes.Conf ext/DynaLoader/dl_os2.xs + - ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs + - ext/FileHandle/Makefile.PL ext/SDBM_File/sdbm/readme.ps + - ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Safe/Safe.xs + - hints/aux.sh hints/dnix.sh hints/irix_6_2.sh lib/chat2.inter + - lib/chat2.pl lib/splain os2/README os2/README.old + - os2/diff.db_file os2/notes pod/perlovl.pod t/lib/safe.t + - t/op/overload.t t/re_tests vms/Makefile x2p/a2p.man + - x2p/handy.h x2p/s2p.man + !> (integrate 392 files) +____________________________________________________________________________ +[ 17] By: mbeattie on 1997/05/24 18:46:49 + Log: Wholesale update to 5.004. + Branch: relperl + + Changes5.000 Changes5.001 Changes5.002 Changes5.003 + + Porting/Glossary Porting/pumpkin.pod README.amiga + + README.cygwin32 README.os2 README.plan9 README.qnx + + README.win32 compat3.sym configure.gnu cygwin32/cw32imp.h + + cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc cygwin32/perlld + + eg/cgi/RunMeFirst eg/cgi/clickable_image.cgi eg/cgi/cookie.cgi + + eg/cgi/crash.cgi eg/cgi/customize.cgi eg/cgi/diff_upload.cgi + + eg/cgi/file_upload.cgi eg/cgi/frameset.cgi eg/cgi/index.html + + eg/cgi/internal_links.cgi eg/cgi/javascript.cgi + + eg/cgi/monty.cgi eg/cgi/multiple_forms.cgi + + eg/cgi/nph-clock.cgi eg/cgi/popup.cgi eg/cgi/save_state.cgi + + eg/cgi/tryit.cgi eg/cgi/wilogo.gif.uu + + ext/DynaLoader/dl_cygwin32.xs ext/IO/IO.pm ext/IO/IO.xs + + ext/IO/Makefile.PL ext/IO/README ext/IO/lib/IO/File.pm + + ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Pipe.pm + + ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Select.pm + + ext/IO/lib/IO/Socket.pm ext/NDBM_File/hints/dec_osf.pl + + ext/NDBM_File/hints/dynixptx.pl ext/ODBM_File/hints/hpux.pl + + ext/ODBM_File/hints/ultrix.pl ext/Opcode/Makefile.PL + + ext/Opcode/Opcode.pm ext/Opcode/Opcode.xs ext/Opcode/Safe.pm + + ext/Opcode/ops.pm ext/POSIX/hints/next_3.pl hints/amigaos.sh + + hints/aux_3.sh hints/broken-db.msg hints/cygwin32.sh + + hints/dcosx.sh hints/irix_6_0.sh hints/irix_6_1.sh + + hints/lynxos.sh hints/next_4.sh hints/qnx.sh hints/umips.sh + + hints/unicosmk.sh installhtml lib/Bundle/CPAN.pm lib/CGI.pm + + lib/CGI/Apache.pm lib/CGI/Carp.pm lib/CGI/Fast.pm + + lib/CGI/Push.pm lib/CGI/Switch.pm lib/CPAN.pm + + lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm lib/Class/Struct.pm + + lib/ExtUtils/Command.pm lib/ExtUtils/Embed.pm + + lib/ExtUtils/MM_Win32.pm lib/File/Compare.pm lib/File/stat.pm + + lib/FileHandle.pm lib/FindBin.pm lib/Math/Trig.pm + + lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm + + lib/Net/servent.pm lib/Pod/Html.pm lib/Tie/RefHash.pm + + lib/Time/gmtime.pm lib/Time/localtime.pm lib/Time/tm.pm + + lib/UNIVERSAL.pm lib/User/grent.pm lib/User/pwent.pm + + lib/autouse.pm lib/blib.pm lib/constant.pm lib/locale.pm + + nostdio.h os2/Changes os2/OS2/ExtAttr/Changes + + os2/OS2/ExtAttr/ExtAttr.pm os2/OS2/ExtAttr/ExtAttr.xs + + os2/OS2/ExtAttr/MANIFEST os2/OS2/ExtAttr/Makefile.PL + + os2/OS2/ExtAttr/myea.h os2/OS2/ExtAttr/t/os2_ea.t + + os2/OS2/ExtAttr/typemap os2/OS2/PrfDB/Changes + + os2/OS2/PrfDB/MANIFEST os2/OS2/PrfDB/Makefile.PL + + os2/OS2/PrfDB/PrfDB.pm os2/OS2/PrfDB/PrfDB.xs + + os2/OS2/PrfDB/t/os2_prfdb.t os2/OS2/PrfDB/typemap + + os2/OS2/Process/MANIFEST os2/OS2/Process/Makefile.PL + + os2/OS2/Process/Process.pm os2/OS2/Process/Process.xs + + os2/OS2/REXX/Changes os2/OS2/REXX/MANIFEST + + os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm + + os2/OS2/REXX/REXX.xs os2/OS2/REXX/t/rx_cmprt.t + + os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t + + os2/OS2/REXX/t/rx_sql.test os2/OS2/REXX/t/rx_tiesql.test + + os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t + + os2/OS2/REXX/t/rx_varset.t os2/OS2/REXX/t/rx_vrexx.t + + os2/dl_os2.c os2/dlfcn.h perlio.c perlio.h perlsdio.h + + perlsfio.h plan9/aperl plan9/arpa/inet.h plan9/buildinfo + + plan9/config.plan9 plan9/exclude plan9/fndvers + + plan9/genconfig.pl plan9/mkfile plan9/myconfig.plan9 + + plan9/perlplan9.doc plan9/perlplan9.pod plan9/plan9.c + + plan9/plan9ish.h plan9/setup.rc plan9/versnum pod/checkpods.PL + + pod/perlapio.pod pod/perldelta.pod pod/perlfaq.pod + + pod/perlfaq1.pod pod/perlfaq2.pod pod/perlfaq3.pod + + pod/perlfaq4.pod pod/perlfaq5.pod pod/perlfaq6.pod + + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlfaq9.pod + + pod/perllocale.pod pod/perlmodlib.pod pod/perltoot.pod + + pod/rofftoc qnx/ar qnx/cpp t/comp/colon.t t/comp/proto.t + + t/comp/redef.t t/comp/use.t t/io/read.t t/lib/abbrev.t + + t/lib/autoloader.t t/lib/basename.t t/lib/checktree.t + + t/lib/complex.t t/lib/env.t t/lib/filecache.t t/lib/filecopy.t + + t/lib/filefind.t t/lib/filepath.t t/lib/findbin.t + + t/lib/getopt.t t/lib/hostname.t t/lib/io_dup.t t/lib/io_pipe.t + + t/lib/io_sel.t t/lib/io_sock.t t/lib/io_taint.t + + t/lib/io_tell.t t/lib/io_udp.t t/lib/io_xs.t t/lib/opcode.t + + t/lib/open2.t t/lib/open3.t t/lib/ops.t t/lib/parsewords.t + + t/lib/safe1.t t/lib/safe2.t t/lib/searchdict.t + + t/lib/selectsaver.t t/lib/symbol.t t/lib/texttabs.t + + t/lib/textwrap.t t/lib/timelocal.t t/lib/trig.t t/op/arith.t + + t/op/assignwarn.t t/op/bop.t t/op/closure.t t/op/cmp.t + + t/op/gv.t t/op/inc.t t/op/method.t t/op/recurse.t + + t/op/runlevel.t t/op/sysio.t t/op/taint.t t/op/tie.t + + t/op/universal.t t/pragma/constant.t t/pragma/locale.t + + t/pragma/overload.t t/pragma/strict-refs t/pragma/strict-subs + + t/pragma/strict-vars t/pragma/strict.t t/pragma/subs.t + + t/pragma/warn-1global t/pragma/warning.t universal.c + + utils/splain.PL vms/ext/DCLsym/0README.txt + + vms/ext/DCLsym/DCLsym.pm vms/ext/DCLsym/DCLsym.xs + + vms/ext/DCLsym/Makefile.PL vms/ext/DCLsym/test.pl + + vms/ext/XSSymSet.pm vms/ext/filespec.t vms/ext/vmsish.pm + + vms/ext/vmsish.t win32/Makefile win32/TEST win32/autosplit.pl + + win32/bin/network.pl win32/bin/pl2bat.bat win32/bin/search.bat + + win32/bin/test.bat win32/bin/webget.bat win32/bin/www.pl + + win32/config.H win32/config.w32 win32/config_h.PL + + win32/config_sh.PL win32/dl_win32.xs win32/genxsdef.pl + + win32/include/arpa/inet.h win32/include/dirent.h + + win32/include/netdb.h win32/include/sys/socket.h + + win32/makedef.pl win32/makemain.pl win32/makeperldef.pl + + win32/perlglob.c win32/perllib.c win32/pod.mak win32/runperl.c + + win32/splittree.pl win32/win32.c win32/win32.h win32/win32io.c + + win32/win32io.h win32/win32iop.h win32/win32sck.c x2p/a2p.pod + + x2p/proto.h + - Changes.Conf ext/DynaLoader/dl_os2.xs + - ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs + - ext/FileHandle/Makefile.PL ext/SDBM_File/sdbm/readme.ps + - ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Safe/Safe.xs + - hints/aux.sh hints/dnix.sh hints/irix_6_2.sh lib/chat2.inter + - lib/chat2.pl lib/splain os2/README os2/README.old + - os2/diff.db_file os2/notes pod/perlovl.pod t/lib/safe.t + - t/op/overload.t t/re_tests vms/Makefile x2p/a2p.man + - x2p/handy.h x2p/s2p.man + ! Artistic Changes Configure EXTERN.h INSTALL INTERN.h MANIFEST + ! Makefile.SH README README.vms Todo XSUB.h av.c av.h cflags.SH + ! config_H config_h.SH configpm configure cop.h cv.h deb.c + ! doio.c doop.c dosish.h dump.c eg/README eg/nih + ! eg/sysvipc/ipcmsg eg/sysvipc/ipcsem eg/sysvipc/ipcshm + ! emacs/cperl-mode.el embed.h embed.pl ext/DB_File/DB_File.pm + ! ext/DB_File/DB_File.xs ext/DB_File/Makefile.PL + ! ext/DB_File/typemap ext/DynaLoader/DynaLoader.pm + ! ext/DynaLoader/Makefile.PL ext/DynaLoader/dl_aix.xs + ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs + ! ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c + ! ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + ! ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm + ! ext/ODBM_File/ODBM_File.pm ext/ODBM_File/ODBM_File.xs + ! ext/ODBM_File/hints/dec_osf.pl ext/POSIX/POSIX.pm + ! ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs + ! ext/SDBM_File/Makefile.PL ext/SDBM_File/SDBM_File.pm + ! ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/pair.c + ! ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3 + ! ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h + ! ext/Socket/Socket.pm ext/Socket/Socket.xs ext/util/make_ext + ! form.h global.sym gv.c gv.h handy.h hints/3b1.sh + ! hints/README.hints hints/aix.sh hints/apollo.sh hints/bsdos.sh + ! hints/convexos.sh hints/cxux.sh hints/dec_osf.sh hints/dgux.sh + ! hints/dynixptx.sh hints/epix.sh hints/esix4.sh + ! hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/irix_5.sh + ! hints/irix_6.sh hints/isc.sh hints/linux.sh hints/machten.sh + ! hints/machten_2.sh hints/mips.sh hints/mpeix.sh + ! hints/netbsd.sh hints/next_3.sh hints/next_3_0.sh hints/os2.sh + ! hints/powerux.sh hints/sco.sh hints/sco_2_3_3.sh + ! hints/sco_2_3_4.sh hints/solaris_2.sh hints/sunos_4_0.sh + ! hints/sunos_4_1.sh hints/svr4.sh hints/titanos.sh + ! hints/ultrix_4.sh hints/unicos.sh hints/utekv.sh hv.c hv.h + ! installman installperl interp.sym keywords.h keywords.pl + ! lib/AnyDBM_File.pm lib/AutoLoader.pm lib/AutoSplit.pm + ! lib/Benchmark.pm lib/Carp.pm lib/Cwd.pm + ! lib/Devel/SelfStubber.pm lib/English.pm lib/Env.pm + ! lib/Exporter.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_OS2.pm + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm + ! lib/ExtUtils/Mkbootstrap.pm lib/ExtUtils/Mksymlists.pm + ! lib/ExtUtils/testlib.pm lib/ExtUtils/typemap + ! lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Copy.pm + ! lib/File/Find.pm lib/File/Path.pm lib/FileCache.pm + ! lib/Getopt/Long.pm lib/Getopt/Std.pm lib/I18N/Collate.pm + ! lib/IPC/Open2.pm lib/IPC/Open3.pm lib/Math/BigInt.pm + ! lib/Math/Complex.pm lib/Net/Ping.pm lib/Pod/Functions.pm + ! lib/Pod/Text.pm lib/Search/Dict.pm lib/SelectSaver.pm + ! lib/SelfLoader.pm lib/Symbol.pm lib/Sys/Hostname.pm + ! lib/Sys/Syslog.pm lib/Term/Cap.pm lib/Term/Complete.pm + ! lib/Term/ReadLine.pm lib/Test/Harness.pm lib/Text/Abbrev.pm + ! lib/Text/ParseWords.pm lib/Text/Soundex.pm lib/Text/Tabs.pm + ! lib/Text/Wrap.pm lib/Tie/Hash.pm lib/Tie/Scalar.pm + ! lib/Tie/SubstrHash.pm lib/Time/Local.pm lib/abbrev.pl + ! lib/bigfloat.pl lib/bigint.pl lib/cacheout.pl lib/complete.pl + ! lib/diagnostics.pm lib/dotsh.pl lib/dumpvar.pl lib/find.pl + ! lib/finddepth.pl lib/ftp.pl lib/getcwd.pl lib/getopts.pl + ! lib/importenv.pl lib/lib.pm lib/look.pl lib/newgetopt.pl + ! lib/open2.pl lib/open3.pl lib/overload.pm lib/perl5db.pl + ! lib/sigtrap.pm lib/strict.pm lib/subs.pm lib/syslog.pl + ! lib/termcap.pl lib/timelocal.pl lib/validate.pl lib/vars.pm + ! makeaperl.SH makedepend.SH malloc.c mg.c mg.h minimod.pl + ! miniperlmain.c myconfig op.c op.h opcode.h opcode.pl + ! os2/Makefile.SHs os2/diff.configure os2/os2.c os2/os2ish.h + ! os2/perl2cmd.pl patchlevel.h perl.c perl.h perl_exp.SH perlsh + ! perly.c perly.c.diff perly.h perly.y pod/Makefile pod/buildtoc + ! pod/perl.pod pod/perlbook.pod pod/perlbot.pod pod/perlcall.pod + ! pod/perldata.pod pod/perldebug.pod pod/perldiag.pod + ! pod/perldsc.pod pod/perlembed.pod pod/perlform.pod + ! pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod + ! pod/perllol.pod pod/perlmod.pod pod/perlobj.pod pod/perlop.pod + ! pod/perlpod.pod pod/perlre.pod pod/perlref.pod pod/perlrun.pod + ! pod/perlsec.pod pod/perlstyle.pod pod/perlsub.pod + ! pod/perlsyn.pod pod/perltie.pod pod/perltoc.pod + ! pod/perltrap.pod pod/perlvar.pod pod/perlxs.pod + ! pod/perlxstut.pod pod/pod2html.PL pod/pod2latex.PL + ! pod/pod2man.PL pod/pod2text.PL pod/roffitall pp.c pp.h + ! pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regcomp.h + ! regexec.c regexp.h run.c scope.c scope.h sv.c sv.h t/README + ! t/TEST t/base/lex.t t/base/term.t t/cmd/mod.t t/cmd/while.t + ! t/comp/cpp.t t/comp/multiline.t t/comp/package.t + ! t/comp/script.t t/harness t/io/argv.t t/io/dup.t t/io/fs.t + ! t/io/inplace.t t/io/pipe.t t/io/tell.t t/lib/anydbm.t + ! t/lib/bigintpm.t t/lib/db-btree.t t/lib/db-hash.t + ! t/lib/db-recno.t t/lib/dirhand.t t/lib/filehand.t t/lib/gdbm.t + ! t/lib/ndbm.t t/lib/odbm.t t/lib/posix.t t/lib/sdbm.t + ! t/lib/socket.t t/op/chop.t t/op/delete.t t/op/each.t + ! t/op/exec.t t/op/fork.t t/op/glob.t t/op/goto.t t/op/groups.t + ! t/op/magic.t t/op/misc.t t/op/mkdir.t t/op/my.t t/op/oct.t + ! t/op/pack.t t/op/pat.t t/op/quotemeta.t t/op/rand.t + ! t/op/re_tests t/op/readdir.t t/op/ref.t t/op/regexp.t + ! t/op/sleep.t t/op/sort.t t/op/split.t t/op/stat.t t/op/subst.t + ! t/op/substr.t t/op/write.t taint.c toke.c unixish.h util.c + ! util.h utils/Makefile utils/c2ph.PL utils/h2ph.PL + ! utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL + ! vms/config.vms vms/descrip.mms vms/ext/Filespec.pm + ! vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs + ! vms/ext/Stdio/test.pl vms/fndvers.com vms/gen_shrfls.pl + ! vms/genconfig.pl vms/genopt.com vms/myconfig.com + ! vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms + ! vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c + ! vms/vms_yfix.pl vms/vmsish.h vms/writemain.pl writemain.SH + ! x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h + ! x2p/a2p.y x2p/a2py.c x2p/cflags.SH x2p/find2perl.PL x2p/hash.c + ! x2p/hash.h x2p/s2p.PL x2p/str.c x2p/str.h x2p/util.c + ! x2p/util.h x2p/walk.c +____________________________________________________________________________ +[ 16] By: mbeattie on 1997/05/23 22:42:08 + Log: Initial integration of relperl from 5.003. + Branch: relperl + +> (branch 600 files) +____________________________________________________________________________ +[ 14] By: mbeattie on 1997/05/12 20:22:56 + Log: Finish code generation rewrite. Clean up B::Section class and + handle symbol table translation internally. Simple .pm modules + now compile OK. + Branch: perlext + ! Compiler/B.pm Compiler/B/Bblock.pm Compiler/B/C.pm + ! Compiler/B/CC.pm +____________________________________________________________________________ +[ 13] By: mbeattie on 1997/05/05 19:41:18 + Log: Don't make pp_enter and pp_return trigger basic blocks. + Branch: perlext + ! Compiler/B/Bblock.pm +____________________________________________________________________________ +[ 12] By: mbeattie on 1997/05/05 19:40:16 + Log: Rewrite code generation. Sections (de)multiplexed into a + temporary file instead of stored in arrays. + Branch: perlext + ! Compiler/B.pm Compiler/B/C.pm Compiler/B/CC.pm +____________________________________________________________________________ +[ 11] By: mbeattie on 1997/05/03 20:20:59 + Log: Development to pre-alpha4 + Branch: perlext + + Compiler/B/Deparse.pm Compiler/B/Lint.pm Compiler/makeliblinks + ! Compiler/B.pm Compiler/B.xs Compiler/B/Bblock.pm + ! Compiler/B/Bytecode.pm Compiler/B/C.pm Compiler/B/CC.pm + ! Compiler/B/Debug.pm Compiler/B/Terse.pm Compiler/B/Xref.pm + ! Compiler/Makefile.PL Compiler/README Compiler/TESTS + ! Compiler/assemble Compiler/bytecode.pl Compiler/byteperl.c + ! Compiler/byterun.c Compiler/cc_runtime.h Compiler/disassemble + ! Compiler/test_harness Compiler/test_harness_cc +____________________________________________________________________________ +[ 10] By: mbeattie on 1997/05/03 14:47:06 + Log: Initial check-in of perl compiler. + Branch: perlext + + Compiler/Artistic Compiler/B.pm Compiler/B.xs + + Compiler/B/Asmdata.pm Compiler/B/Assembler.pm + + Compiler/B/Bblock.pm Compiler/B/Bytecode.pm Compiler/B/C.pm + + Compiler/B/CC.pm Compiler/B/Debug.pm + + Compiler/B/Disassembler.pm Compiler/B/Showlex.pm + + Compiler/B/Stackobj.pm Compiler/B/Terse.pm Compiler/B/Xref.pm + + Compiler/Copying Compiler/Makefile.PL Compiler/NOTES + + Compiler/O.pm Compiler/README Compiler/TESTS + + Compiler/TESTS.alpha2 Compiler/Todo Compiler/assemble + + Compiler/bytecode.h Compiler/bytecode.pl Compiler/byteperl.c + + Compiler/byterun.c Compiler/byterun.h Compiler/cc_harness + + Compiler/cc_runtime.h Compiler/ccop.c Compiler/ccop.h + + Compiler/disassemble Compiler/old/README.feb11 + + Compiler/old/TESTS.mar11 Compiler/old/TESTS.mar20 + + Compiler/old/TESTS.may11 Compiler/old/TESTS.pre-jul27 + + Compiler/op.patch Compiler/ramblings/cc.notes + + Compiler/ramblings/curcop.runtime + + Compiler/ramblings/dontparse.c Compiler/ramblings/flip-flop + + Compiler/ramblings/foo.bench Compiler/ramblings/foo2.bench + + Compiler/ramblings/foo3.bench Compiler/ramblings/magic + + Compiler/ramblings/pp_i_add Compiler/ramblings/reg.alloc + + Compiler/ramblings/runtime.porting + + Compiler/ramblings/sort.notes Compiler/ramblings/sub.call + + Compiler/ramblings/subst.notes Compiler/run_bytecode_test + + Compiler/run_cc_test Compiler/run_test Compiler/test_harness + + Compiler/test_harness_bytecode Compiler/test_harness_cc + + Compiler/typemap +____________________________________________________________________________ +[ 9] By: mbeattie on 1997/05/02 19:03:49 + Log: Don't require CvDEPTH == 0 when bombing out of subs. + Branch: thrperl + ! pp_hot.c +____________________________________________________________________________ +[ 8] By: mbeattie on 1997/04/23 19:06:45 + Log: Added programmer-level condition variables via "condpair" magic. + Added support for detached threads and tweaked a few things. + Branch: thrperl + ! embed.h global.sym keywords.h mg.c opcode.h perl.c perl.h + ! pp_ctl.c pp_hot.c proto.h run.c scope.c sv.c sv.h thread.h + ! util.c +____________________________________________________________________________ +[ 7] By: mbeattie on 1997/04/23 19:04:18 + Log: Rewrote programmer-level condition variables from scratch. Added + support for detaching threads. Fixed handling for arguments + passed in to threads and return values for joined threads. + Branch: perlext + + Thread/lock.t + ! Thread/README Thread/Thread.pm Thread/Thread.xs Thread/cond.t + ! Thread/typemap +____________________________________________________________________________ +[ 6] By: mbeattie on 1997/04/10 20:17:26 + Log: Initial check-in of Thread module. + Branch: perlext + + Thread/Makefile.PL Thread/Notes Thread/README Thread/Thread.pm + + Thread/Thread.xs Thread/cond.t Thread/create.t Thread/io.t + + Thread/join.t Thread/sync.t Thread/sync2.t Thread/typemap + + Thread/unsync.t Thread/unsync2.t Thread/unsync3.t + + Thread/unsync4.t +____________________________________________________________________________ +[ 5] By: mbeattie on 1997/04/10 20:05:52 + Log: Tweaks to allow compilation without -DUSE_THREADS and fix + missing parens (pad allocation) in the tokener. + Branch: thrperl + ! op.c pp_ctl.c toke.c +____________________________________________________________________________ +[ 4] By: mbeattie on 1997/03/28 18:40:44 + Log: Initial 3-way merge from (5.001m, thr1m, 5.003) plus fixups. + Branch: thrperl + + thread.h + ! XSUB.h av.c cv.h deb.c doio.c doop.c dump.c global.sym gv.c + ! hv.c malloc.c mg.c op.c op.h opcode.h opcode.pl perl.c perl.h + ! pp.h pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regexec.c + ! run.c scope.c sv.c sv.h toke.c util.c +____________________________________________________________________________ +[ 3] By: mbeattie on 1997/03/28 13:36:23 + Log: Branch 5.003 -> thrperl + Branch: thrperl + +> (branch 600 files) +____________________________________________________________________________ +[ 2] By: mbeattie on 1997/03/28 13:32:21 + Log: Initial devel changes. + Pseudo-hashes. Optional strong typing. RESTART {}. + Branch: perl + ! av.c doop.c embed.h ext/DB_File/DB_File.xs global.sym + ! interp.sym keywords.h keywords.pl lib/ExtUtils/xsubpp op.c + ! perl.c perl.h pp.c pp_hot.c proto.h t/op/groups.t toke.c +____________________________________________________________________________ +[ 1] By: mbeattie on 1997/03/28 13:17:33 + Log: Perl 5.003 check-in + Branch: perl + + Artistic Changes Changes.Conf Configure Copying EXTERN.h + + INSTALL INTERN.h MANIFEST Makefile.SH README README.vms Todo + + XSUB.h av.c av.h cflags.SH config_H config_h.SH configpm + + configure cop.h cv.h deb.c doio.c doop.c dosish.h dump.c + + eg/ADB eg/README eg/changes eg/client eg/down eg/dus eg/findcp + + eg/findtar eg/g/gcp eg/g/gcp.man eg/g/ged eg/g/ghosts eg/g/gsh + + eg/g/gsh.man eg/muck eg/muck.man eg/myrup eg/nih eg/relink + + eg/rename eg/rmfrom eg/scan/scan_df eg/scan/scan_last + + eg/scan/scan_messages eg/scan/scan_passwd eg/scan/scan_ps + + eg/scan/scan_sudo eg/scan/scan_suid eg/scan/scanner eg/server + + eg/shmkill eg/sysvipc/README eg/sysvipc/ipcmsg + + eg/sysvipc/ipcsem eg/sysvipc/ipcshm eg/travesty eg/unuc + + eg/uudecode eg/van/empty eg/van/unvanish eg/van/vanexp + + eg/van/vanish eg/who eg/wrapsuid emacs/cperl-mode.el embed.h + + embed.pl ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + ext/DB_File/DB_File_BS ext/DB_File/Makefile.PL + + ext/DB_File/typemap ext/DynaLoader/DynaLoader.pm + + ext/DynaLoader/Makefile.PL ext/DynaLoader/README + + ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_dld.xs + + ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs + + ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_none.xs + + ext/DynaLoader/dl_os2.xs ext/DynaLoader/dl_vms.xs + + ext/DynaLoader/dlutils.c ext/Fcntl/Fcntl.pm ext/Fcntl/Fcntl.xs + + ext/Fcntl/Makefile.PL ext/FileHandle/FileHandle.pm + + ext/FileHandle/FileHandle.xs ext/FileHandle/Makefile.PL + + ext/GDBM_File/GDBM_File.pm ext/GDBM_File/GDBM_File.xs + + ext/GDBM_File/Makefile.PL ext/GDBM_File/typemap + + ext/NDBM_File/Makefile.PL ext/NDBM_File/NDBM_File.pm + + ext/NDBM_File/NDBM_File.xs ext/NDBM_File/hints/solaris.pl + + ext/NDBM_File/hints/svr4.pl ext/NDBM_File/typemap + + ext/ODBM_File/Makefile.PL ext/ODBM_File/ODBM_File.pm + + ext/ODBM_File/ODBM_File.xs ext/ODBM_File/hints/dec_osf.pl + + ext/ODBM_File/hints/sco.pl ext/ODBM_File/hints/solaris.pl + + ext/ODBM_File/hints/svr4.pl ext/ODBM_File/typemap + + ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod + + ext/POSIX/POSIX.xs ext/POSIX/typemap ext/SDBM_File/Makefile.PL + + ext/SDBM_File/SDBM_File.pm ext/SDBM_File/SDBM_File.xs + + ext/SDBM_File/sdbm/CHANGES ext/SDBM_File/sdbm/COMPARE + + ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/README + + ext/SDBM_File/sdbm/README.too ext/SDBM_File/sdbm/biblio + + ext/SDBM_File/sdbm/dba.c ext/SDBM_File/sdbm/dbd.c + + ext/SDBM_File/sdbm/dbe.1 ext/SDBM_File/sdbm/dbe.c + + ext/SDBM_File/sdbm/dbm.c ext/SDBM_File/sdbm/dbm.h + + ext/SDBM_File/sdbm/dbu.c ext/SDBM_File/sdbm/grind + + ext/SDBM_File/sdbm/hash.c ext/SDBM_File/sdbm/linux.patches + + ext/SDBM_File/sdbm/makefile.sdbm ext/SDBM_File/sdbm/pair.c + + ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/readme.ms + + ext/SDBM_File/sdbm/readme.ps ext/SDBM_File/sdbm/sdbm.3 + + ext/SDBM_File/sdbm/sdbm.c ext/SDBM_File/sdbm/sdbm.h + + ext/SDBM_File/sdbm/tune.h ext/SDBM_File/sdbm/util.c + + ext/SDBM_File/typemap ext/Safe/Makefile.PL ext/Safe/Safe.pm + + ext/Safe/Safe.xs ext/Socket/Makefile.PL ext/Socket/Socket.pm + + ext/Socket/Socket.xs ext/util/extliblist ext/util/make_ext + + ext/util/mkbootstrap form.h global.sym globals.c gv.c gv.h + + h2pl/README h2pl/cbreak.pl h2pl/cbreak2.pl h2pl/eg/sizeof.ph + + h2pl/eg/sys/errno.pl h2pl/eg/sys/ioctl.pl h2pl/eg/sysexits.pl + + h2pl/getioctlsizes h2pl/mksizes h2pl/mkvars h2pl/tcbreak + + h2pl/tcbreak2 handy.h hints/3b1.sh hints/3b1cc + + hints/README.hints hints/aix.sh hints/altos486.sh + + hints/apollo.sh hints/aux.sh hints/bsdos.sh hints/convexos.sh + + hints/cxux.sh hints/dec_osf.sh hints/dgux.sh hints/dnix.sh + + hints/dynix.sh hints/dynixptx.sh hints/epix.sh hints/esix4.sh + + hints/fps.sh hints/freebsd.sh hints/genix.sh + + hints/greenhills.sh hints/hpux.sh hints/i386.sh + + hints/irix_4.sh hints/irix_5.sh hints/irix_6.sh + + hints/irix_6_2.sh hints/isc.sh hints/isc_2.sh hints/linux.sh + + hints/machten.sh hints/machten_2.sh hints/mips.sh hints/mpc.sh + + hints/mpeix.sh hints/ncr_tower.sh hints/netbsd.sh + + hints/next_3.sh hints/next_3_0.sh hints/opus.sh hints/os2.sh + + hints/powerux.sh hints/sco.sh hints/sco_2_3_0.sh + + hints/sco_2_3_1.sh hints/sco_2_3_2.sh hints/sco_2_3_3.sh + + hints/sco_2_3_4.sh hints/solaris_2.sh hints/stellar.sh + + hints/sunos_4_0.sh hints/sunos_4_1.sh hints/svr4.sh + + hints/ti1500.sh hints/titanos.sh hints/ultrix_4.sh + + hints/unicos.sh hints/unisysdynix.sh hints/utekv.sh + + hints/uts.sh hv.c hv.h installman installperl interp.sym + + keywords.h keywords.pl lib/AnyDBM_File.pm lib/AutoLoader.pm + + lib/AutoSplit.pm lib/Benchmark.pm lib/Carp.pm lib/Cwd.pm + + lib/Devel/SelfStubber.pm lib/DirHandle.pm lib/English.pm + + lib/Env.pm lib/Exporter.pm lib/ExtUtils/Install.pm + + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_OS2.pm + + lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm + + lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm + + lib/ExtUtils/Mkbootstrap.pm lib/ExtUtils/Mksymlists.pm + + lib/ExtUtils/testlib.pm lib/ExtUtils/typemap + + lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/CheckTree.pm + + lib/File/Copy.pm lib/File/Find.pm lib/File/Path.pm + + lib/FileCache.pm lib/Getopt/Long.pm lib/Getopt/Std.pm + + lib/I18N/Collate.pm lib/IPC/Open2.pm lib/IPC/Open3.pm + + lib/Math/BigFloat.pm lib/Math/BigInt.pm lib/Math/Complex.pm + + lib/Net/Ping.pm lib/Pod/Functions.pm lib/Pod/Text.pm + + lib/Search/Dict.pm lib/SelectSaver.pm lib/SelfLoader.pm + + lib/Shell.pm lib/Symbol.pm lib/Sys/Hostname.pm + + lib/Sys/Syslog.pm lib/Term/Cap.pm lib/Term/Complete.pm + + lib/Term/ReadLine.pm lib/Test/Harness.pm lib/Text/Abbrev.pm + + lib/Text/ParseWords.pm lib/Text/Soundex.pm lib/Text/Tabs.pm + + lib/Text/Wrap.pm lib/Tie/Hash.pm lib/Tie/Scalar.pm + + lib/Tie/SubstrHash.pm lib/Time/Local.pm lib/abbrev.pl + + lib/assert.pl lib/bigfloat.pl lib/bigint.pl lib/bigrat.pl + + lib/cacheout.pl lib/chat2.inter lib/chat2.pl lib/complete.pl + + lib/ctime.pl lib/diagnostics.pm lib/dotsh.pl lib/dumpvar.pl + + lib/exceptions.pl lib/fastcwd.pl lib/find.pl lib/finddepth.pl + + lib/flush.pl lib/ftp.pl lib/getcwd.pl lib/getopt.pl + + lib/getopts.pl lib/hostname.pl lib/importenv.pl lib/integer.pm + + lib/less.pm lib/lib.pm lib/look.pl lib/newgetopt.pl + + lib/open2.pl lib/open3.pl lib/overload.pm lib/perl5db.pl + + lib/pwd.pl lib/shellwords.pl lib/sigtrap.pm lib/splain + + lib/stat.pl lib/strict.pm lib/subs.pm lib/syslog.pl + + lib/tainted.pl lib/termcap.pl lib/timelocal.pl lib/validate.pl + + lib/vars.pm makeaperl.SH makedepend.SH makedir.SH malloc.c + + mg.c mg.h minimod.pl miniperlmain.c mv-if-diff myconfig op.c + + op.h opcode.h opcode.pl os2/Makefile.SHs os2/POSIX.mkfifo + + os2/README os2/README.old os2/diff.configure os2/diff.db_file + + os2/notes os2/os2.c os2/os2ish.h os2/perl2cmd.pl patchlevel.h + + perl.c perl.h perl_exp.SH perlsh perly.c perly.c.diff + + perly.fixer perly.h perly.y pod/Makefile pod/buildtoc + + pod/perl.pod pod/perlbook.pod pod/perlbot.pod pod/perlcall.pod + + pod/perldata.pod pod/perldebug.pod pod/perldiag.pod + + pod/perldsc.pod pod/perlembed.pod pod/perlform.pod + + pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod + + pod/perllol.pod pod/perlmod.pod pod/perlobj.pod pod/perlop.pod + + pod/perlovl.pod pod/perlpod.pod pod/perlre.pod pod/perlref.pod + + pod/perlrun.pod pod/perlsec.pod pod/perlstyle.pod + + pod/perlsub.pod pod/perlsyn.pod pod/perltie.pod + + pod/perltoc.pod pod/perltrap.pod pod/perlvar.pod + + pod/perlxs.pod pod/perlxstut.pod pod/pod2html.PL + + pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL pod/roffitall + + pod/splitman pod/splitpod pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c + + proto.h regcomp.c regcomp.h regexec.c regexp.h run.c scope.c + + scope.h sv.c sv.h t/README t/TEST t/base/cond.t t/base/if.t + + t/base/lex.t t/base/pat.t t/base/term.t t/cmd/elsif.t + + t/cmd/for.t t/cmd/mod.t t/cmd/subval.t t/cmd/switch.t + + t/cmd/while.t t/comp/cmdopt.t t/comp/cpp.aux t/comp/cpp.t + + t/comp/decl.t t/comp/multiline.t t/comp/package.t + + t/comp/script.t t/comp/term.t t/harness t/io/argv.t t/io/dup.t + + t/io/fs.t t/io/inplace.t t/io/pipe.t t/io/print.t t/io/tell.t + + t/lib/anydbm.t t/lib/bigint.t t/lib/bigintpm.t + + t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t + + t/lib/dirhand.t t/lib/english.t t/lib/filehand.t t/lib/gdbm.t + + t/lib/ndbm.t t/lib/odbm.t t/lib/posix.t t/lib/safe.t + + t/lib/sdbm.t t/lib/socket.t t/lib/soundex.t t/op/append.t + + t/op/array.t t/op/auto.t t/op/chop.t t/op/cond.t t/op/delete.t + + t/op/do.t t/op/each.t t/op/eval.t t/op/exec.t t/op/exp.t + + t/op/flip.t t/op/fork.t t/op/glob.t t/op/goto.t t/op/groups.t + + t/op/index.t t/op/int.t t/op/join.t t/op/list.t t/op/local.t + + t/op/magic.t t/op/misc.t t/op/mkdir.t t/op/my.t t/op/oct.t + + t/op/ord.t t/op/overload.t t/op/pack.t t/op/pat.t t/op/push.t + + t/op/quotemeta.t t/op/rand.t t/op/range.t t/op/re_tests + + t/op/read.t t/op/readdir.t t/op/ref.t t/op/regexp.t + + t/op/repeat.t t/op/sleep.t t/op/sort.t t/op/split.t + + t/op/sprintf.t t/op/stat.t t/op/study.t t/op/subst.t + + t/op/substr.t t/op/time.t t/op/undef.t t/op/unshift.t + + t/op/vec.t t/op/write.t t/re_tests taint.c toke.c unixish.h + + util.c util.h utils/Makefile utils/c2ph.PL utils/h2ph.PL + + utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL + + vms/Makefile vms/config.vms vms/descrip.mms + + vms/ext/Filespec.pm vms/ext/Stdio/0README.txt + + vms/ext/Stdio/Makefile.PL vms/ext/Stdio/Stdio.pm + + vms/ext/Stdio/Stdio.xs vms/ext/Stdio/test.pl vms/fndvers.com + + vms/gen_shrfls.pl vms/genconfig.pl vms/genopt.com + + vms/make_command.com vms/mms2make.pl vms/myconfig.com + + vms/perlvms.pod vms/perly_c.vms vms/perly_h.vms + + vms/sockadapt.c vms/sockadapt.h vms/test.com vms/vms.c + + vms/vms_yfix.pl vms/vmsish.h vms/writemain.pl writemain.SH + + x2p/EXTERN.h x2p/INTERN.h x2p/Makefile.SH x2p/a2p.c x2p/a2p.h + + x2p/a2p.man x2p/a2p.y x2p/a2py.c x2p/cflags.SH + + x2p/find2perl.PL x2p/handy.h x2p/hash.c x2p/hash.h x2p/s2p.PL + + x2p/s2p.man x2p/str.c x2p/str.h x2p/util.c x2p/util.h + + x2p/walk.c diff --git a/contrib/perl5/Changes5.000 b/contrib/perl5/Changes5.000 new file mode 100644 index 00000000000..78cab26f14c --- /dev/null +++ b/contrib/perl5/Changes5.000 @@ -0,0 +1,185 @@ +------------- +Version 5.000 +------------- + +New things +---------- + The -w switch is much more informative. + + References. See t/op/ref.t for examples. All entities in Perl 5 are + reference counted so that it knows when each item should be destroyed. + + Objects. See t/op/ref.t for examples. + + => is now a synonym for comma. This is useful as documentation for + arguments that come in pairs, such as initializers for associative arrays, + or named arguments to a subroutine. + + All functions have been turned into list operators or unary operators, + meaning the parens are optional. Even subroutines may be called as + list operators if they've already been declared. + + More embeddible. See main.c and embed_h.sh. Multiple interpreters + in the same process are supported (though not with interleaved + execution yet). + + The interpreter is now flattened out. Compare Perl 4's eval.c with + the perl 5's pp.c. Compare Perl 4's 900 line interpreter loop in cmd.c + with Perl 5's 1 line interpreter loop in run.c. Eventually we'll make + everything non-blocking so we can interface nicely with a scheduler. + + eval is now treated more like a subroutine call. Among other things, + this means you can return from it. + + Format value lists may be spread over multiple lines by enclosing in + a do {} block. + + You may now define BEGIN and END subroutines for each package. The BEGIN + subroutine executes the moment it's parsed. The END subroutine executes + just before exiting. + + Flags on the #! line are interpreted even if the script wasn't + executed directly. (And even if the script was located by "perl -x"!) + + The ?: operator is now legal as an lvalue. + + List context now propagates to the right side of && and ||, as well + as the 2nd and 3rd arguments to ?:. + + The "defined" function can now take a general expression. + + Lexical scoping available via "my". eval can see the current lexical + variables. + + The preferred package delimiter is now :: rather than '. + + tie/untie are now preferred to dbmopen/dbmclose. Multiple DBM + implementations are allowed in the same executable, so you can + write scripts to interchange data among different formats. + + New "and" and "or" operators work just like && and || but with + a precedence lower than comma, so they work better with list operators. + + New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst(), + chomp(), glob() + + require with a number checks to see that the version of Perl that is + currently running is at least that number. + + Dynamic loading of external modules is now supported. + + There is a new quote form qw//, which is equivalent to split(' ', q//). + + Assignment of a reference to a glob value now just replaces the + single element of the glob corresponding to the reference type: + *foo = \$bar, *foo = \&bletch; + + Filehandle methods are now supported: + output_autoflush STDOUT 1; + + There is now an "English" module that provides human readable translations + for cryptic variable names. + + Autoload stubs can now call the replacement subroutine with goto &realsub. + + Subroutines can be defined lazily in any package by declaring an AUTOLOAD + routine, which will be called if a non-existent subroutine is called in + that package. + + Several previously added features have been subsumed under the new + keywords "use" and "no". Saying "use Module LIST" is short for + BEGIN { require Module; import Module LIST; } + The "no" keyword is identical except that it calls "unimport" instead. + The earlier pragma mechanism now uses this mechanism, and two new + modules have been added to the library to implement "use integer" + and variations of "use strict vars, refs, subs". + + Variables may now be interpolated literally into a pattern by prefixing + them with \Q, which works just like \U, but backwhacks non-alphanumerics + instead. There is also a corresponding quotemeta function. + + Any quantifier in a regular expression may now be followed by a ? to + indicate that the pattern is supposed to match as little as possible. + + Pattern matches may now be followed by an m or s modifier to explicitly + request multiline or singleline semantics. An s modifier makes . match + newline. + + Patterns may now contain \A to match only at the beginning of the string, + and \Z to match only at the end. These differ from ^ and $ in that + they ignore multiline semantics. In addition, \G matches where the + last interation of m//g or s///g left off. + + Non-backreference-producing parens of various sorts may now be + indicated by placing a ? directly after the opening parenthesis, + followed by a character that indicates the purpose of the parens. + An :, for instance, indicates simple grouping. (?:a|b|c) will + match any of a, b or c without producing a backreference. It does + "eat" the input. There are also assertions which do not eat the + input but do lookahead for you. (?=stuff) indicates that the next + thing must be "stuff". (?!nonsense) indicates that the next thing + must not be "nonsense". + + The negation operator now treats non-numeric strings specially. + A -"text" is turned into "-text", so that -bareword is the same + as "-bareword". If the string already begins with a + or -, it + is flipped to the other sign. + +Incompatibilities +----------------- + @ now always interpolates an array in double-quotish strings. Some programs + may now need to use backslash to protect any @ that shouldn't interpolate. + + Ordinary variables starting with underscore are no longer forced into + package main. + + s'$lhs'$rhs' now does no interpolation on either side. It used to + interplolate $lhs but not $rhs. + + The second and third arguments of splice are now evaluated in scalar + context (like the book says) rather than list context. + + Saying "shift @foo + 20" is now a semantic error because of precedence. + + "open FOO || die" is now incorrect. You need parens around the filehandle. + + The elements of argument lists for formats are now evaluated in list + context. This means you can interpolate list values now. + + You can't do a goto into a block that is optimized away. Darn. + + It is no longer syntactically legal to use whitespace as the name + of a variable, or as a delimiter for any kind of quote construct. + + Some error messages will be different. + + The caller function now returns a false value in a scalar context if there + is no caller. This lets library files determine if they're being required. + + m//g now attaches its state to the searched string rather than the + regular expression. + + "reverse" is no longer allowed as the name of a sort subroutine. + + taintperl is no longer a separate executable. There is now a -T + switch to turn on tainting when it isn't turned on automatically. + + Symbols starting with _ are no longer forced into package main, except + for $_ itself (and @_, etc.). + + Double-quoted strings may no longer end with an unescaped $ or @. + + Negative array subscripts now count from the end of the array. + + The comma operator in a scalar context is now guaranteed to give a + scalar context to its arguments. + + The ** operator now binds more tightly than unary minus. + + Setting $#array lower now discards array elements so that destructors + work reasonably. + + delete is not guaranteed to return the old value for tied arrays, + since this capability may be onerous for some modules to implement. + + Attempts to set $1 through $9 now result in a run-time error. diff --git a/contrib/perl5/Changes5.001 b/contrib/perl5/Changes5.001 new file mode 100644 index 00000000000..c26134a79aa --- /dev/null +++ b/contrib/perl5/Changes5.001 @@ -0,0 +1,1299 @@ +------------- +Version 5.001 +------------- + +Nearly all the changes for 5.001 were bug fixes of one variety or another, +so here's the bug list, along with the "resolution" for each of them. If +you wish to correspond about any of them, please include the bug number. + +There were a few that can be construed as enhancements: + NETaa13059: now warns of use of \1 where $1 is necessary. + NETaa13512: added $SIG{__WARN__} and $SIG{__DIE__} hooks + NETaa13520: added closures + NETaa13530: scalar keys now resets hash iterator + NETaa13641: added Tim's fancy new import whizbangers + NETaa13710: cryptswitch needed to be more "useable" + NETaa13716: Carp now allows multiple packages to be skipped out of + NETaa13716: now counts imported routines as "defined" for redef warnings + (and, of course, much of the stuff from the perl5-porters) + +NETaa12974: README incorrectly said it was a pre-release. +Files patched: README + +NETaa13033: goto pushed a bogus scope on the context stack. +From: Steve Vinoski +Files patched: pp_ctl.c + The goto operator pushed an extra bogus scope onto the context stack. (This + often didn't matter, since many things pop extra unrecognized scopes off.) + +NETaa13034: tried to get valid pointer from undef. +From: Castor Fu +Also: Achille Hui, the Day Dreamer +Also: Eric Arnold +Files patched: pp_sys.c + Now treats undef specially, and calls SvPV_force on any non-numeric scalar + value to get a real pointer to somewhere. + +NETaa13035: included package info with filehandles. +From: Jack Shirazi - BIU +Files patched: pp_hot.c pp_sys.c + Now passes a glob to filehandle methods to keep the package info intact. + +NETaa13048: didn't give strict vars message on every occurrence. +From: Doug Campbell +Files patched: gv.c + It now complains about every occurrence. (The bug resulted from an + ill-conceived attempt to suppress a duplicate error message in a + suboptimal fashion.) + +NETaa13052: test for numeric sort sub return value fooled by taint magic. +From: Peter Jaspers-Fayer +Files patched: pp_ctl.c sv.h + The test to see if the sort sub return value was numeric looked at the + public flags rather than the private flags of the SV, so taint magic + hid that info from the sort. + +NETaa13053: forced a2p to use byacc +From: Andy Dougherty +Files patched: MANIFEST x2p/Makefile.SH x2p/a2p.c + a2p.c is now pre-byacced and shipped with the kit. + +NETaa13055: misnamed constant in previous patch. +From: Conrad Augustin +Files patched: op.c op.h toke.c + The tokener translates $[ to a constant, but with a special marking in case + the constant gets assigned to or localized. Unfortunately, the marking + was done with a combination of OPf_SPECIAL and OPf_MOD that was easily + spoofed. There is now a private OPpCONST_ARYLEN flag for this purpose. + +NETaa13055: use of OPf_SPECIAL for $[ lvaluehood was too fragile. +Files patched: op.c op.h toke.c + (same) + +NETaa13056: convert needs to throw away any number info on its list. +From: Jack Shirazi - BIU +Files patched: op.c + The listiness of the argument list leaked out to the subroutine call because + of how prepend_elem and append_elem reuse an existing list. The convert() + routine just needs to discard any listiness it finds on its argument. + +NETaa13058: AUTOLOAD shouldn't assume size of @_ is meaningful. +From: Florent Guillaume +Files patched: ext/DB_File/DB_File.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/Socket/Socket.pm h2xs.SH + I just deleted the optimization, which is silly anyway since the eventual + subroutine definition is cached. + +NETaa13059: now warns of use of \1 where $1 is necessary. +From: Gustaf Neumann +Files patched: toke.c + Now says + + Can't use \1 to mean $1 in expression at foo line 2 + + along with an explanation in perldiag. + +NETaa13060: no longer warns on attempt to read <> operator's transition state. +From: Chaim Frenkel +Files patched: pp_hot.c + No longer warns on <> operator's transitional state. + +NETaa13140: warning said $ when @ would be more appropriate. +From: David J. MacKenzie +Files patched: op.c pod/perldiag.pod + Now says + + (Did you mean $ or @ instead of %?) + + and added more explanation to perldiag. + +NETaa13149: was reading freed memory to make incorrect error message. +Files patched: pp_ctl.c + It was reading freed memory to make an error message that would be + incorrect in any event because it had the inner filename rather than + the outer. + +NETaa13149: confess was sometimes less informative than croak +From: Jack Shirazi +Files patched: lib/Carp.pm + (same) + +NETaa13150: stderr needs to be STDERR in package +From: Jack Shirazi +Files patched: lib/File/CheckTree.pm + Also fixed pl2pm to translate the filehandles to uppercase. + +NETaa13150: uppercases stdin, stdout and stderr +Files patched: pl2pm + (same) + +NETaa13154: array assignment didn't notice package magic. +From: Brian Reichert +Files patched: pp_hot.c + The list assignment operator looked for only set magic, but set magic is + only on the elements of a magical hash, not on the hash as a whole. I made + the operator look for any magic at all on the target array or hash. + +NETaa13155: &DB::DB left trash on the stack. +From: Thomas Koenig +Files patched: lib/perl5db.pl pp_ctl.c + The call by pp_dbstate() to &DB::DB left trash on the stack. It now + calls DB in list context, and DB returns (). + +NETaa13156: lexical variables didn't show up in debugger evals. +From: Joergen Haegg +Files patched: op.c + The code that searched back up the context stack for the lexical scope + outside the eval only partially took into consideration that there + might be extra debugger subroutine frames that shouldn't be used, and + ended up comparing the wrong statement sequence number to the range of + valid sequence numbers for the scope of the lexical variable. (There + was also a bug fixed in passing that caused the scope of lexical to go + clear to the end of the subroutine even if it was within an inner block.) + +NETaa13157: any request for autoloaded DESTROY should create a null one. +From: Tom Christiansen +Files patched: lib/AutoLoader.pm + If DESTROY.al is not located, it now creates sub DESTROY {} automatically. + +NETaa13158: now preserves $@ around destructors while leaving eval. +From: Tim Bunce +Files patched: pp_ctl.c + Applied supplied patch, except the whole second hunk can be replaced with + + sv_insert(errsv, 0, 0, message, strlen(message)); + +NETaa13160: clarified behavior of split without arguments +From: Harry Edmon +Files patched: pod/perlfunc.pod + Clarified the behavior of split without arguments. + +NETaa13162: eval {} lost list/scalar context +From: Dov Grobgeld +Files patched: op.c + LEAVETRY didn't propagate number to ENTERTRY. + +NETaa13163: clarified documentation of foreach using my variable +From: Tom Christiansen +Files patched: pod/perlsyn.pod + Explained that foreach using a lexical is still localized. + +NETaa13164: the dot detector for the end of formats was over-rambunctious. +From: John Stoffel +Files patched: toke.c + The dot detector for the end of formats was over-rambunctious. It would + pick up any dot that didn't have a space in front of it. + +NETaa13165: do {} while 1 never linked outer block into next chain. +From: Gisle Aas +Files patched: op.c + When the conditional of do {} while 1; was optimized away, it confused the + postfix order construction so that the block that ordinarily sits around the + whole loop was never executed. So when the loop tried to unstack between + iterations, it got the wrong context, and blew away the lexical variables + of the outer scope. Fixed it by introducing a NULL opcode that will be + optimized away later. + +NETaa13167: coercion was looking at public bits rather than private bits. +From: Randal L. Schwartz +Also: Thomas Riechmann +Also: Shane Castle +Files patched: sv.c + There were some bad ifdefs around the various varieties of set*id(). In + addition, tainting was interacting badly with assignment to $> because + sv_2iv() was examining SvPOK rather than SvPOKp, and so couldn't coerce + a string uid to an integer one. + +NETaa13167: had some ifdefs wrong on set*id. +Files patched: mg.c pp_hot.c + (same) + +NETaa13168: relaxed test for comparison of new and old fds +From: Casper H.S. Dik +Files patched: t/lib/posix.t + I relaxed the comparison to just check that the new fd is greater. + +NETaa13169: autoincrement can corrupt scalar value state. +From: Gisle Aas +Also: Tom Christiansen +Files patched: sv.c + It assumed a PV didn't need to be upgraded to become an NV. + +NETaa13169: previous patch could leak a string pointer. +Files patched: sv.c + (same) + +NETaa13170: symbols missing from global.sym +From: Tim Bunce +Files patched: global.sym + Applied suggested patch. + +NETaa13171: \\ in <<'END' shouldn't reduce to \. +From: Randal L. Schwartz +Files patched: toke.c + <<'END' needed to bypass ordinary single-quote processing. + +NETaa13172: 'use integer' turned off magical autoincrement. +From: Erich Rickheit KSC +Files patched: pp.c pp_hot.c + The integer versions of the increment and decrement operators were trying too + hard to be efficient. + +NETaa13172: deleted duplicate increment and decrement code +Files patched: opcode.h opcode.pl pp.c + (same) + +NETaa13173: install should make shared libraries executable. +From: Brian Grossman +Also: Dave Nadler +Also: Eero Pajarre +Files patched: installperl + Now gives permission 555 to any file ending with extension specified by $dlext. + +NETaa13176: ck_rvconst didn't free the const it used up. +From: Nick Duffek +Files patched: op.c + I checked in many random memory leaks under this bug number, since it + was an eval that brought many of them out. + +NETaa13176: didn't delete XRV for temp ref of destructor. +Files patched: sv.c + (same) + +NETaa13176: didn't delete op_pmshort in matching operators. +Files patched: op.c + (same) + +NETaa13176: eval leaked the name of the eval. +Files patched: scope.c + (same) + +NETaa13176: gp_free didn't free the format. +Files patched: gv.c + (same) + +NETaa13176: minor leaks in loop exits and constant subscript optimization. +Files patched: op.c + (same) + +NETaa13176: plugged some duplicate struct allocation memory leaks. +Files patched: perl.c + (same) + +NETaa13176: sv_clear of an FM didn't clear anything. +Files patched: sv.c + (same) + +NETaa13176: tr/// didn't mortalize its return value. +Files patched: pp.c + (same) + +NETaa13177: SCOPE optimization hid line number info +From: David J. MacKenzie +Also: Hallvard B Furuseth +Files patched: op.c + Every pass on the syntax tree has to keep track of the current statement. + Unfortunately, the single-statement block was optimized into a single + statement between the time the variable was parsed and the time the + void code scan was done, so that pass didn't see the OP_NEXTSTATE + operator, because it has been optimized to an OP_NULL. + + Fortunately, null operands remember what they were, so it was pretty easy + to make it set the correct line number anyway. + +NETaa13178: some linux doesn't handle nm well +From: Alan Modra +Files patched: hints/linux.sh + Applied supplied patch. + +NETaa13180: localized slice now pre-extends array +From: Larry Schuler +Files patched: pp.c + A localized slice now pre-extends its array to avoid reallocation during + the scope of the local. + +NETaa13181: m//g didn't keep track of whether previous match matched null. +From: "philippe.verdret" +Files patched: mg.h pp_hot.c + A pattern isn't allowed to match a null string in the same place twice in + a row. m//g wasn't keeping track of whether the previous match matched + the null string. + +NETaa13182: now includes whitespace as a regexp metacharacter. +From: Larry Wall +Files patched: toke.c + scan_const() now counts " \t\n\r\f\v" as metacharacters when scanning a pattern. + +NETaa13183: sv_setsv shouldn't try to clone an object. +From: Peter Gordon +Files patched: sv.c + The sv_mortalcopy() done by the return in STORE called sv_setsv(), + which cloned the object. sv_setsv() shouldn't be in the business of + cloning objects. + +NETaa13184: bogus warning on quoted signal handler name removed. +From: Dan Carson +Files patched: toke.c + Now doesn't complain unless the first non-whitespace character after the = + is an alphabetic character. + +NETaa13186: now croaks on chop($') +From: Casper H.S. Dik +Files patched: doop.c + Now croaks on chop($') and such. + +NETaa13187: "${foo::bar}" now counts as mere delimitation, not as a bareword. +From: Jay Rogers +Files patched: toke.c + "${foo::bar}" now counts as mere delimitation, not as a bareword inside a + reference block. + +NETaa13188: for backward compatibility, looks for "perl -" before "perl". +From: Russell Mosemann +Files patched: toke.c + Now allows non-whitespace characters on the #! line between the "perl" + and the "-". + +NETaa13188: now allows non-whitespace after #!...perl before switches. +Files patched: toke.c + (same) + +NETaa13189: derivative files need to be removed before recreation +From: Simon Leinen +Also: Dick Middleton +Also: David J. MacKenzie +Files patched: embed_h.sh x2p/Makefile.SH + Fixed various little nits as suggested in several messages. + +NETaa13190: certain assignments can spoof pod directive recognizer +From: Ilya Zakharevich +Files patched: toke.c + The lexer now only recognizes pod directives where a statement is expected. + +NETaa13194: now returns undef when there is no curpm. +From: lusol@Dillon.CC.Lehigh.EDU +Files patched: mg.c + Since there was no regexp prior to the "use", it was returning whatever the + last successful match was within the "use", because there was no current + regexp, so it treated it as a normal variable. It now returns undef. + +NETaa13195: semop had one S too many. +From: Joachim Huober +Files patched: opcode.pl + The entry in opcode.pl had one too many S's. + +NETaa13196: always assumes it's a Perl script if -c is used. +From: Dan Carson +Files patched: toke.c + It now will assume it's a Perl script if the -c switch is used. + +NETaa13197: changed implicit -> message to be more understandable. +From: Bruce Barnett +Files patched: op.c pod/perldiag.pod + I changed the error message to be more understandable. It now says + + Can't use subscript on sort... + + +NETaa13201: added OPpCONST_ENTERED flag to properly enter filehandle symbols. +From: E. Jay Berkenbilt +Also: Tom Christiansen +Files patched: op.c op.h toke.c + The grammatical reduction of a print statement didn't properly count + the filehandle as a symbol reference because it couldn't distinguish + between a symbol entered earlier in the program and a symbol entered + for the first time down in the lexer. + +NETaa13203: README shouldn't mention uperl.o any more. +From: Anno Siegel +Files patched: README + +NETaa13204: .= shouldn't warn on uninitialized target. +From: Pete Peterson +Files patched: pp_hot.c + No longer warns on uninitialized target of .= operator. + +NETaa13206: handy macros in XSUB.h +From: Tim Bunce +Files patched: XSUB.h + Added suggested macros. + +NETaa13228: commonality checker didn't treat lexicals as variables. +From: mcook@cognex.com +Files patched: op.c opcode.pl + The list assignment operator tries to avoid unnecessary copies by doing the + assignment directly if there are no common variables on either side of the + equals. Unfortunately, the code that decided that only recognized references + to dynamic variables, not lexical variables. + +NETaa13229: fixed sign stuff for complement, integer coercion. +From: Larry Wall +Files patched: perl.h pp.c sv.c + Fixed ~0 and integer coercions. + +NETaa13230: no longer tries to reuse scratchpad temps if tainting in effect. +From: Luca Fini +Files patched: op.c + I haven't reproduced it, but I believe the problem is the reuse of scratchpad + temporaries between statements. I've made it not try to reuse them if + tainting is in effect. + +NETaa13231: *foo = *bar now prevents typo warnings on "foo" +From: Robin Barker +Files patched: sv.c + Aliasing of the form *foo = *bar is now protected from the typo warnings. + Previously only the *foo = \$bar form was. + +NETaa13235: require BAREWORD now introduces package name immediately. +From: Larry Wall +Files patched: toke.c + require BAREWORD now introduces package name immediately. This lets the + method intuit code work right even though the require hasn't actually run + yet. + +NETaa13289: didn't calculate correctly using arybase. +From: Jared Rhine +Files patched: pp.c pp_hot.c + The runtime code didn't use curcop->cop_arybase correctly. + +NETaa13301: store now throws exception on error +From: Barry Friedman +Files patched: ext/GDBM_File/GDBM_File.xs ext/NDBM_File/NDBM_File.xs ext/ODBM_File/ODBM_File.xs ext/SDBM_File/SDBM_File.xs + Changed warn to croak in ext/*DBM_File/*.xs. + +NETaa13302: ctime now takes Time_t rather than Time_t*. +From: Rodger Anderson +Files patched: ext/POSIX/POSIX.xs + Now declares a Time_t and takes the address of that in CODE. + +NETaa13302: shorter way to do this patch +Files patched: ext/POSIX/POSIX.xs + (same) + +NETaa13304: could feed too large $@ back into croak, whereupon it croaked. +From: Larry Wall +Files patched: perl.c + callist() could feed $@ back into croak with more than a bare %s. (croak() + handles long strings with a bare %s okay.) + +NETaa13305: compiler misoptimized RHS to outside of s/a/print/e +From: Brian S. Cashman +Files patched: op.c + The syntax tree was being misconstructed because the compiler felt that + the RHS was invariant, so it did it outside the s///. + +NETaa13314: assigning mortal to lexical leaks +From: Larry Wall +Files patched: sv.c + In stealing strings, sv_setsv was checking SvPOK to see if it should free + the destination string. It should have been checking SvPVX. + +NETaa13316: wait4pid now recalled when errno == EINTR +From: Robert J. Pankratz +Files patched: pp_sys.c util.c + system() and the close() of a piped open now recall wait4pid if it returned + prematurely with errno == EINTR. + +NETaa13329: needed to localize taint magic +From: Brian Katzung +Files patched: sv.c doio.c mg.c pp_hot.c pp_sys.c scope.c taint.c + Taint magic is now localized better, though I had to resort to a kludge + to allow a value to be both tainted and untainted simultaneously during + the assignment of + + local $foo = $_[0]; + + when $_[0] is a reference to the variable $foo already. + +NETaa13341: clarified interaction of AnyDBM_File::ISA and "use" +From: Ian Phillipps +Files patched: pod/modpods/AnyDBMFile.pod + The doc was misleading. + +NETaa13342: grep and map with block would enter block but never leave it. +From: Ian Phillipps +Files patched: op.c + The compiler use some sort-checking code to handle the arguments of + grep and map. Unfortunately, this wiped out the block exit opcode while + leaving the block entry opcode. This doesn't matter to sort, but did + matter to grep and map. It now leave the block entry intact. + + The reason it worked without the my is because the block entry and exit + were optimized away to an OP_SCOPE, which it doesn't matter if it's there + or not. + +NETaa13343: goto needed to longjmp when in a signal handler. +From: Robert Partington +Files patched: pp_ctl.c + goto needed to longjmp() when in a signal handler to get back into the + right run() context. + + +NETaa13344: strict vars shouldn't apply to globs or filehandles. +From: Andrew Wilcox +Files patched: gv.c + Filehandles and globs will be excepted from "strict vars", so that you can + do the standard Perl 4 trick of + + use strict; + sub foo { + local(*IN); + open(IN,"file"); + } + + +NETaa13345: assert.pl didn't use package DB +From: Hans Mulder +Files patched: lib/assert.pl + Now it does. + +NETaa13348: av_undef didn't free scalar representing $#foo. +From: David Filo +Files patched: av.c + av_undef didn't free scalar representing $#foo. + +NETaa13349: sort sub accumulated save stack entries +From: David Filo +Files patched: pp_ctl.c + COMMON only gets set if assigning to @_, which is reasonable. Most of the + problem was a memory leak. + +NETaa13351: didn't treat indirect filehandles as references. +From: Andy Dougherty +Files patched: op.c + Now produces + + Can't use an undefined value as a symbol reference at ./foo line 3. + + +NETaa13352: OP_SCOPE allocated as UNOP rather than LISTOP. +From: Andy Dougherty +Files patched: op.c + +NETaa13353: scope() didn't release filegv on OP_SCOPE optimization. +From: Larry Wall +Files patched: op.c + When scope() nulled out a NEXTSTATE, it didn't release its filegv reference. + +NETaa13355: hv_delete now avoids useless mortalcopy +From: Larry Wall +Files patched: hv.c op.c pp.c pp_ctl.c proto.h scope.c util.c + hv_delete now avoids useless mortalcopy. + + +NETaa13359: comma operator section missing its heading +From: Larry Wall +Files patched: pod/perlop.pod + +NETaa13359: random typo +Files patched: pod/perldiag.pod + +NETaa13360: code to handle partial vec values was bogus. +From: Conrad Augustin +Files patched: pp.c + The code that Mark J. added a long time ago to handle values that were partially + off the end of the string was incorrect. + +NETaa13361: made it not interpolate inside regexp comments +From: Martin Jost +Files patched: toke.c + To avoid surprising people, it no longer interpolates inside regexp + comments. + +NETaa13362: ${q[1]} should be interpreted like it used to +From: Hans Mulder +Files patched: toke.c + Now resolves ${keyword[1]} to $keyword[1] and warns if -w. Likewise for {}. + +NETaa13363: meaning of repeated search chars undocumented in tr/// +From: Stephen P. Potter +Files patched: pod/perlop.pod + Documented that repeated characters use the first translation given. + +NETaa13365: if closedir fails, don't try it again. +From: Frank Crawford +Files patched: pp_sys.c + Now does not attempt to closedir a second time. + +NETaa13366: can't do block scope optimization on $1 et al when tainting. +From: Andrew Vignaux +Files patched: toke.c + The tainting mechanism assumes that every statement starts out + untainted. Unfortunately, the scope removal optimization for very + short blocks removed the statementhood of statements that were + attempting to read $1 as an untainted value, with the effect that $1 + appeared to be tainted anyway. The optimization is now disabled when + tainting and the block contains $1 (or equivalent). + +NETaa13366: fixed this a better way in toke.c. +Files patched: op.c + (same) + +NETaa13366: need to disable scope optimization when tainting. +Files patched: op.c + (same) + +NETaa13367: Did a SvCUR_set without nulling out final char. +From: "Rob Henderson" +Files patched: doop.c pp.c pp_sys.c + When do_vop set the length on its result string it neglected to null-terminate + it. + +NETaa13368: bigrat::norm sometimes chucked sign +From: Greg Kuperberg +Files patched: lib/bigrat.pl + The normalization routine was assuming that the gcd of two numbers was + never negative, and based on that assumption managed to move the sign + to the denominator, where it was deleted on the assumption that the + denominator is always positive. + +NETaa13368: botched previous patch +Files patched: lib/bigrat.pl + (same) + +NETaa13369: # is now a comment character, and \# should be left for regcomp. +From: Simon Parsons +Files patched: toke.c + It was not skipping the comment when it skipped the white space, and constructed + an opcode that tried to match a null string. Unfortunately, the previous + star tried to use the first character of the null string to optimize where + to recurse, so it never matched. + +NETaa13369: comment after regexp quantifier induced non-match. +Files patched: regcomp.c + (same) + +NETaa13370: some code assumed SvCUR was of type int. +From: Spider Boardman +Files patched: pp_sys.c + Did something similar to the proposed patch. I also fixed the problem that + it assumed the type of SvCUR was int. And fixed get{peer,sock}name the + same way. + +NETaa13375: sometimes dontbother wasn't added back into strend. +From: Jamshid Afshar +Files patched: regexec.c + When the /g modifier was used, the regular expression code would calculate + the end of $' too short by the minimum number of characters the pattern could + match. + +NETaa13375: sv_setpvn now disallows negative length. +Files patched: sv.c + (same) + +NETaa13376: suspected indirect objecthood prevented recognition of lexical. +From: Gisle.Aas@nr.no +Files patched: toke.c + When $data[0] is used in a spot that might be an indirect object, the lexer + was getting confused over the rule that says the $data in $$data[0] isn't + an array element. (The lexer uses XREF state for both indirect objects + and for variables used as names.) + +NETaa13377: -I processesing ate remainder of #! line. +From: Darrell Schiebel +Files patched: perl.c + I made the -I processing in moreswitches look for the end of the string, + delimited by whitespace. + +NETaa13379: ${foo} now treated the same outside quotes as inside +From: Hans Mulder +Files patched: toke.c + ${bareword} is now treated the same outside quotes as inside. + +NETaa13379: previous fix for this bug was botched +Files patched: toke.c + (same) + +NETaa13381: TEST should check for perl link +From: Andy Dougherty +Files patched: t/TEST + die "You need to run \"make test\" first to set things up.\n" unless -e 'perl'; + + +NETaa13384: fixed version 0.000 botch. +From: Larry Wall +Files patched: installperl + +NETaa13385: return 0 from required file loses message +From: Malcolm Beattie +Files patched: pp_ctl.c + Works right now. + +NETaa13387: added pod2latex +From: Taro KAWAGISHI +Files patched: MANIFEST pod/pod2latex + Added most recent copy to pod directory. + +NETaa13388: constant folding now prefers integer results over double +From: Ilya Zakharevich +Files patched: op.c + Constant folding now prefers integer results over double. + +NETaa13389: now treats . and exec as shell metathingies +From: Hans Mulder +Files patched: doio.c + Now treats . and exec as shell metathingies. + +NETaa13395: eval didn't check taintedness. +From: Larry Wall +Files patched: pp_ctl.c + +NETaa13396: $^ coredumps at end of string +From: Paul Rogers +Files patched: toke.c + The scan_ident() didn't check for a null following $^. + +NETaa13397: improved error messages when operator expected +From: Larry Wall +Files patched: toke.c + Added message (Do you need to predeclare BAR?). Also fixed the missing + semicolon message. + +NETaa13399: cleanup by Andy +From: Larry Wall +Files patched: Changes Configure Makefile.SH README cflags.SH config.H config_h.SH deb.c doop.c dump.c ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/POSIX/POSIX.pm ext/SDBM_File/sdbm/sdbm.h ext/Socket/Socket.pm ext/util/make_ext h2xs.SH hints/aix.sh hints/bsd386.sh hints/dec_osf.sh hints/esix4.sh hints/freebsd.sh hints/irix_5.sh hints/next_3_2.sh hints/sunos_4_1.sh hints/svr4.sh hints/ultrix_4.sh installperl lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/Term/Cap.pm mg.c miniperlmain.c perl.c perl.h perl_exp.SH pod/Makefile pod/perldiag.pod pod/pod2html pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h sv.h t/re_tests util.c x2p/Makefile.SH x2p/a2p.h x2p/a2py.c x2p/handy.h x2p/hash.c x2p/hash.h x2p/str.c x2p/str.h x2p/util.c x2p/util.h x2p/walk.c + +NETaa13399: cleanup from Andy +Files patched: MANIFEST + +NETaa13399: configuration cleanup +Files patched: Configure Configure MANIFEST MANIFEST Makefile.SH Makefile.SH README config.H config.H config_h.SH config_h.SH configpm ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_hpux.xs ext/NDBM_File/Makefile.PL ext/ODBM_File/Makefile.PL ext/util/make_ext handy.h hints/aix.sh hints/hpux_9.sh hints/hpux_9.sh hints/irix_4.sh hints/linux.sh hints/mpeix.sh hints/next_3_2.sh hints/solaris_2.sh hints/svr4.sh installperl installperl lib/AutoSplit.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/Getopt/Long.pm lib/Text/Tabs.pm makedepend.SH makedepend.SH mg.c op.c perl.h perl_exp.SH pod/perl.pod pod/perldiag.pod pod/perlsyn.pod pod/pod2man pp_sys.c proto.h proto.h unixish.h util.c util.c vms/config.vms writemain.SH x2p/a2p.h x2p/a2p.h x2p/a2py.c x2p/a2py.c x2p/handy.h x2p/util.c x2p/walk.c x2p/walk.c + +NETaa13399: new files from Andy +Files patched: ext/DB_File/Makefile.PL ext/DynaLoader/Makefile.PL ext/Fcntl/Makefile.PL ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/ODBM_File/Makefile.PL ext/POSIX/Makefile.PL ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL ext/Socket/Makefile.PL globals.c hints/convexos.sh hints/irix_6.sh + +NETaa13399: patch0l from Andy +Files patched: Configure MANIFEST Makefile.SH config.H config_h.SH ext/DB_File/Makefile.PL ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/Makefile.PL ext/util/make_ext h2xs.SH hints/next_3_2.sh hints/solaris_2.sh hints/unicos.sh installperl lib/Cwd.pm lib/ExtUtils/MakeMaker.pm makeaperl.SH vms/config.vms x2p/util.c x2p/util.h + +NETaa13399: stuff from Andy +Files patched: Configure MANIFEST Makefile.SH configpm hints/dec_osf.sh hints/linux.sh hints/machten.sh lib/ExtUtils/MakeMaker.pm util.c + +NETaa13399: Patch 0k from Andy +Files patched: Configure MANIFEST Makefile.SH config.H config_h.SH hints/dec_osf.sh hints/mpeix.sh hints/next_3_0.sh hints/ultrix_4.sh installperl lib/ExtUtils/MakeMaker.pm lib/File/Path.pm makeaperl.SH minimod.PL perl.c proto.h vms/config.vms vms/ext/MM_VMS.pm x2p/a2p.h + +NETaa13399: Patch 0m from Andy +Files patched: Configure MANIFEST Makefile.SH README config.H config_h.SH ext/DynaLoader/README ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/sdbm.h ext/util/extliblist hints/cxux.sh hints/linux.sh hints/powerunix.sh lib/ExtUtils/MakeMaker.pm malloc.c perl.h pp_sys.c util.c + +NETaa13400: pod2html update from Bill Middleton +From: Larry Wall +Files patched: pod/pod2html + +NETaa13401: Boyer-Moore code attempts to compile string longer than 255. +From: Kyriakos Georgiou +Files patched: util.c + The Boyer-Moore table uses unsigned char offsets, but the BM compiler wasn't + rejecting strings longer than 255 chars, and was miscompiling them. + +NETaa13403: missing a $ on variable name +From: Wayne Scott +Files patched: installperl + Yup, it was missing. + +NETaa13406: didn't wipe out dead match when proceeding to next BRANCH +From: Michael P. Clemens +Files patched: regexec.c + The code to check alternatives didn't invalidate backreferences matched by the + failed branch. + +NETaa13407: overload upgrade +From: owner-perl5-porters@nicoh.com +Also: Ilya Zakharevich +Files patched: MANIFEST gv.c lib/Math/BigInt.pm perl.h pod/perlovl.pod pp.c pp.h pp_hot.c sv.c t/lib/bigintpm.t t/op/overload.t + Applied supplied patch, and fixed bug induced by use of sv_setsv to do + a deep copy, since sv_setsv no longer copies objecthood. + +NETaa13409: sv_gets tries to grow string at EOF +From: Harold O Morris +Files patched: sv.c + Applied suggested patch, only two statements earlier, since the end code + also does SvCUR_set. + +NETaa13410: delaymagic did =~ instead of &= ~ +From: Andreas Schwab +Files patched: pp_hot.c + Applied supplied patch. + +NETaa13411: POSIX didn't compile under -DLEAKTEST +From: Frederic Chauveau +Files patched: ext/POSIX/POSIX.xs + Used NEWSV instead of newSV. + +NETaa13412: new version from Tony Sanders +From: Tony Sanders +Files patched: lib/Term/Cap.pm + Installed as Term::Cap.pm + +NETaa13413: regmust extractor needed to restart loop on BRANCH for (?:) to work +From: DESARMENIEN +Files patched: regcomp.c + The BRANCH skipper should have restarted the loop from the top. + +NETaa13414: the check for accidental list context was done after pm_short check +From: Michael H. Coen +Files patched: pp_hot.c + Moved check for accidental list context to before the pm_short optimization. + +NETaa13418: perlre.pod babbled nonsense about | in character classes +From: Philip Hazel +Files patched: pod/perlre.pod + Removed bogus brackets. Now reads: + Note however that "|" is interpreted as a literal with square brackets, + so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>. + +NETaa13419: need to document introduction of lexical variables +From: "Heading, Anthony" +Files patched: pod/perlfunc.pod + Now mentions that lexicals aren't introduced till after the current statement. + +NETaa13420: formats that overflowed a page caused endless top of forms +From: Hildo@CONSUL.NL +Files patched: pp_sys.c + If a record is too large to fit on a page, it now prints whatever will + fit and then calls top of form again on the remainder. + +NETaa13423: the code to do negative list subscript in scalar context was missing +From: Steve McDougall +Files patched: pp.c + The negative subscript code worked right in list context but not in scalar + context. In fact, there wasn't code to do it in the scalar context. + +NETaa13424: existing but undefined CV blocked inheritance +From: Spider Boardman +Files patched: gv.c + Applied supplied patch. + +NETaa13425: removed extra argument to croak +From: "R. Bernstein" +Files patched: regcomp.c + Removed extra argument. + +NETaa13427: added return types +From: "R. Bernstein" +Files patched: x2p/a2py.c + Applied suggested patch. + +NETaa13427: added static declarations +Files patched: x2p/walk.c + (same) + +NETaa13428: split was assuming that all backreferences were defined +From: Dave Schweisguth +Files patched: pp.c + split was assuming that all backreferences were defined. + +NETaa13430: hoistmust wasn't hoisting anchored shortcircuit's length +From: Tom Christiansen +Also: Rob Hooft +Files patched: toke.c + +NETaa13432: couldn't call code ref under debugger +From: Mike Fletcher +Files patched: op.c pp_hot.c sv.h + The debugging code assumed it could remember a name to represent a subroutine, + but anonymous subroutines don't have a name. It now remembers a CV reference + in that case. + +NETaa13435: 1' dumped core +From: Larry Wall +Files patched: toke.c + Didn't check a pointer for nullness. + +NETaa13436: print foo(123) didn't treat foo as subroutine +From: mcook@cognex.com +Files patched: toke.c + Now treats it as a subroutine rather than a filehandle. + +NETaa13437: &$::foo didn't think $::foo was a variable name +From: mcook@cognex.com +Files patched: toke.c + Now treats $::foo as a global variable. + +NETaa13439: referred to old package name +From: Tom Christiansen +Files patched: lib/Sys/Syslog.pm + Wasn't a strict refs problem after all. It was simply referring to package + syslog, which had been renamed to Sys::Syslog. + +NETaa13440: stat operations didn't know what to do with glob or ref to glob +From: mcook@cognex.com +Files patched: doio.c pp_sys.c + Now knows about the kinds of filehandles returned by FileHandle constructors + and such. + +NETaa13442: couldn't find name of copy of deleted symbol table entry +From: Spider Boardman +Files patched: gv.c gv.h + I did a much simpler fix. When gp_free notices that it's freeing the + master GV, it nulls out gp_egv. The GvENAME and GvESTASH macros know + to revert to gv if egv is null. + + This has the advantage of not creating a reference loop. + +NETaa13443: couldn't override an XSUB +From: William Setzer +Files patched: op.c + When the newSUB and newXS routines checked for whether the old sub was + defined, they only looked at CvROOT(cv), not CvXSUB(cv). + +NETaa13443: needed to do same thing in newXS +Files patched: op.c + (same) + +NETaa13444: -foo now doesn't warn unless sub foo is defined +From: Larry Wall +Files patched: toke.c + Made it not warn on -foo, unless there is a sub foo defined. + +NETaa13451: in scalar context, pp_entersub now guarantees one item from XSUB +From: Nick Gianniotis +Files patched: pp_hot.c + The pp_entersub routine now guarantees that an XSUB in scalar context + returns one and only one value. If there are fewer, it pushes undef, + and if there are more, it returns the last one. + +NETaa13457: now explicitly disallows printf format with 'n' or '*'. +From: lees@cps.msu.edu +Files patched: doop.c + Now says + + Use of n in printf format not supported at ./foo line 3. + + +NETaa13458: needed to call SvPOK_only() in pp_substr +From: Wayne Scott +Files patched: pp.c + Needed to call SvPOK_only() in pp_substr. + +NETaa13459: umask and chmod now warn about missing initial 0 even with paren +From: Andreas Koenig +Files patched: toke.c + Now skips parens as well as whitespace looking for argument. + +NETaa13460: backtracking didn't work on .*? because reginput got clobbered +From: Andreas Koenig +Files patched: regexec.c + When .*? did a probe of the rest of the string, it clobbered reginput, + so the next call to match a . tried to match the newline and failed. + +NETaa13475: \(@ary) now treats array as list of scalars +From: Tim Bunce +Files patched: op.c + The mod() routine now refrains from marking @ary as an lvalue if it's in parens + and is the subject of an OP_REFGEN. + +NETaa13481: accept buffer wasn't aligned good enough +From: Holger Bechtold +Also: Christian Murphy +Files patched: pp_sys.c + Applied suggested patch. + +NETaa13486: while (<>) now means while (defined($_ = <>)) +From: Jim Balter +Files patched: op.c pod/perlop.pod + while () now means while (defined($_ = )). + +NETaa13500: needed DESTROY in FileHandle +From: Tim Bunce +Files patched: ext/POSIX/POSIX.pm + Added DESTROY method. Also fixed ungensym to use POSIX:: instead of _POSIX. + Removed ungensym from close method, since DESTROY should do that now. + +NETaa13502: now complains if you use local on a lexical variable +From: Larry Wall +Files patched: op.c + Now says something like + + Can't localize lexical variable $var at ./try line 6. + +NETaa13512: added $SIG{__WARN__} and $SIG{__DIE__} hooks +From: Larry Wall +Files patched: embed.h gv.c interp.sym mg.c perl.h pod/perlvar.pod pp_ctl.c util.c Todo pod/perldiag.pod + +NETaa13514: statements before intro of lex var could see lex var +From: William Setzer +Files patched: op.c + When a lexical variable is declared, introduction is delayed until + the start of the next statement, so that any initialization code runs + outside the scope of the new variable. Thus, + + my $y = 3; + my $y = $y; + print $y; + + should print 3. Unfortunately, the declaration was marked with the + beginning location at the time that "my $y" was processed instead of + when the variable was introduced, so any embedded statements within + an anonymous subroutine picked up the wrong "my". The declaration + is now labelled correctly when the variable is actually introduced. + +NETaa13520: added closures +From: Larry Wall +Files patched: Todo cv.h embed.h global.sym gv.c interp.sym op.c perl.c perl.h pod/perlform.pod pp.c pp_ctl.c pp_hot.c sv.c sv.h toke.c + +NETaa13520: test to see if lexical works in a format now +Files patched: t/op/write.t + +NETaa13522: substitution couldn't be used on a substr() +From: Hans Mulder +Files patched: pp_ctl.c pp_hot.c + Changed pp_subst not to use sv_replace() anymore, which didn't handle lvalues + and was overkill anyway. Should be slightly faster this way too. + +NETaa13525: G_EVAL mode in perl_call_sv didn't return values right. +Files patched: perl.c + +NETaa13525: consolidated error message +From: Larry Wall +Files patched: perl.h toke.c + +NETaa13525: derived it +Files patched: perly.h + +NETaa13525: missing some values from embed.h +Files patched: embed.h + +NETaa13525: random cleanup +Files patched: MANIFEST Todo cop.h lib/TieHash.pm lib/perl5db.pl opcode.h patchlevel.h pod/perldata.pod pod/perlsub.pod t/op/ref.t toke.c + +NETaa13525: random cleanup +Files patched: pp_ctl.c util.c + +NETaa13527: File::Find needed to export $name and $dir +From: Chaim Frenkel +Files patched: lib/File/Find.pm + They are now exported. + +NETaa13528: cv_undef left unaccounted-for GV pointer in CV +From: Tye McQueen +Also: Spider Boardman +Files patched: op.c + +NETaa13530: scalar keys now resets hash iterator +From: Tim Bunce +Files patched: doop.c + scalar keys() now resets the hash iterator. + +NETaa13531: h2ph doesn't check defined right +From: Casper H.S. Dik +Files patched: h2ph.SH + +NETaa13540: VMS update +From: Larry Wall +Files patched: MANIFEST README.vms doio.c embed.h ext/DynaLoader/dl_vms.xs interp.sym lib/Cwd.pm lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Find.pm lib/File/Path.pm mg.c miniperlmain.c perl.c perl.h perly.c perly.c.diff pod/perldiag.pod pp_ctl.c pp_hot.c pp_sys.c proto.h util.c vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Filespec.pm vms/ext/MM_VMS.pm vms/ext/VMS/stdio/Makefile.PL vms/ext/VMS/stdio/stdio.pm vms/ext/VMS/stdio/stdio.xs vms/genconfig.pl vms/perlvms.pod vms/sockadapt.c vms/sockadapt.h vms/vms.c vms/vmsish.h vms/writemain.pl + +NETaa13540: got some duplicate code +Files patched: lib/File/Path.pm + +NETaa13540: stuff from Charles +Files patched: MANIFEST README.vms lib/ExtUtils/MakeMaker.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Path.pm perl.c perl.h pod/perldiag.pod pod/perldiag.pod vms/Makefile vms/Makefile vms/config.vms vms/config.vms vms/descrip.mms vms/descrip.mms vms/ext/Filespec.pm vms/ext/Filespec.pm vms/ext/MM_VMS.pm vms/ext/MM_VMS.pm vms/ext/VMS/stdio/stdio.pm vms/ext/VMS/stdio/stdio.xs vms/gen_shrfls.pl vms/gen_shrfls.pl vms/genconfig.pl vms/genconfig.pl vms/mms2make.pl vms/perlvms.pod vms/sockadapt.h vms/test.com vms/vms.c vms/vms.c vms/vmsish.h vms/vmsish.h vms/writemain.pl + +NETaa13540: tweak from Charles +Files patched: lib/File/Path.pm + +NETaa13552: scalar unpack("P4",...) ignored the 4 +From: Eric Arnold +Files patched: pp.c + The optimization that tried to do only one item in a scalar context didn't + realize that the argument to P was not a repeat count. + +NETaa13553: now warns about 8 or 9 in octal escapes +From: Mike Rogers +Files patched: util.c + Now warns if it finds 8 or 9 before the end of the octal escape sequence. + So \039 produces a warning, but \0339 does not. + +NETaa13554: now allows foreach ${"name"} +From: Johan Holtman +Files patched: op.c + Instead of trying to remove OP_RV2SV, the compiler now just transmutes it into an + OP_RV2GV, which is a no-op for ordinary variables and does the right + thing for ${"name"}. + +NETaa13559: substitution now always checks for readonly +From: Rodger Anderson +Files patched: pp_hot.c + Substitution now always checks for readonly. + +NETaa13561: added explanations of closures and curly-quotes +From: Larry Wall +Files patched: pod/perlref.pod + +NETaa13562: null components in path cause indigestion +From: Ambrose Kofi Laing +Files patched: lib/Cwd.pm lib/pwd.pl + +NETaa13575: documented semantics of negative substr length +From: Jeff Bouis +Files patched: pod/perlfunc.pod + Documented the fact that negative length now leaves characters off the end, + and while I was at it, made it work right even if offset wasn't 0. + +NETaa13575: negative length to substr didn't work when offset non-zero +Files patched: pp.c + (same) + +NETaa13575: random cleanup +Files patched: pod/perlfunc.pod + (same) + +NETaa13580: couldn't localize $ACCUMULATOR +From: Larry Wall +Files patched: gv.c lib/English.pm mg.c perl.c sv.c + Needed to make $^A a real magical variable. Also lib/English.pm wasn't + exporting good. + +NETaa13583: doc mods from Tom +From: Larry Wall +Files patched: pod/modpods/AnyDBMFile.pod pod/modpods/Basename.pod pod/modpods/Benchmark.pod pod/modpods/Cwd.pod pod/modpods/Dynaloader.pod pod/modpods/Exporter.pod pod/modpods/Find.pod pod/modpods/Finddepth.pod pod/modpods/Getopt.pod pod/modpods/MakeMaker.pod pod/modpods/Open2.pod pod/modpods/POSIX.pod pod/modpods/Ping.pod pod/modpods/less.pod pod/modpods/strict.pod pod/perlapi.pod pod/perlbook.pod pod/perldata.pod pod/perlform.pod pod/perlfunc.pod pod/perlipc.pod pod/perlmod.pod pod/perlobj.pod pod/perlref.pod pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod pod/perltrap.pod pod/perlvar.pod + +NETaa13589: return was enforcing list context on its arguments +From: Tim Freeman +Files patched: opcode.pl + A return was being treated like a normal list operator, in that it was + setting list context on its arguments. This was bogus. + +NETaa13591: POSIX::creat used wrong argument +From: Paul Marquess +Files patched: ext/POSIX/POSIX.pm + Applied suggested patch. + +NETaa13605: use strict refs error message now displays bad ref +From: Peter Gordon +Files patched: perl.h pod/perldiag.pod pp.c pp_hot.c + Now says + + Can't use string ("2") as a HASH ref while "strict refs" in use at ./foo line 12. + +NETaa13630: eof docs were unclear +From: Hallvard B Furuseth +Files patched: pod/perlfunc.pod + Applied suggested patch. + +NETaa13636: $< and $> weren't refetched on undump restart +From: Steve Pearlmutter +Files patched: perl.c + The code in main() bypassed perl_construct on an undump restart, which bypassed + the code that set $< and $>. + +NETaa13641: added Tim's fancy new import whizbangers +From: Tim Bunce +Files patched: lib/Exporter.pm + Applied suggested patch. + +NETaa13649: couldn't AUTOLOAD a symbol reference +From: Larry Wall +Files patched: pp_hot.c + pp_entersub needed to guarantee a CV so it would get to the AUTOLOAD code. + +NETaa13651: renamed file had wrong package name +From: Andreas Koenig +Files patched: lib/File/Path.pm + Applied suggested patch. + +NETaa13660: now that we're testing distribution we can diagnose RANDBITS errors +From: Karl Glazebrook +Files patched: t/op/rand.t + Changed to suggested algorithm. Also duplicated it to test rand(100) too. + +NETaa13660: rand.t didn't test for proper distribution within range +Files patched: t/op/rand.t + (same) + +NETaa13671: array slice misbehaved in a scalar context +From: Tye McQueen +Files patched: pp.c + A spurious else prevented the scalar-context-handling code from running. + +NETaa13672: filehandle constructors in POSIX don't return failure successfully +From: Ian Phillipps +Files patched: ext/POSIX/POSIX.pm + Applied suggested patch. + + +NETaa13678: forced $1 to always be untainted +From: Ka-Ping Yee +Files patched: mg.c + I believe the bug that triggered this was fixed elsewhere, but just in case, + I put in explicit code to force $1 et al not to be tainted regardless. + +NETaa13682: formline doc need to discuss ~ and ~~ policy +From: Peter Gordon +Files patched: pod/perlfunc.pod + +NETaa13686: POSIX::open and POSIX::mkfifo didn't check tainting +From: Larry Wall +Files patched: ext/POSIX/POSIX.xs + open() and mkfifo() now check tainting. + +NETaa13687: new Exporter.pm +From: Tim Bunce +Files patched: lib/Exporter.pm + Added suggested changes, except for @EXPORTABLE, because it looks too much + like @EXPORTTABLE. Decided to stick with @EXPORT_OK because it looks more + like an adjunct. Also added an export_tags routine. The keys in the + %EXPORT_TAGS hash no longer use colons, to make the initializers prettier. + +NETaa13687: new Exporter.pm +Files patched: ext/POSIX/POSIX.pm + (same) + +NETaa13694: add sockaddr_in to Socket.pm +From: Tim Bunce +Files patched: ext/Socket/Socket.pm + Applied suggested patch. + +NETaa13695: library routines should use qw() as good example +From: Dean Roehrich +Files patched: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/POSIX/POSIX.pm ext/Socket/Socket.pm + Applied suggested patch. + +NETaa13696: myconfig should be a routine in Config.pm +From: Kenneth Albanowski +Files patched: configpm + Applied suggested patch. + +NETaa13704: fdopen closed fd on failure +From: Hallvard B Furuseth +Files patched: doio.c + Applied suggested patch. + +NETaa13706: Term::Cap doesn't work +From: Dean Roehrich +Files patched: lib/Term/Cap.pm + Applied suggested patch. + +NETaa13710: cryptswitch needed to be more "useable" +From: Tim Bunce +Files patched: embed.h global.sym perl.h toke.c + The cryptswitch_fp function now can operate in two modes. It can + modify the global rsfp to redirect input as before, or it can modify + linestr and return true, indicating that it is not necessary for yylex + to read another line since cryptswitch_fp has just done it. + +NETaa13712: new_tmpfile() can't be called as constructor +From: Hans Mulder +Files patched: ext/POSIX/POSIX.xs + Now allows new_tmpfile() to be called as a constructor. + +NETaa13714: variable method call not documented +From: "Randal L. Schwartz" +Files patched: pod/perlobj.pod + Now indicates that OBJECT->$method() works. + +NETaa13715: PACK->$method produces spurious warning +From: Larry Wall +Files patched: toke.c + The -> operator was telling the lexer to expect an operator when the + next thing was a variable. + +NETaa13716: Carp now allows multiple packages to be skipped out of +From: Larry Wall +Files patched: lib/Carp.pm + The subroutine redefinition warnings now warn on import collisions. + +NETaa13716: Exporter catches warnings and gives a better line number +Files patched: lib/Exporter.pm + (same) + +NETaa13716: now counts imported routines as "defined" for redef warnings +Files patched: op.c sv.c + (same) diff --git a/contrib/perl5/Changes5.002 b/contrib/perl5/Changes5.002 new file mode 100644 index 00000000000..6382d529175 --- /dev/null +++ b/contrib/perl5/Changes5.002 @@ -0,0 +1,4003 @@ +------------- +Version 5.002 +------------- + +The main enhancement to the Perl core was the addition of prototypes. +Many of the modules that come with Perl have been extensively upgraded. + +Other than that, nearly all the changes for 5.002 were bug fixes of one +variety or another, so here's the bug list, along with the "resolution" +for each of them. If you wish to correspond about any of them, please +include the bug number (if any). + +Changes specific to the Configure and build process are described +at the bottom. + +Added APPLLIB_EXP for embedded perl library support. +Files patched: perl.c + +Couldn't define autoloaded routine by assignment to typeglob. +Files patched: pp_hot.c sv.c + +NETaa13525: Tiny patch to fix installman -n +From: Larry Wall +Files patched: installman + +NETaa13525: de-documented \v +Files patched: pod/perlop.pod pod/perlre.pod + +NETaa13525: doc changes +Files patched: pod/perlop.pod pod/perltrap.pod + +NETaa13525: perlxs update from Dean Roehrich +Files patched: pod/perlxs.pod + +NETaa13525: rename powerunix to powerux +Files patched: MANIFEST hints/powerux.sh + +NETaa13540: VMS uses CLK_TCK for HZ +Files patched: pp_sys.c + +NETaa13721: pad_findlex core dumps on bad CvOUTSIDE() +From: Carl Witty +Files patched: op.c sv.c toke.c + Each CV has a reference to the CV containing it lexically. Unfortunately, + it didn't reference-count this reference, so when the outer CV was freed, + we ended up with a pointer to memory that got reused later as some other kind + of SV. + +NETaa13721: warning suppression +Files patched: toke.c + (same) + +NETaa13722: walk.c had inconsistent static declarations +From: Tim Bunce +Files patched: x2p/walk.c + Consolidated the various declarations and made them consistent with + the actual definitions. + +NETaa13724: -MPackage=args patch +From: Tim Bunce +Files patched: perl.c pod/perlrun.pod + Added in the -MPackage=args patch too. + +NETaa13729: order-of-evaluation dependency in scope.c on leaving REGCONTEXT +From: "Jason Shirk" +Files patched: scope.c + Did + + I32 delta = SSPOPINT; + savestack_ix -= delta; /* regexp must have croaked */ + + instead. + +NETaa13731: couldn't assign external lexical array to itself +From: oneill@cs.sfu.ca +Files patched: op.c + The pad_findmy routine was only checking previous statements for previous + mention of external lexicals, so the fact that the current statement + already mentioned @list was not noted. It therefore allocated another + reference to the outside lexical, and this didn't compare equal when + the assigment parsing code was trying to determine whether there was a + common variable on either side of the equals. Since it didn't see the + same variable, it thought it could avoid making copies of the values on + the stack during list assignment. Unfortunately, before using those + values, the list assignment has to zero out the target array, which + destroys the values. + + The fix was to make pad_findmy search the current statement as well. This + was actually a holdover from some old code that was trying to delay + introduction of "my" variables until the next statement. This is now + done with a different mechanism, so the fix should not adversely affect + that. + +NETaa13733: s/// doesn't free old string when using copy mode +From: Larry Wall +Files patched: pp_ctl.c pp_hot.c + When I removed the use of sv_replace(), I simply forgot to free the old char*. + +NETaa13736: closures leaked memory +From: Carl Witty +Files patched: op.c pp.c + This is a specific example of a more general bug, fixed as NETaa13760, having + to do with reference counts on comppads. + +NETaa13739: XSUB interface caches gimme in case XSUB clobbers it +From: Dean Roehrich +Files patched: pp_hot.c + Applied suggest patch. Also deleted second gimme declaration as redundant. + +NETaa13760: comppad reference counts were inconsistent +From: Larry Wall +Files patched: op.c perl.c pp_ctl.c toke.c + All official references to comppads are supposed to be through compcv now, + but the transformation was not complete, resulting in memory leakage. + +NETaa13761: sv_2pv() wrongly preferred IV to NV when SV was readonly +From: "Jack R. Lawler" +Files patched: sv.c + Okay, I understand how this one happened. This is a case where a + beneficial fix uncovered a bug elsewhere. I changed the constant + folder to prefer integer results over double if the numbers are the + same. In this case, they aren't, but it leaves the integer value there + anyway because the storage is already allocated for it, and it *might* + be used in an integer context. And since it's producing a constant, it + sets READONLY. Unfortunately, sv_2pv() bogusly preferred the integer + value to the double when READONLY was set. This never showed up if you + just said + + print 1.4142135623731; + + because in that case, there was already a string value. + + +NETaa13772: shmwrite core dumps consistently +From: Gabe Schaffer +Files patched: opcode.h opcode.pl + The shmwrite operator is a list operator but neglected to push a stack + mark beforehand, because an 'm' was missing from opcode.pl. + +NETaa13773: $. was misdocumented as read-only. +From: Inaba Hiroto +Files patched: pod/perlvar.pod + <1.array-element-read-only> + % perl -le '$,=", "; $#w=5; for (@w) { $_=1; } print @w' + Modification of a read-only value attempted at -e line 1. + % perl4 -le '$,=", "; $#w=5; for (@w) { $_=1; } print @w' + 1, 1, 1, 1, 1, 1 + + This one may stay the way it is for performance reasons. + + <2.begin-local-RS> + % cat abc + a + b + c + % perl -e 'BEGIN { local $/ = ""; } print "$.:$_" while <>;' abc + 1:a + b + c + % perl -e '{ local $/ = ""; } print "$.:$_" while <>;' abc + 1:a + 2:b + 3:c + + $/ wasn't initialized early enough, so local set it back to permanently + undefined on exit from the block. + + <3.grep-x0-bug> + % perl -le 'print grep(/^-/ ? ($x=$_) x 0 : 1, "a", "-b", "c");' + a + + % perl4 -le 'print grep(/^-/ ? ($x=$_) x 0 : 1, "a", "-b", "c");' + ac + + An extra mark was left on the stack if (('x') x $repeat) was used in a scalar + context. + + <4.input-lineno-assign> + # perl -w does not complain about assignment to $. (Is this just a feature?) + # perlvar.pod says "This variable should be considered read-only." + % cat abc + a + b + c + % perl -wnle '$. = 10 if $. == 2; print "$.:$_"' abc + 1:a + 10:b + 11:c + + Fixed doc. + + <5.local-soft-ref.bug> + % perl -e 'local ${"a"}=1;' + zsh: 529 segmentation fault perl -e 'local ${"a"}=1;' + + Now says + Can't localize a reference at -e line 1. + + <6.package-readline> + % perl -e 'package foo; sub foo { 1; } package main; $_ = foo::foo(); print' + 1 + % perl -e ' + package readline; sub foo { 1; } package main; $_ = readline::foo(); print' + Undefined subroutine &main::foo called at -e line 1. + % perl -e ' + package readline; sub foo { 1; } package main; $_ = &readline::foo(); print' + 1 + + Now treats foo::bar correctly even if foo is a keyword. + + <7.page-head-set-to-null-string> + % cat page-head + #From: russell@ccu1.auckland.ac.nz (Russell Fulton) + #Newsgroups: comp.lang.perl + #Subject: This script causes Perl 5.00 to sementation fault + #Date: 15 Nov 1994 00:11:37 GMT + #Message-ID: <3a8ubp$jrj@net.auckland.ac.nz> + + select((select(STDOUT), $^='')[0]); #this is the critical line + $a = 'a'; + write ; + exit; + + format STDOUT = + @<<<<<< + $a + . + + % perl page-head + zsh: 1799 segmentation fault perl /tmp/page-head + + Now says + Undefined top format "main::" called at ./try line 11. + + <8.sub-as-index> + # parser bug? + % perl -le 'sub foo {0}; $x[0]=0;$x[foo]<=0' + Unterminated <> operator at -e line 1. + % perl -le 'sub foo {0}; $x[0]=0;$x[foo()]<=0' + + A right square bracket now forces expectation of an operator. + + <9.unary-minus-to-regexp-var> + % cat minus-reg + #From: Michael Cook + #Newsgroups: comp.lang.perl + #Subject: bug: print -$1 + #Date: 01 Feb 1995 15:31:25 GMT + #Message-ID: + + $_ = "123"; + /\d+/; + print $&, "\n"; + print -$&, "\n"; + print 0-$&, "\n"; + + % perl minus-reg + 123 + 123 + -123 + + Apparently already fixed in my copy. + + <10.vec-segv> + % cat vec-bug + ## Offset values are changed for my machine. + + #From: augustin@gdstech.grumman.com (Conrad Augustin) + #Subject: perl5 vec() bug? + #Message-ID: <1994Nov22.193728.25762@gdstech.grumman.com> + #Date: Tue, 22 Nov 1994 19:37:28 GMT + + #The following two statements each produce a segmentation fault in perl5: + + #vec($a, 21406, 32) = 1; # seg fault + vec($a, 42813, 16) = 1; # seg fault + + #When the offset values are one less, all's well: + #vec($a, 21405, 32) = 1; # ok + #vec($a, 42812, 16) = 1; # ok + + #Interestingly, this is ok for all high values of N: + #$N=1000000; vec($a, $N, 8) = 1; + + % perl vec-bug + zsh: 1806 segmentation fault perl vec-bug + + Can't reproduce this one. + + +NETaa13773: $/ not correctly localized in BEGIN +Files patched: perl.c + (same) + +NETaa13773: foo::bar was misparsed if foo was a reserved word +Files patched: toke.c toke.c + (same) + +NETaa13773: right square bracket didn't force expectation of operator +Files patched: toke.c + (same) + +NETaa13773: scalar ((x) x $repeat) left stack mark +Files patched: op.c + (same) + +NETaa13778: -w coredumps on <$> +From: Hans Mulder +Files patched: pp_hot.c toke.c + Now produces suggested error message. Also installed guard in warning code + that coredumped. + +NETaa13779: foreach didn't use savestack mechanism +From: Hans Mulder +Files patched: cop.h pp_ctl.c + The foreach mechanism saved the old scalar value on the context stack + rather than the savestack. It could consequently get out of sync if + unexpectedly unwound. + +NETaa13785: GIMME sometimes used wrong context frame +From: Greg Earle +Files patched: embed.h global.sym op.h pp_ctl.c proto.h + The expression inside the return was taking its context from the immediately + surrounding block rather than the innermost surrounding subroutine call. + +NETaa13797: could modify sv_undef through auto-vivification +From: Ilya Zakharevich +Files patched: pp.c + Inserted the missing check for readonly values on auto-vivification. + +NETaa13798: if (...) {print} treats print as quoted +From: Larry Wall +Files patched: toke.c + The trailing paren of the condition was setting expectations to XOPERATOR + rather than XBLOCK, so it was being treated like ${print}. + +NETaa13926: commonality was not detected in assignments using COND_EXPR +From: Mark Hanson +Files patched: opcode.h opcode.pl + The assignment compiler didn't check the 2nd and 3rd args of a ?: + for commonality. It still doesn't, but I made ?: into a "dangerous" + operator so it is forced to treat it as common. + +NETaa13957: was marking the PUSHMARK as modifiable rather than the arg +From: David Couture +Files patched: op.c sv.c + It was marking the PUSHMARK as modifiable rather than the arg. + +NETaa13962: documentation of behavior of scalar <*> was unclear +From: Tom Christiansen +Files patched: pod/perlop.pod + Added the following to perlop: + + A glob only evaluates its (embedded) argument when it is starting a new + list. All values must be read before it will start over. In a list + context this isn't important, because you automatically get them all + anyway. In a scalar context, however, the operator returns the next value + each time it is called, or a FALSE value if you've just run out. Again, + FALSE is returned only once. So if you're expecting a single value from + a glob, it is much better to say + + ($file) = ; + + than + + $file = ; + + because the latter will alternate between returning a filename and + returning FALSE. + + +NETaa13986: split ignored /m pattern modifier +From: Winfried Koenig +Files patched: pp.c + Fixed to work like m// and s///. + +NETaa13992: regexp comments not seen after + in non-extended regexp +From: Mark Knutsen +Files patched: regcomp.c + The code to skip regexp comments was guarded by a conditional that only + let it work when /x was in effect. + +NETaa14014: use subs should not count as definition, only as declaration +From: Keith Thompson +Files patched: sv.c + On *foo = \&bar, doesn't set GVf_IMPORTED if foo and bar are in same package. + +NETaa14021: sv_inc and sv_dec "upgraded" magical SV to non-magical +From: Paul A Sand +Also: Andreas Koenig +Files patched: sv.c + The sv_inc() and sv_dec() routines "upgraded" null magical SVs to non-magical. + +NETaa14086: require should check tainting +From: Karl Simon Berg +Files patched: pp_ctl.c + Since we shouldn't allow tainted requires anyway, it now says: + + Insecure dependency in require while running with -T switch at tst.pl line 1. + +NETaa14104: negation fails on magical variables like $1 +From: tim +Files patched: pp.c + Negation was failing on magical values like $1. It was testing the wrong + bits and also failed to provide a final "else" if none of the bits matched. + +NETaa14107: deep sort return leaked contexts +From: Quentin Fennessy +Files patched: pp_ctl.c + Needed to call dounwind() appropriately. + +NETaa14129: attempt to localize via a reference core dumps +From: Michele Sardo +Files patched: op.c pod/perldiag.pod + Now produces an error "Can't localize a reference", with explanation in + perldiag. + +NETaa14138: substr() and s/// can cause core dump +From: Andrew Vignaux +Files patched: pp_hot.c + Forgot to call SvOOK_off() on the SV before freeing its string. + +NETaa14145: ${@INC}[0] dumped core in debugger +From: Hans Mulder +Files patched: sv.c + Now croaks "Bizarre copy of ARRAY in block exit", which is better than + a core dump. The fact that ${@INC}[0] means $INC[0] outside the debugger + is a different bug. + +NETaa14147: bitwise assignment ops wipe out byte of target string +From: Jim Richardson +Files patched: doop.c + The code was assuming that the target was not either of the two operands, + which is false for an assignment operator. + +NETaa14153: lexing of lexicals in patterns fooled by character class +From: Dave Bianchi +Files patched: toke.c + It never called the dwimmer, which is how it fooled it. + +NETaa14154: allowed autoloaded methods by recognizing sub method; declaration +From: Larry Wall +Files patched: gv.c + Made sub method declaration sufficient for autoloader to stop searching on. + +NETaa14156: shouldn't optimize block scope on tainting +From: Pete Peterson +Files patched: op.c toke.c + I totally disabled the block scope optimization when running tainted. + +NETaa14157: -T and -B only allowed 1/30 "odd" characters--changed to 1/3 +From: Tor Lillqvist +Files patched: pp_sys.c + Applied suggested patch. + +NETaa14160: deref of null symbol should produce null list +From: Jared Rhine +Files patched: pp_hot.c + It didn't check for list context before returning undef. + +NETaa14162: POSIX::gensym now returns a symbol reference +From: Josh N. Pritikin +Also: Tim Bunce +Files patched: ext/POSIX/POSIX.pm + Applied suggested patch. + +NETaa14164: POSIX autoloader now distinguishes non-constant "constants" +From: Tim Bunce +Files patched: ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs + The .xs file now distinguishes non-constant "constants" by setting EAGAIN. + This will also let us use #ifdef within the .xs file to de-constantify + any other macros that happen not to be constants even if they don't use + an argument. + +NETaa14166: missing semicolon after "my" induces core dump +From: Thomas Kofler +Files patched: toke.c + The parser was left thinking it was still processing a "my", and flubbed. + I made it wipe out the "in_my" variable on a syntax error. + +NETaa14166: missing semicolon after "my" induces core dump" +Files patched: toke.c + (same) + +NETaa14206: can now use English and strict at the same time +From: Andrew Wilcox +Files patched: sv.c + It now counts imported symbols as okay under "use strict". + +NETaa14206: can now use English and strict at the same time +Files patched: gv.c pod/perldiag.pod + (same) + +NETaa14265: elseif now produces severe warning +From: Yutao Feng +Files patched: pod/perldiag.pod toke.c + Now complains explicitly about "elseif". + +NETaa14279: list assignment propagated taintedness to independent scalars +From: Tim Freeman +Files patched: pp_hot.c + List assignment needed to be modified so that tainting didn't propagate + between independent scalar values. + +NETaa14312: undef in @EXPORTS core dumps +From: William Setzer +Files patched: lib/Exporter.pm + Now says: + + Unable to create sub named "t::" at lib/Exporter.pm line 159. + Illegal null symbol in @t::EXPORT at -e line 1 + BEGIN failed--compilation aborted at -e line 1. + + +NETaa14312: undef in @EXPORTS core dumps +Files patched: pod/perldiag.pod sv.c + (same) + +NETaa14321: literal @array check shouldn't happen inside embedded expressions +From: Mark H. Nodine +Files patched: toke.c + The general solution to this is to disable the literal @array check within + any embedded expression. For instance, this also failed bogusly: + + print "$foo{@foo}"; + + The reason fixing this also fixes the s///e problem is that the lexer + effectively puts the RHS into a do {} block, making the expression + embedded within curlies, as far as the error message is concerned. + +NETaa14322: now localizes $! during POSIX::AUTOLOAD +From: Larry Wall +Files patched: ext/POSIX/POSIX.pm + Added local $! = 0. + +NETaa14324: defined() causes spurious sub existence +From: "Andreas Koenig" +Files patched: op.c pp.c + It called pp_rv2cv which wrongly assumed it could add any sub it referenced. + +NETaa14336: use Module () forces import of nothing +From: Tim Bunce +Files patched: op.c + use Module () now refrains from calling import at all. + +NETaa14353: added special HE allocator +From: Larry Wall +Files patched: global.sym + +NETaa14353: added special HE allocator +Files patched: hv.c perl.h + +NETaa14353: array extension now converts old memory to SV storage. +Files patched: av.c av.h sv.c + +NETaa14353: hashes now convert old storage into SV arenas. +Files patched: global.sym + +NETaa14353: hashes now convert old storage into SV arenas. +Files patched: hv.c perl.h + +NETaa14353: upgraded SV arena allocation +Files patched: proto.h + +NETaa14353: upgraded SV arena allocation +Files patched: perl.c sv.c + +NETaa14422: added rudimentary prototypes +From: Gisle Aas +Files patched: Makefile.SH op.c op.c perly.c perly.c.diff perly.h perly.y proto.h sv.c toke.c + Message-Id: <9509290018.AA21548@scalpel.netlabs.com> + To: doughera@lafcol.lafayette.edu (Andy Dougherty) + Cc: perl5-porters@africa.nicoh.com + Subject: Re: Jumbo Configure patch vs. 1m. + Date: Thu, 28 Sep 95 17:18:54 -0700 + From: lwall@scalpel.netlabs.com (Larry Wall) + + : No. Larry's currently got the patch pumpkin for all such core perl topics. + + I dunno whether you should let me have the patch pumpkin or not. To fix + a Sev 2 I just hacked in rudimentary prototypes. :-) + + We can now define true unary subroutines, as well as argumentless + subroutines: + + sub baz () { 12; } # Must not have argument + sub bar ($) { $_[0] * 7 } # Must have exactly one argument + sub foo ($@) { print "@_\n" } # Must have at least one argument + foo bar baz / 2 || "oops", "is the answer"; + + This prints "42 is the answer" on my machine. That is, it's the same as + + foo( bar( baz() / 2) || "oops", "is the answer"); + + Attempting to compile + + foo; + + results in + + Too few arguments for main::foo at ./try line 8, near "foo;" + + Compiling + + bar 1,2,3; + + results in + + Too many arguments for main::bar at ./try line 8, near "foo;" + + But + + @array = ('a','b','c'); + foo @array, @array; + + prints "3 a b c" because the $ puts the first arg of foo into scalar context. + + The main win at this point is that we can say + + sub AAA () { 1; } + sub BBB () { 2; } + + and the user can say AAA + BBB and get 3. + + I'm not quite sure how this interacts with autoloading though. I fear + POSIX.pm will need to say + + sub E2BIG (); + sub EACCES (); + sub EAGAIN (); + sub EBADF (); + sub EBUSY (); + ... + sub _SC_STREAM_MAX (); + sub _SC_TZNAME_MAX (); + sub _SC_VERSION (); + + unless we can figure out how to efficiently declare a default prototype + at import time. Meaning, not using eval. Currently + + *foo = \&bar; + + (the ordinary import mechanism) implicitly stubs &bar with no prototype if + &bar is not yet declared. It's almost like you want an AUTOPROTO to + go with your AUTOLOAD. + + Another thing to rub one's 5 o'clock shadow over is that there's no way + to apply a prototype to a method call at compile time. + + And no, I don't want to have the + + sub howabout ($formal, @arguments) { ... } + + argument right now. + + Larry + +NETaa14422: couldn't take reference of a prototyped function +Files patched: op.c + (same) + +NETaa14423: use didn't allow expressions involving the scratch pad +From: Graham Barr +Files patched: op.c perly.c perly.c.diff perly.y proto.h vms/perly_c.vms + Applied suggested patch. + +NETaa14444: lexical scalar didn't autovivify +From: Gurusamy Sarathy +Files patched: op.c pp_hot.c + It didn't have code in pp_padsv to do the right thing. + +NETaa14448: caller could dump core when used within an eval or require +From: Danny R. Faught +Files patched: pp_ctl.c + caller() was incorrectly assuming the context stack contained a subroutine + context when it in fact contained an eval context. + +NETaa14451: improved error message on bad pipe filehandle +From: Danny R. Faught +Files patched: pp_sys.c + Now says the slightly more informative + + Can't use an undefined value as filehandle reference at ./try line 3. + +NETaa14462: pp_dbstate had a scope leakage on recursion suppression +From: Tim Bunce +Files patched: pp_ctl.c + Swapped the code in question around. + +NETaa14482: sv_unref freed ref prematurely at times +From: Gurusamy Sarathy +Files patched: sv.c + Made sv_unref() mortalize rather than free the old reference. + +NETaa14484: appending string to array produced bizarre results +From: Greg Ward +Also: Malcolm Beattie +Files patched: pp_hot.c + Will now say, "Can't coerce ARRAY to string". + +NETaa14525: assignment to globs didn't reset them correctly +From: Gurusamy Sarathy +Files patched: sv.c + Applied parts of patch not overridden by subsequent patch. + +NETaa14529: a partially matching subpattern could spoof infinity detector +From: Wayne Berke +Files patched: regexec.c + A partial match on a subpattern could fool the infinite regress detector + into thinking progress had been made. + The previous workaround prevented another bug (NETaa14529) from being fixed, + so I've backed it out. I'll need to think more about how to detect failure + to progress. I'm still hopeful it's not equivalent to the halting problem. + +NETaa14535: patches from Gurusamy Sarathy +From: Gurusamy Sarathy +Files patched: op.c pp.c pp_hot.c regexec.c sv.c toke.c + Applied most recent suggested patches. + +NETaa14537: select() can return too soon +From: Matt Kimball +Also: Andreas Gustafsson +Files patched: pp_sys.c + +NETaa14538: method calls were treated like do {} under loop modifiers +From: Ilya Zakharevich +Files patched: perly.c perly.y + Needed to take the OPf_SPECIAL flag off of entersubs from method reductions. + (It was probably a cut-and-paste error from long ago.) + +NETaa14540: foreach (@array) no longer does extra stack copy +From: darrinm@lmc.com +Files patched: Todo op.c pp_ctl.c pp_hot.c + Fixed by doing the foreach(@array) optimization, so it iterates + directly through the array, and can detect the implicit shift from + referencing <>. + +NETaa14541: new version of perlbug +From: Kenneth Albanowski +Files patched: README pod/perl.pod utils/perlbug.PL + Brought it up to version 1.09. + +NETaa14541: perlbug 1.11 +Files patched: utils/perlbug.PL + (same) + +NETaa14548: magic sets didn't check private OK bits +From: W. Bradley Rubenstein +Files patched: mg.c + The magic code was getting mixed up between private and public POK bits. + +NETaa14550: made ~ magic magical +From: Tim Bunce +Files patched: sv.c + Applied suggested patch. + +NETaa14551: humongous header causes infinite loop in format +From: Grace Lee +Files patched: pp_sys.c + Needed to check for page exhaustion after doing top-of-form. + +NETaa14558: attempt to call undefined top format core dumped +From: Hallvard B Furuseth +Files patched: pod/perldiag.pod pp_sys.c + Now issues an error on attempts to call a non-existent top format. + +NETaa14561: Gurusamy Sarathy's G_KEEPERR patch +From: Andreas Koenig +Also: Gurusamy Sarathy +Also: Tim Bunce +Files patched: cop.h interp.sym perl.c perl.h pp_ctl.c pp_sys.c sv.c toke.c + Applied latest patch. + +NETaa14581: shouldn't execute BEGIN when there are compilation errors +From: Rickard Westman +Files patched: op.c + Perl should not try to execute BEGIN and END blocks if there's been a + compilation error. + +NETaa14582: got SEGV sorting sparse array +From: Rick Pluta +Files patched: pp_ctl.c + Now weeds out undefined values much like Perl 4 did. + Now sorts undefined values to the front. + +NETaa14582: sort was letting unsortable values through to comparison routine +Files patched: pp_ctl.c + (same) + +NETaa14585: globs in pad space weren't properly cleaned up +From: Gurusamy Sarathy +Files patched: op.c pp.c pp_hot.c sv.c + Applied suggested patch. + +NETaa14614: now does dbmopen with perl_eval_sv() +From: The Man +Files patched: perl.c pp_sys.c proto.h + dbmopen now invokes perl_eval_sv(), which should handle error conditions + better. + +NETaa14618: exists doesn't work in GDBM_File +From: Andrew Wilcox +Files patched: ext/GDBM_File/GDBM_File.xs + Applied suggested patch. + +NETaa14619: tied() +From: Larry Wall +Also: Paul Marquess +Files patched: embed.h global.sym keywords.h keywords.pl opcode.h opcode.pl pp_sys.c toke.c + Applied suggested patch. + +NETaa14636: Jumbo Dynaloader patch +From: Tim Bunce +Files patched: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c + Applied suggested patches. + +NETaa14637: checkcomma routine was stupid about bareword sub calls +From: Tim Bunce +Files patched: toke.c + The checkcomma routine was stupid about bareword sub calls. + +NETaa14639: (?i) didn't reset on runtime patterns +From: Mark A. Scheel +Files patched: op.h pp_ctl.c toke.c + It didn't distinguish between permanent flags outside the pattern and + temporary flags within the pattern. + +NETaa14649: selecting anonymous globs dumps core +From: Chip Salzenberg +Files patched: cop.h doio.c embed.h global.sym perl.c pp_sys.c proto.h + Applied suggested patch, but reversed the increment and decrement to avoid + decrementing and freeing what we're going to increment. + +NETaa14655: $? returned negative value on AIX +From: Kim Frutiger +Also: Stephen D. Lee +Files patched: pp_sys.c + Applied suggested patch. + +NETaa14668: {2,} could match once +From: Hugo van der Sanden +Files patched: regexec.c + When an internal pattern failed a conjecture, it didn't back off on the + number of times it thought it had matched. + +NETaa14673: open $undefined dumped core +From: Samuli K{rkk{inen +Files patched: pp_sys.c + pp_open() didn't check its argument for globness. + +NETaa14683: stringifies were running pad out of space +From: Robin Barker +Files patched: op.h toke.c + Increased PADOFFSET to a U32, and made lexer not put double-quoted strings + inside OP_STRINGIFY unless they really needed it. + +NETaa14689: shouldn't have . in @INC when tainting +From: William R. Somsky +Files patched: perl.c + Now does not put . into @INC when tainting. It may still be added with a + + use lib "."; + + or, to put it at the end, + + BEGIN { push(@INC, ".") } + + but this is not recommended unless a chdir to a known location has been done + first. + +NETaa14690: values inside tainted SVs were ignored +From: "James M. Stern" +Files patched: pp.c pp_ctl.c + It was assuming that a tainted value was a string. + +NETaa14692: format name required qualification under use strict +From: Tom Christiansen +Files patched: gv.c + Now treats format names the same as subroutine names. + +NETaa14695: added simple regexp caching +From: John Rowe +Files patched: pp_ctl.c + Applied suggested patch. + +NETaa14697: regexp comments were sometimes wrongly treated as literal text +From: Tom Christiansen +Files patched: regcomp.c + The literal-character grabber didn't know about extended comments. + N.B. '#' is treated as a comment character whenever the /x option is + used now, so you can't include '#' as a simple literal in /x regexps. + + (By the way, Tom, the boxed form of quoting in the previous enclosure is + exceeding antisocial when you want to extract the code from it.) + +NETaa14704: closure got wrong outer scope if outer sub was predeclared +From: Marc Paquette +Files patched: op.c + The outer scope of the anonymous sub was set to the stub rather than to + the actual subroutine. I kludged it by making the outer scope of the + stub be the actual subroutine, if anything is depending on the stub. + +NETaa14705: $foo .= $foo did free memory read +From: Gerd Knops +Files patched: sv.c + Now modifies address to copy if it was reallocated. + +NETaa14709: Chip's FileHandle stuff +From: Larry Wall +Also: Chip Salzenberg +Files patched: MANIFEST ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs ext/FileHandle/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs lib/FileCache.pm lib/Symbol.pm t/lib/filehand.t t/lib/posix.t + Applied suggested patches. + +NETaa14711: added (&) and (*) prototypes for blocks and symbols +From: Kenneth Albanowski +Files patched: Makefile.SH op.c perly.c perly.h perly.y toke.c + & now means that it must have an anonymous sub as that argument. If + it's the first argument, the sub may be specified as a block in the + indirect object slot, much like grep or sort, which have prototypes of (&@). + + Also added * so you can do things like + + sub myopen (*;$); + + myopen(FOO, $filename); + +NETaa14713: setuid FROM root now defaults to not do tainting +From: Tony Camas +Files patched: mg.c perl.c pp_hot.c + Applied suggested patch. + +NETaa14714: duplicate magics could be added to an SV +From: Yary Hluchan +Files patched: sv.c sv.c + The sv_magic() routine didn't properly check to see if it already had a + magic of that type. Ordinarily it would have, but it was called during + mg_get(), which forces the magic flags off temporarily. + +NETaa14721: sub defined during erroneous do-FILE caused core dump +From: David Campbell +Files patched: op.c + Fixed the seg fault. I couldn't reproduce the return problem. + +NETaa14734: ref should never return undef +From: Dale Amon +Files patched: pp.c t/op/overload.t + Now returns null string. + +NETaa14751: slice of undefs now returns null list +From: Tim Bunce +Files patched: pp.c pp_hot.c + Null list clobberation is now done in lslice, not aassign. + +NETaa14789: select coredumped on Linux +From: Ulrich Kunitz +Files patched: pp_sys.c + Applied suggested patches, more or less. + +NETaa14789: straightened out ins and out of duping +Files patched: lib/IPC/Open3.pm + (same) + +NETaa14791: implemented internal SUPER class +From: Nick Ing-Simmons +Also: Dean Roehrich +Files patched: gv.c + Applied suggested patch. + +NETaa14845: s/// didn't handle offset strings +From: Ken MacLeod +Files patched: pp_ctl.c + Needed a call to SvOOK_off(targ) in pp_substcont(). + +NETaa14851: Use of << to mean <<"" is deprecated +From: Larry Wall +Files patched: toke.c + +NETaa14865: added HINT_BLOCK_SCOPE to "elsif" +From: Jim Avera +Files patched: perly.y + Needed to set HINT_BLOCK_SCOPE on "elsif" to prevent the do block from + being optimized away, which caused the statement transition in elsif + to reset the stack too far back. + +NETaa14876: couldn't delete localized GV safely +From: John Hughes +Files patched: pp.c scope.c + The reference count of the "borrowed" GV needed to be incremented while + there was a reference to it in the savestack. + +NETaa14887: couldn't negate magical scalars +From: ian +Also: Gurusamy Sarathy +Files patched: pp.c + Applied suggested patch, more or less. (It's not necessary to test both + SvNIOK and SvNIOKp, since the private bits are always set if the public + bits are set.) + +NETaa14893: /m modifier was sticky +From: Jim Avera +Files patched: pp_ctl.c + pp_match() and pp_subst() were using an improperly scoped SAVEINT to restore + the value of the internal variable multiline. + +NETaa14893: /m modifier was sticky +Files patched: cop.h pp_hot.c + (same) + +NETaa14916: complete.pl retained old return value +From: Martyn Pearce +Files patched: lib/complete.pl + Applied suggested patch. + +NETaa14928: non-const 3rd arg to split assigned to list could coredump +From: Hans de Graaff +Files patched: op.c + The optimizer was assuming the OP was an OP_CONST. + +NETaa14942: substr as lvalue could disable magic +From: Darrell Kindred +Files patched: pp.c + The substr was disabling the magic of $1. + +NETaa14990: "not" not parseable when expecting term +From: "Randal L. Schwartz" +Files patched: perly.c perly.c.diff perly.y vms/perly_c.vms + The NOTOP production needed to be moved down into the terms. + +NETaa14993: Bizarre copy of formline +From: Tom Christiansen +Also: Charles Bailey +Files patched: sv.c + Applied suggested patch. + +NETaa14998: sv_add_arena() no longer leaks memory +From: Andreas Koenig +Files patched: av.c hv.c perl.h sv.c + Now keeps one potential arena "on tap", but doesn't use it unless there's + demand for SV headers. When an AV or HV is extended, its old memory + becomes the next potential arena unless there already is one, in which + case it is simply freed. This will have the desired property of not + stranding medium-sized chunks of memory when extending a single array + repeatedly, but will not degrade when there's no SV demand beyond keeping + one chunk of memory on tap, which generally will be about 250 bytes big, + since it prefers the earlier freed chunk over the later. See the nice_chunk + variable. + +NETaa14999: $a and $b now protected from use strict and lexical declaration +From: Tom Christiansen +Files patched: gv.c pod/perldiag.pod toke.c + Bare $a and $b are now allowed during "use strict". In addition, + the following diag was added: + + =item Can't use "my %s" in sort comparison + + (F) The global variables $a and $b are reserved for sort comparisons. + You mentioned $a or $b in the same line as the <=> or cmp operator, + and the variable had earlier been declared as a lexical variable. + Either qualify the sort variable with the package name, or rename the + lexical variable. + + +NETaa15034: use strict refs should allow calls to prototyped functions +From: Roderick Schertler +Files patched: perly.c perly.c.diff perly.y toke.c vms/perly_c.vms + Applied patch suggested by Chip. + +NETaa15083: forced $AUTOLOAD to be untainted +From: Tim Bunce +Files patched: gv.c pp_hot.c + Stripped any taintmagic from $AUTOLOAD after setting it. + +NETaa15084: patch for Term::Cap +From: Mark Kaehny +Also: Hugo van der Sanden +Files patched: lib/Term/Cap.pm + Applied suggested patch. + +NETaa15086: null pattern could cause coredump in s//_$1_/ +From: "Paul E. Maisano" +Files patched: cop.h pp_ctl.c + If the replacement pattern was complicated enough to cause pp_substcont + to be called, then it lost track of which REGEXP* it was supposed to + be using. + +NETaa15087: t/io/pipe.t didn't work on AIX +From: Andy Dougherty +Files patched: t/io/pipe.t + Applied suggested patch. + +NETaa15088: study was busted +From: Hugo van der Sanden +Files patched: opcode.h opcode.pl pp.c + It was studying its scratch pad target rather than the argument supplied. + +NETaa15090: MSTATS patch +From: Tim Bunce +Files patched: global.sym malloc.c perl.c perl.h proto.h + Applied suggested patch. + +NETaa15098: longjmp out of magic leaks memory +From: Chip Salzenberg +Files patched: mg.c sv.c + Applied suggested patch. + +NETaa15102: getpgrp() is broken if getpgrp2() is available +From: Roderick Schertler +Files patched: perl.h pp_sys.c + Applied suggested patch. + +NETaa15103: prototypes leaked opcodes +From: Chip Salzenberg +Files patched: op.c + Applied suggested patch. + +NETaa15107: quotameta memory bug on all metacharacters +From: Chip Salzenberg +Files patched: pp.c + Applied suggested patch. + +NETaa15108: Fix for incomplete string leak +From: Chip Salzenberg +Files patched: toke.c + Applied suggested patch. + +NETaa15110: couldn't use $/ with 8th bit set on some architectures +From: Chip Salzenberg +Files patched: doop.c interp.sym mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c util.c + Applied suggested patches. + +NETaa15112: { a_1 => 2 } didn't parse as expected +From: Stuart M. Weinstein +Files patched: toke.c + The little dwimmer was only skipping ALPHA rather than ALNUM chars. + +NETaa15123: bitwise ops produce spurious warnings +From: Hugo van der Sanden +Also: Chip Salzenberg +Also: Andreas Gustafsson +Files patched: sv.c + Decided to suppress the warning in the conversion routines if merely converting + a temporary, which can never be a user-supplied value anyway. + +NETaa15129: #if defined (foo) misparsed in h2ph +From: Roderick Schertler +Files patched: utils/h2ph.PL + Applied suggested patch. + +NETaa15131: some POSIX functions assumed valid filehandles +From: Chip Salzenberg +Files patched: ext/POSIX/POSIX.xs + Applied suggested patch. + +NETaa15151: don't optimize split on OPpASSIGN_COMMON +From: Huw Rogers +Files patched: op.c + Had to swap the optimization down to after the assignment op is generated + and COMMON is calculated, and then clean up the resultant tree differently. + +NETaa15154: MakeMaker-5.18 +From: Andreas Koenig +Files patched: MANIFEST lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + Brought it up to 5.18. + +NETaa15156: some Exporter tweaks +From: Roderick Schertler +Also: Tim Bunce +Files patched: lib/Exporter.pm + Also did Tim's Tiny Trivial patch. + +NETaa15157: new version of Test::Harness +From: Andreas Koenig +Files patched: lib/Test/Harness.pm + Applied suggested patch. + +NETaa15175: overloaded nomethod has garbage 4th op +From: Ilya Zakharevich +Files patched: gv.c + Applied suggested patch. + +NETaa15179: SvPOK_only shouldn't back off on offset pointer +From: Gutorm.Hogasen@oslo.teamco.telenor.no +Files patched: sv.h + SvPOK_only() was calling SvOOK_off(), which adjusted the string pointer + after tr/// has already acquired it. It shouldn't really be necessary + for SvPOK_only() to undo an offset string pointer, since there's no + conflict with a possible integer value where the offset is stored. + +NETaa15193: & now always bypasses prototype checking +From: Larry Wall +Files patched: dump.c op.c op.h perly.c perly.c.diff perly.y pod/perlsub.pod pp_hot.c proto.h toke.c vms/perly_c.vms vms/perly_h.vms + Turned out to be a big hairy deal because the lexer turns foo() into &foo(). + But it works consistently now. Also fixed pod. + +NETaa15197: 5.002b2 is 'appending' to $@ +From: Gurusamy Sarathy +Files patched: pp_ctl.c + Applied suggested patch. + +NETaa15201: working around Linux DBL_DIG problems +From: Kenneth Albanowski +Files patched: hints/linux.sh sv.c + Applied suggested patch. + +NETaa15208: SelectSaver +From: Chip Salzenberg +Files patched: MANIFEST lib/SelectSaver.pm + Applied suggested patch. + +NETaa15209: DirHandle +From: Chip Salzenberg +Files patched: MANIFEST lib/DirHandle.pm t/lib/dirhand.t + +NETaa15210: sysopen() +From: Chip Salzenberg +Files patched: doio.c keywords.pl lib/ExtUtils/typemap opcode.pl pod/perlfunc.pod pp_hot.c pp_sys.c proto.h toke.c + Applied suggested patch. Hope it works... + +NETaa15211: use mnemonic names in Safe setup +From: Chip Salzenberg +Files patched: ext/Safe/Safe.pm + Applied suggested patch, more or less. + +NETaa15214: prototype() +From: Chip Salzenberg +Files patched: ext/Safe/Safe.pm global.sym keywords.pl opcode.pl pp.c toke.c + Applied suggested patch. + +NETaa15217: -w problem with -d:foo +From: Tim Bunce +Files patched: perl.c + Applied suggested patch. + +NETaa15218: *GLOB{ELEMENT} +From: Larry Wall +Files patched: Makefile.SH embed.h ext/Safe/Safe.pm keywords.h opcode.h opcode.h opcode.pl perly.c perly.c.diff perly.y pp_hot.c t/lib/safe.t vms/perly_c.vms + +NETaa15219: Make *x=\*y do like *x=*y +From: Chip Salzenberg +Files patched: sv.c + Applied suggested patch. + +NETaa15221: Indigestion with Carp::longmess and big eval '...'s +From: Tim Bunce +Files patched: lib/Carp.pm + Applied suggested patch. + +NETaa15222: VERSION patch for standard extensions +From: Paul Marquess +Files patched: ext/DB_File/Makefile.PL ext/DynaLoader/DynaLoader.pm ext/DynaLoader/Makefile.PL ext/Fcntl/Fcntl.pm ext/Fcntl/Makefile.PL ext/GDBM_File/GDBM_File.pm ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/NDBM_File/NDBM_File.pm ext/ODBM_File/Makefile.PL ext/ODBM_File/ODBM_File.pm ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/SDBM_File/Makefile.PL ext/SDBM_File/SDBM_File.pm ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Socket/Makefile.PL + Applied suggested patch. + +NETaa15222: VERSION patch for standard extensions (reprise) +Files patched: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm ext/POSIX/POSIX.pm ext/SDBM_File/SDBM_File.pm ext/Safe/Safe.pm ext/Socket/Socket.pm + (same) + +NETaa15227: $i < 10000 should optimize to integer op +From: Larry Wall +Files patched: op.c op.c + The program + + for ($i = 0; $i < 100000; $i++) { + push @foo, $i; + } + + takes about one quarter the memory if the optimizer decides that it can + use an integer < comparison rather than floating point. It now does so + if one side is an integer constant and the other side a simple variable. + This should really help some of our benchmarks. You can still force a + floating point comparison by using 100000.0 instead. + +NETaa15228: CPerl-mode patch +From: Ilya Zakharevich +Files patched: emacs/cperl-mode.el + Applied suggested patch. + +NETaa15231: Symbol::qualify() +From: Chip Salzenberg +Files patched: ext/FileHandle/FileHandle.pm gv.c lib/SelectSaver.pm lib/Symbol.pm pp_hot.c + Applied suggested patch. + +NETaa15236: select select broke under use strict +From: Chip Salzenberg +Files patched: op.c + Instead of inventing a new bit, I just turned off the HINT_STRICT_REFS bit. + I don't think it's worthwhile distinguishing between qualified or unqualified + names to select. + +NETaa15237: use vars +From: Larry Wall +Files patched: MANIFEST gv.c lib/subs.pm lib/vars.pm sv.c + +NETaa15240: keep op names _and_ descriptions +From: Chip Salzenberg +Files patched: doio.c embed.h ext/Safe/Safe.pm ext/Safe/Safe.xs global.sym op.c opcode.h opcode.pl scope.c sv.c + Applied suggested patch. + +NETaa15259: study doesn't unset on string modification +From: Larry Wall +Files patched: mg.c pp.c + Piggybacked on m//g unset magic to unset the study too. + +NETaa15276: pick a better initial cxstack_max +From: Chip Salzenberg +Files patched: perl.c + Added fudge in, and made it calculate how many it could fit into (most of) 8K, + to avoid getting 16K of Kingsley malloc. + +NETaa15287: numeric comparison optimization adjustments +From: Clark Cooper +Files patched: op.c + Applied patch suggested by Chip, with liberalization to >= and <=. + +NETaa15299: couldn't eval string containing pod or __DATA__ +From: Andreas Koenig +Also: Gisle Aas +Files patched: toke.c + Basically, eval didn't know how to bypass pods correctly. + +NETaa15300: sv_backoff problems +From: Paul Marquess +Also: mtr +Also: Chip Salzenberg +Files patched: op.c sv.c sv.h + Applied suggested patch. + +NETaa15312: Avoid fclose(NULL) +From: Chip Salzenberg +Files patched: toke.c + Applied suggested patch. + +NETaa15318: didn't set up perl_init_i18nl14n for export +From: Ilya Zakharevich +Files patched: perl_exp.SH + Applied suggested patch. + +NETaa15331: File::Path::rmtree followed symlinks +From: Andreas Koenig +Files patched: lib/File/Path.pm + Added suggested patch, except I did + + if (not -l $root and -d _) { + + for efficiency, since if -d is true, the -l already called lstat on it. + +NETaa15339: sv_gets() didn't reset count +From: alanburlison@unn.unisys.com +Files patched: sv.c + Applied suggested patch. + +NETaa15341: differentiated importation of different types +From: Chip Salzenberg +Files patched: gv.c gv.h op.c perl.c pp.c pp_ctl.c sv.c sv.h toke.c + Applied suggested patch. + +NETaa15342: Consistent handling of e_{fp,tmpname} +From: Chip Salzenberg +Files patched: perl.c pp_ctl.c util.c + Applied suggested patch. + +NETaa15344: Safe gets confused about malloc on AIX +From: Tim Bunce +Files patched: ext/Safe/Safe.xs + Applied suggested patch. + +NETaa15348: -M upgrade +From: Tim Bunce +Files patched: perl.c pod/perlrun.pod + Applied suggested patch. + +NETaa15369: change in split optimization broke scalar context +From: Ulrich Pfeifer +Files patched: op.c + The earlier patch to make the split optimization pay attention to + OPpASSIGN_COMMON rearranged how the syntax tree is constructed, but kept + the wrong context flags. This causes pp_split() do do the wrong thing. + +NETaa15423: can't do subversion numbering because of %5.3f assumptions +From: Andy Dougherty +Files patched: configpm patchlevel.h perl.c perl.h pp_ctl.c + Removed the %5.3f assumptions where appropriate. patchlevel.h now + defines SUBVERSION, which if greater than 0 indicates a development version. + +NETaa15424: Sigsetjmp patch +From: Kenneth Albanowski +Files patched: Configure config_h.SH op.c perl.c perl.h pp_ctl.c util.c + Applied suggested patch. + +Needed to make install paths absolute. +Files patched: installperl + +h2xs 1.14 +Files patched: utils/h2xs.PL + +makedir() looped on a symlink to a directory. +Files patched: installperl + +xsubpp 1.932 +Files patched: lib/ExtUtils/xsubpp + +---------------------------------------------------------------- +Summary of user-visible Configure and build changes since 5.001: +---------------------------------------------------------------- + +Yet more enhancements and fixes have been made to the Configure and +build process for perl. Most of these will not be visible to the +ordinary user--they just make the process more robust and likely to +work on a wider range of platforms. + +This is a brief summary of the most important changes. A more +detailed description is given below. + + Slightly changed installation directories. See INSTALL. + + Include 5.000 - 5.001 upgrage notes :-) (see below). You might + want to read through them as well as these notes. + + Install documentation for perl modules and pod2* translators. You can + now view perl module documentation with either your system's man(1) + program or with the supplied perldoc script. + + Many hint file updates. + + Improve and simplify detection of local libraries and header files. + + Expand documentation of installation process in new INSTALL file. + + Try to reduce Unixisms (such as SH file extraction) to enhance + portability to other platforms. There's still a long way to go. + +Upgrade Traps and Pitfalls: + +Since a lot has changed in the build process, you are probably best off +starting with a fresh copy of the perl5.002 sources. In particular, +your 5.000 or 5.001 config.sh will contain several variables that are no +longer needed. Further, improvements in the Configure tests may mean +that some of the answers will be different than they were in previous +versions, and which answer to keep can be difficult to sort out. +Therefore, you are probably better off ignoring your old config.sh, as +in the following: + + make -k distclean # (if you've built perl before) + rm -f config.sh # (in case distclean mysteriously fails) + sh Configure [whatever options you like] + make depend + make + make test + +This, and much more, is described in the new INSTALL file. + +Here are the detailed changes from 5.002beta1 to 5.002b2 in +reverse chronolgical order: + +------------- +Version 5.002beta2 +------------- + +This is patch.2b2 to perl5.002beta1. +This takes you from 5.002beta1h to 5.002beta2. + +Renaming this as beta2 reflects _my_ feeling that it's time to +wrap up things for the release of 5.002. + +Index: Changes.Conf + + Include changes from patches 2b1a .. 2b1h, as well as this + patch. + +Index: Configure + + Use nm -D on Linux with shared libraries, if the system + supports nm -D. + +Prereq: 3.0.1.8 +*** perl5.002b1h/Configure Thu Jan 4 11:14:37 1996 +--- perl5.002b2/Configure Thu Jan 11 17:09:13 1996 + +Index: MANIFEST + + Include Stub Readline library as part of new debugger. + + Include hints file dec_osf for ODBM_File extension. + +*** perl5.002b1h/MANIFEST Wed Jan 3 14:37:54 1996 +--- perl5.002b2/MANIFEST Sat Jan 13 16:30:43 1996 + +Index: configpm + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/configpm Tue Oct 31 11:51:52 1995 +--- perl5.002b2/configpm Fri Jan 12 10:53:34 1996 + +Index: doop.c + + Chip's patch to use STDCHAR and U8 nearly everywhere instead of + assuming 8-bit chars or ~(char) 0 == 0xff. + +*** perl5.002b1h/doop.c Wed Nov 15 15:08:01 1995 +--- perl5.002b2/doop.c Fri Jan 12 15:05:04 1996 + +Index: embed.h + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/embed.h Thu Jan 4 13:28:08 1996 +--- perl5.002b2/embed.h Fri Jan 12 15:09:11 1996 + +Index: ext/DB_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 +--- perl5.002b2/ext/DB_File/Makefile.PL Tue Jan 9 16:54:17 1996 + +*** perl5.002b1h/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 +--- perl5.002b2/ext/DB_File/Makefile.PL Sat Jan 13 17:07:11 1996 + +Index: ext/DynaLoader/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/DynaLoader/Makefile.PL Tue Jun 6 12:24:37 1995 +--- perl5.002b2/ext/DynaLoader/Makefile.PL Sat Jan 13 17:16:34 1996 + +Index: ext/Fcntl/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Fcntl/Makefile.PL Thu Jan 19 18:58:52 1995 +--- perl5.002b2/ext/Fcntl/Makefile.PL Sat Jan 13 17:16:38 1996 + +Index: ext/GDBM_File/GDBM_File.pm + + Make the NAME section a legal paragraph. + +*** perl5.002b1h/ext/GDBM_File/GDBM_File.pm Mon Nov 20 10:22:26 1995 +--- perl5.002b2/ext/GDBM_File/GDBM_File.pm Fri Jan 12 16:11:38 1996 + +Index: ext/GDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/GDBM_File/Makefile.PL Wed Feb 22 14:36:36 1995 +--- perl5.002b2/ext/GDBM_File/Makefile.PL Sat Jan 13 17:08:02 1996 + +Index: ext/NDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/NDBM_File/Makefile.PL Wed Feb 22 14:36:39 1995 +--- perl5.002b2/ext/NDBM_File/Makefile.PL Sat Jan 13 17:08:13 1996 + +Index: ext/ODBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/ODBM_File/Makefile.PL Mon Jun 5 15:03:44 1995 +--- perl5.002b2/ext/ODBM_File/Makefile.PL Sat Jan 13 17:08:22 1996 + +Index: ext/ODBM_File/hints/dec_osf.pl + + New file. + +*** /dev/null Sat Jan 13 16:48:01 1996 +--- perl5.002b2/ext/ODBM_File/hints/dec_osf.pl Sat Jan 13 16:30:01 1996 + +Index: ext/POSIX/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/POSIX/Makefile.PL Thu Jan 19 18:59:00 1995 +--- perl5.002b2/ext/POSIX/Makefile.PL Sat Jan 13 17:08:27 1996 + +Index: ext/SDBM_File/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/SDBM_File/Makefile.PL Tue Nov 14 11:16:43 1995 +--- perl5.002b2/ext/SDBM_File/Makefile.PL Sat Jan 13 17:16:49 1996 + +Index: ext/SDBM_File/sdbm/sdbm.c + + Give correct prototype for free. + +Prereq: 1.16 +*** perl5.002b1h/ext/SDBM_File/sdbm/sdbm.c Mon Nov 13 23:01:41 1995 +--- perl5.002b2/ext/SDBM_File/sdbm/sdbm.c Fri Jan 12 10:33:32 1996 + +Index: ext/Safe/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Safe/Makefile.PL Tue Jan 2 15:43:53 1996 +--- perl5.002b2/ext/Safe/Makefile.PL Sat Jan 13 17:08:45 1996 + +Index: ext/Safe/Safe.pm + + Patch from Andreas. + +*** perl5.002b1h/ext/Safe/Safe.pm Tue Jan 2 15:45:27 1996 +--- perl5.002b2/ext/Safe/Safe.pm Fri Jan 12 10:52:33 1996 + +Index: ext/Safe/Safe.xs + + Patch for older compilers which had namespace confusion. + +*** perl5.002b1h/ext/Safe/Safe.xs Tue Jan 2 15:45:27 1996 +--- perl5.002b2/ext/Safe/Safe.xs Fri Jan 5 14:27:47 1996 + +Index: ext/Socket/Makefile.PL + + Disable prototypes. + Disable pod2man. + +*** perl5.002b1h/ext/Socket/Makefile.PL Sat Dec 2 16:23:52 1995 +--- perl5.002b2/ext/Socket/Makefile.PL Sat Jan 13 17:08:52 1996 + +Index: ext/Socket/Socket.xs + + Use unsigned shorts for ports. + +*** perl5.002b1h/ext/Socket/Socket.xs Sat Dec 2 15:46:20 1995 +--- perl5.002b2/ext/Socket/Socket.xs Mon Jan 8 21:59:52 1996 + +Index: global.sym + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/global.sym Wed Jan 3 12:01:59 1996 +--- perl5.002b2/global.sym Fri Jan 12 10:53:34 1996 + +Index: gv.c + + Avoid VMS sprintf bug with buffers >1024. + +*** perl5.002b1h/gv.c Fri Dec 8 10:37:22 1995 +--- perl5.002b2/gv.c Fri Jan 12 15:27:27 1996 + +Index: hints/aix.sh + + Updated + +*** perl5.002b1h/hints/aix.sh Mon Nov 13 23:03:33 1995 +--- perl5.002b2/hints/aix.sh Fri Jan 12 12:09:48 1996 + +Index: hints/irix_5.sh + + Updated + +*** perl5.002b1h/hints/irix_5.sh Tue Jan 2 14:53:52 1996 +--- perl5.002b2/hints/irix_5.sh Tue Jan 9 16:05:11 1996 + +Index: hints/linux.sh + + Updated + +*** perl5.002b1h/hints/linux.sh Fri Jun 2 10:20:55 1995 +--- perl5.002b2/hints/linux.sh Fri Jan 12 11:43:52 1996 + +Index: hints/machten.sh + + Updated + +*** perl5.002b1h/hints/machten.sh Sun Mar 12 02:36:04 1995 +--- perl5.002b2/hints/machten.sh Wed Jan 10 14:53:32 1996 + +Index: installman + + Use File::Path::mkpath instead of our own makedir(). + ./perl installman --man1dir=man1 could lead to infinte recursion + in old makedir() routine. Use the standard library instead. + +*** perl5.002b1h/installman Thu Dec 28 16:06:11 1995 +--- perl5.002b2/installman Thu Jan 11 16:12:30 1996 + +Index: installperl + + Use File::Path::mkpath instead of our own makedir(). + +*** perl5.002b1h/installperl Wed Jan 3 14:33:57 1996 +--- perl5.002b2/installperl Thu Jan 11 16:12:16 1996 + +Index: interp.sym + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/interp.sym Fri Nov 10 17:17:32 1995 +--- perl5.002b2/interp.sym Fri Jan 12 15:05:04 1996 + +Index: lib/AutoLoader.pm + + Undo Tim's tainting patch from beta1h. + +*** perl5.002b1h/lib/AutoLoader.pm Tue Jan 2 16:10:36 1996 +--- perl5.002b2/lib/AutoLoader.pm Fri Jan 5 16:02:28 1996 + +Index: lib/Carp.pm +*** perl5.002b1h/lib/Carp.pm Tue Jan 2 12:10:38 1996 +--- perl5.002b2/lib/Carp.pm Fri Jan 12 11:23:31 1996 + +Index: lib/ExtUtils/MM_VMS.pm + + Updated to MakeMaker-5.16. + +*** perl5.002b1h/lib/ExtUtils/MM_VMS.pm Tue Jan 2 14:07:10 1996 +--- perl5.002b2/lib/ExtUtils/MM_VMS.pm Thu Jan 4 21:00:46 1996 + +Index: lib/ExtUtils/MakeMaker.pm + + Updated to MakeMaker-5.16. + +Prereq: 1.129 +*** perl5.002b1h/lib/ExtUtils/MakeMaker.pm Tue Jan 2 14:07:10 1996 +--- perl5.002b2/lib/ExtUtils/MakeMaker.pm Wed Jan 10 16:13:05 1996 + +Index: lib/File/Find.pm + + Fixed exporting of symbols to work. + +*** perl5.002b1h/lib/File/Find.pm Wed Nov 15 15:20:03 1995 +--- perl5.002b2/lib/File/Find.pm Wed Jan 10 14:46:24 1996 + +Index: lib/I18N/Collate.pm + + Updated documentation to match program. + +*** perl5.002b1h/lib/I18N/Collate.pm Fri Jun 2 11:30:49 1995 +--- perl5.002b2/lib/I18N/Collate.pm Fri Jan 5 16:05:26 1996 + +Index: lib/Term/ReadLine.pm + + Stub new file to interface to various readline packages, or + give stub functions if none are found. + +*** /dev/null Sat Jan 13 16:48:01 1996 +--- perl5.002b2/lib/Term/ReadLine.pm Fri Jan 12 11:23:31 1996 + +Index: lib/dumpvar.pl + + Ilya's new debugger. + +*** perl5.002b1h/lib/dumpvar.pl Tue Oct 18 12:36:00 1994 +--- perl5.002b2/lib/dumpvar.pl Fri Jan 12 11:23:31 1996 + +Index: lib/perl5db.pl + + Ilya's new debugger. + +*** perl5.002b1h/lib/perl5db.pl Tue Jan 2 16:30:33 1996 +--- perl5.002b2/lib/perl5db.pl Fri Jan 12 11:23:31 1996 + +Index: lib/sigtrap.pm + + Ilya's new debugger. + +*** perl5.002b1h/lib/sigtrap.pm Thu May 25 11:20:13 1995 +--- perl5.002b2/lib/sigtrap.pm Fri Jan 12 11:23:31 1996 + +Index: miniperlmain.c + + More robust i18nl14n() function from jhi. + +*** perl5.002b1h/miniperlmain.c Thu Jan 4 12:03:37 1996 +--- perl5.002b2/miniperlmain.c Mon Jan 8 22:00:19 1996 + +Index: myconfig + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/myconfig Tue Apr 4 12:13:21 1995 +--- perl5.002b2/myconfig Fri Jan 12 10:53:35 1996 + +Index: op.c + + Chip's U8/STDCHAR patch. + +*** perl5.002b1h/op.c Wed Jan 3 14:17:01 1996 +--- perl5.002b2/op.c Fri Jan 12 15:05:05 1996 + +Index: perl.c + + Change Copyright date to include 1996. Hope you don't mind. + + Presumptively call this beta2. + +*** perl5.002b1h/perl.c Thu Jan 4 15:13:53 1996 +--- perl5.002b2/perl.c Fri Jan 12 15:05:05 1996 + +Index: perl.h + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/perl.h Wed Jan 3 12:21:55 1996 +--- perl5.002b2/perl.h Fri Jan 12 15:05:04 1996 + +Index: pod/Makefile + + Use PERL=../miniperl + +*** perl5.002b1h/pod/Makefile Wed Jan 3 15:06:41 1996 +--- perl5.002b2/pod/Makefile Fri Jan 5 14:14:30 1996 + +Index: pod/perlembed.pod + + Give correct usage for the 5th arg to perl_parse (don't pass + env). + +*** perl5.002b1h/pod/perlembed.pod Thu Dec 28 16:34:07 1995 +--- perl5.002b2/pod/perlembed.pod Tue Jan 9 16:02:51 1996 + +Index: pod/perlfunc.pod + + Work around a pod2man complaint about the -X function. + +*** perl5.002b1h/pod/perlfunc.pod Tue Jan 2 15:39:26 1996 +--- perl5.002b2/pod/perlfunc.pod Fri Jan 12 11:04:15 1996 + +*** perl5.002b1h/pod/perlfunc.pod Tue Jan 2 15:39:26 1996 +--- perl5.002b2/pod/perlfunc.pod Fri Jan 12 11:04:15 1996 + +Index: pod/perlovl.pod + + Add DESCRIPTION to head1 line. + +*** perl5.002b1h/pod/perlovl.pod Thu Dec 28 16:34:13 1995 +--- perl5.002b2/pod/perlovl.pod Thu Jan 11 17:11:16 1996 + +Index: pod/perlrun.pod + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/pod/perlrun.pod Thu Dec 28 16:34:15 1995 +--- perl5.002b2/pod/perlrun.pod Fri Jan 12 10:53:35 1996 + +Index: pp_ctl.c + + Debugger patch. + +*** perl5.002b1h/pp_ctl.c Wed Jan 3 12:23:13 1996 +--- perl5.002b2/pp_ctl.c Fri Jan 12 15:05:05 1996 + +Index: t/lib/posix.t + + Not having POSIX shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/posix.t Mon Jan 16 22:27:33 1995 +--- perl5.002b2/t/lib/posix.t Tue Jan 9 15:33:14 1996 + +Index: t/lib/safe.t + + Not having Safe shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/safe.t Tue Jan 2 15:43:53 1996 +--- perl5.002b2/t/lib/safe.t Tue Jan 9 15:35:43 1996 + +Index: t/lib/socket.t + + Not having Socket shouldn't result in test failing TEST harness. + +*** perl5.002b1h/t/lib/socket.t Fri Dec 8 11:16:01 1995 +--- perl5.002b2/t/lib/socket.t Tue Jan 9 15:35:51 1996 + +Index: t/op/time.t + + Test missed year-end wrap-around by one day. + +*** perl5.002b1h/t/op/time.t Tue Oct 18 12:46:31 1994 +--- perl5.002b2/t/op/time.t Wed Jan 10 16:04:41 1996 + +Index: toke.c + + Chip's U8/STDCHAR patch. + + Tim's "add a ; after PERL5DB" patch. + +*** perl5.002b1h/toke.c Wed Dec 6 13:24:19 1995 +--- perl5.002b2/toke.c Fri Jan 12 15:05:06 1996 + +Index: utils/h2xs.PL + + Updated to 1.13. Include Changes template file. + +*** perl5.002b1h/utils/h2xs.PL Tue Jan 2 13:50:55 1996 +--- perl5.002b2/utils/h2xs.PL Thu Jan 11 16:59:48 1996 + +Index: writemain.SH + + Updates from Tim's -m/-M/-V patch. + +*** perl5.002b1h/writemain.SH Sat Nov 18 15:51:55 1995 +--- perl5.002b2/writemain.SH Fri Jan 12 10:53:35 1996 + +------------- +Version 5.002b1h +------------- + +This is patch.2b1h to perl5.002beta1. This is mainly a clean-up +patch. No progress is made dealing with memory leaks or +optimizations, though I have used #define STRANGE_MALLOC to +work around at least some problems. + +Index: Configure + + Upgraded to metaconfig patchlevel 60. + + Add in usesafe variable to include or exclude the Safe extension. + + Test for sigaction(). + + Check for pager. This was actually accidental since perldoc.PL + mentions $pager and metaconfig has a unit to check for the + user's pager. In retrospect, I decided the Configure check + didn't do any harm and some extension writers might decide to + use it. + + Always put man1dir under $prefix unless a command line + override is used. + + Allow command-line overrides of $man1ext and $man3ext. + + + Allow man1dir and man3dir names like .../man.1 instead of + just .../man1. + + Lots of rearrangements of various pieces of Configure. + This might be because I ran metaconfig on a different + architecture. + + libc searching now honors $libpth. Previously, it (almost) + always looked in /usr/lib before checking /lib. + + Only prompt user if voidflags is not 15. If voidflags is 15, then + we presume all is well. + + +Prereq: 3.0.1.8 +*** perl5.002b1g/Configure Fri Dec 8 11:23:56 1995 +--- perl5.002b1h/Configure Thu Jan 4 11:14:37 1996 + +Index: INSTALL + + Document how to skip various extensions. + + Indicate that site_perl is typically under (not beside) + /usr/local/lib/perl5. + + Mention how to avoid nm extraction. + + +*** perl5.002b1g/INSTALL Tue Nov 21 22:54:28 1995 +--- perl5.002b1h/INSTALL Thu Jan 4 11:06:28 1996 + +Index: MANIFEST + + Rearrange files some. Try to move .PL utilities to a separate + utils/ subdirectory. + + Merge c2ph.PL and c2ph.doc. + + Add the Safe extension. + +*** perl5.002b1g/MANIFEST Fri Jan 5 11:41:50 1996 +--- perl5.002b1h/MANIFEST Wed Jan 3 14:37:54 1996 + +Index: Makefile.SH + + Now builds .PL utilities in the utils/ subdirectory. + +*** perl5.002b1g/Makefile.SH Fri Dec 8 10:36:33 1995 +--- perl5.002b1h/Makefile.SH Wed Jan 3 14:28:30 1996 + +Index: README.vms + + Updated. + +*** perl5.002b1g/README.vms Wed Nov 15 14:23:10 1995 +--- perl5.002b1h/README.vms Tue Jan 2 16:33:02 1996 + +Index: XSUB.h + + Updated to match xsubpp-1.929. + +*** perl5.002b1g/XSUB.h Wed Dec 6 13:25:26 1995 +--- perl5.002b1h/XSUB.h Tue Jan 2 11:57:57 1996 + +Index: config_h.SH + + Check for HAS_SIGACCTION + + Add STARTPERL define for C code (specifically, a2p). + +Prereq: 3.0.1.4 +*** perl5.002b1g/config_h.SH Fri Dec 8 11:23:56 1995 +--- perl5.002b1h/config_h.SH Thu Jan 4 11:14:37 1996 + +Index: doio.c + + VMS changes for kill. + +*** perl5.002b1g/doio.c Wed Nov 15 14:36:12 1995 +--- perl5.002b1h/doio.c Tue Jan 2 16:27:07 1996 + +Index: embed.h + + Auto-generated from global.sym and interp.sym. + +*** perl5.002b1g/embed.h Wed Nov 15 14:48:47 1995 +--- perl5.002b1h/embed.h Thu Jan 4 13:28:08 1996 + +Index: ext/DynaLoader/DynaLoader.pm + + VMS-specific updates. + +*** perl5.002b1g/ext/DynaLoader/DynaLoader.pm Fri Nov 10 11:49:00 1995 +--- perl5.002b1h/ext/DynaLoader/DynaLoader.pm Tue Jan 2 16:28:02 1996 + +Index: ext/DynaLoader/dl_vms.xs + + Updated to Oct 31, 1995 version. + +*** perl5.002b1g/ext/DynaLoader/dl_vms.xs Tue Oct 31 11:06:06 1995 +--- perl5.002b1h/ext/DynaLoader/dl_vms.xs Tue Jan 2 16:27:32 1996 + +Index: global.sym + + Added maxo and save_pptr items. + +*** perl5.002b1g/global.sym Wed Nov 15 14:58:14 1995 +--- perl5.002b1h/global.sym Wed Jan 3 12:01:59 1996 + +Index: hints/README.hints + + List of tested systems updated a little. + +*** perl5.002b1g/hints/README.hints Fri May 5 14:12:06 1995 +--- perl5.002b1h/hints/README.hints Tue Dec 12 20:03:36 1995 + +Index: hints/irix_5.sh + + Note SGI stdio/malloc related problem. + +*** perl5.002b1g/hints/irix_5.sh Fri May 5 14:07:52 1995 +--- perl5.002b1h/hints/irix_5.sh Tue Jan 2 14:53:52 1996 + +Index: hints/irix_6.sh + + Address change. + + Note SGI stdio/malloc related problem. + +*** perl5.002b1g/hints/irix_6.sh Fri May 5 14:08:41 1995 +--- perl5.002b1h/hints/irix_6.sh Tue Jan 2 14:54:04 1996 + +Index: hints/irix_6_2.sh + + Address change. + +*** perl5.002b1g/hints/irix_6_2.sh Mon Nov 20 11:16:55 1995 +--- perl5.002b1h/hints/irix_6_2.sh Tue Jan 2 14:49:45 1996 + +Index: hints/os2.sh + + Updated. + +*** perl5.002b1g/hints/os2.sh Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/hints/os2.sh Tue Dec 26 17:51:16 1995 + +Index: installman + + Use fork if available. + +*** perl5.002b1g/installman Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/installman Thu Dec 28 16:06:11 1995 + +Index: installperl + + Use new location of utility scripts. + + Eliminate double '//' and extra "". + +*** perl5.002b1g/installperl Mon Nov 20 12:55:03 1995 +--- perl5.002b1h/installperl Wed Jan 3 14:33:57 1996 + +Index: lib/AutoLoader.pm + + Avoid tainting problems. + +*** perl5.002b1g/lib/AutoLoader.pm Wed Nov 15 15:04:59 1995 +--- perl5.002b1h/lib/AutoLoader.pm Tue Jan 2 16:10:36 1996 + +Index: lib/Carp.pm + + Honor trailing \n in messages, as is done for warn(). + +*** perl5.002b1g/lib/Carp.pm Thu May 25 11:16:07 1995 +--- perl5.002b1h/lib/Carp.pm Tue Jan 2 12:10:38 1996 + +Index: lib/Cwd.pm + + VMS patches. + +*** perl5.002b1g/lib/Cwd.pm Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/lib/Cwd.pm Tue Jan 2 16:28:57 1996 + +Index: lib/Exporter.pm + + Include Tim Bunce's enhanced Exporter. I also tried to + resolve the two copies of documentation that I had. + +*** perl5.002b1g/lib/Exporter.pm Fri Jan 5 11:41:52 1996 +--- perl5.002b1h/lib/Exporter.pm Thu Jan 4 14:02:08 1996 + +Index: lib/ExtUtils/MM_VMS.pm + + New file. Incorporates VMS-specific items into MakeMaker. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/lib/ExtUtils/MM_VMS.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.116 + + Updated from 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/MakeMaker.pm Fri Jan 5 11:41:53 1996 +--- perl5.002b1h/lib/ExtUtils/MakeMaker.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/Manifest.pm + + Updated from MakeMaker 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/Manifest.pm Fri Jan 5 11:41:54 1996 +--- perl5.002b1h/lib/ExtUtils/Manifest.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/Mkbootstrap.pm + + Updated from MakeMaker 5.12 to 5.16. + +*** perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm Fri Jan 5 11:41:54 1996 +--- perl5.002b1h/lib/ExtUtils/Mkbootstrap.pm Tue Jan 2 14:07:10 1996 + +Index: lib/ExtUtils/xsubpp + + Updated from xsubpp-1.924 to 1.929. + +*** perl5.002b1g/lib/ExtUtils/xsubpp Sun Nov 26 16:04:50 1995 +--- perl5.002b1h/lib/ExtUtils/xsubpp Tue Jan 2 16:29:59 1996 + +Index: lib/File/Path.pm + + VMS-specific changes. + +*** perl5.002b1g/lib/File/Path.pm Wed Nov 15 15:20:31 1995 +--- perl5.002b1h/lib/File/Path.pm Tue Jan 2 16:30:21 1996 + +Index: lib/Pod/Text.pm + + New file. This was created by Dov (???) and enhanced + by Kenneth Albanowski, but all based on Tom C.'s pod2text. + Unfortunately, they used a version of pod2text earlier than + the one in patch.2b1g. I've tried to straighten this all out. + + Equally unfortunately, we've all left Tom as the AUTHOR, even + though we can't hold him responsible for errors he didn't + introduce. Oh well. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/lib/Pod/Text.pm Thu Jan 4 14:16:50 1996 + +Index: lib/Sys/Hostname.pm + + VMS-specific changes. + +*** perl5.002b1g/lib/Sys/Hostname.pm Fri Jan 5 11:41:55 1996 +--- perl5.002b1h/lib/Sys/Hostname.pm Tue Jan 2 16:30:49 1996 + +Index: lib/diagnostics.pm + + A patch from Tim Bunce (?) + +*** perl5.002b1g/lib/diagnostics.pm Wed Dec 6 13:58:42 1995 +--- perl5.002b1h/lib/diagnostics.pm Tue Jan 2 12:10:37 1996 + +Index: lib/perl5db.pl + + VMS-specific changes. + +*** perl5.002b1g/lib/perl5db.pl Wed Nov 15 22:37:45 1995 +--- perl5.002b1h/lib/perl5db.pl Tue Jan 2 16:30:33 1996 + +Index: lib/splain + + Fix some old typos. + +*** perl5.002b1g/lib/splain Tue Nov 14 16:16:36 1995 +--- perl5.002b1h/lib/splain Tue Jan 2 12:10:37 1996 + +Index: makeaperl.SH + + Use the 'new' startperl variable. + +*** perl5.002b1g/makeaperl.SH Thu Jun 1 11:20:52 1995 +--- perl5.002b1h/makeaperl.SH Tue Jan 2 12:11:28 1996 + +Index: mg.c + + Set up a reliable signal handler, courtesy of Kenneth Albanowski. + This needs to be documented still. The idea is that even on + System V systems, you won't have to reset the signal handler as + the first action inside your signal handler. + +*** perl5.002b1g/mg.c Wed Nov 15 15:44:10 1995 +--- perl5.002b1h/mg.c Thu Jan 4 13:49:12 1996 + +Index: minimod.pl + + Give a proper NAME description. + +*** perl5.002b1g/minimod.pl Sun Nov 26 16:19:55 1995 +--- perl5.002b1h/minimod.pl Tue Jan 2 14:30:24 1996 + +Index: miniperlmain.c + + Better locale handling, courtesy of jhi. + + Include a proper cast of NULL for non-prototyping compilers. + +*** perl5.002b1g/miniperlmain.c Sat Nov 18 15:48:10 1995 +--- perl5.002b1h/miniperlmain.c Thu Jan 4 12:03:37 1996 + +Index: op.c + + Turn on USE_OP_MASK by default for the Safe extension. I'll be + interested in benchmark results with this on and off. + +*** perl5.002b1g/op.c Wed Nov 15 22:10:36 1995 +--- perl5.002b1h/op.c Wed Jan 3 14:17:01 1996 + +Index: os2/Makefile.SHs + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/Makefile.SHs Sun Dec 24 13:55:22 1995 + +Index: os2/README + + Updated. + +*** perl5.002b1g/os2/README Tue Nov 14 14:42:13 1995 +--- perl5.002b1h/os2/README Tue Dec 26 18:31:32 1995 + +Index: os2/diff.MANIFEST + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.MANIFEST Tue Dec 26 19:54:12 1995 + +Index: os2/diff.Makefile + + Updated + +*** perl5.002b1g/os2/diff.Makefile Tue Nov 14 11:09:29 1995 +--- perl5.002b1h/os2/diff.Makefile Fri Dec 8 00:09:56 1995 + +Index: os2/diff.c2ph + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.c2ph Thu Dec 7 15:25:52 1995 + +Index: os2/diff.configure + + Updated. + +*** perl5.002b1g/os2/diff.configure Sun Nov 12 01:31:34 1995 +--- perl5.002b1h/os2/diff.configure Tue Dec 26 19:57:08 1995 + +Index: os2/diff.db_file + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.db_file Tue Dec 19 02:14:54 1995 + +Index: os2/diff.init + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.init Sun Nov 26 15:05:48 1995 + +Index: os2/diff.installman + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.installman Wed Nov 22 03:50:26 1995 + +Index: os2/diff.installperl + + Updated. + +*** perl5.002b1g/os2/diff.installperl Tue Nov 14 11:09:28 1995 +--- perl5.002b1h/os2/diff.installperl Wed Nov 22 02:59:58 1995 + +Index: os2/diff.mkdep + + Updated. + +*** perl5.002b1g/os2/diff.mkdep Tue Nov 14 11:09:28 1995 +--- perl5.002b1h/os2/diff.mkdep Sun Nov 26 15:00:24 1995 + +Index: os2/diff.rest + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/diff.rest Thu Dec 7 16:03:26 1995 + +Index: os2/diff.x2pMakefile + + Updated. + +*** perl5.002b1g/os2/diff.x2pMakefile Tue Nov 14 11:09:29 1995 +--- perl5.002b1h/os2/diff.x2pMakefile Wed Nov 22 21:55:42 1995 + +Index: os2/notes + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/notes Tue Dec 26 19:55:30 1995 + +Index: os2/os2.c + + Updated. + +*** perl5.002b1g/os2/os2.c Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/os2/os2.c Sun Dec 24 13:43:02 1995 + +Index: os2/os2ish.h + + Updated. + +*** perl5.002b1g/os2/os2ish.h Tue Nov 14 11:07:33 1995 +--- perl5.002b1h/os2/os2ish.h Mon Dec 18 16:17:38 1995 + +Index: os2/perl2cmd.pl + + New file. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/os2/perl2cmd.pl Tue Dec 19 11:20:42 1995 + +Index: perl.c + + Updated to say beta1h. + + Move VMS env code. + +*** perl5.002b1g/perl.c Fri Jan 5 11:41:56 1996 +--- perl5.002b1h/perl.c Thu Jan 4 15:13:53 1996 + +Index: perl.h + + 5.002beta1 attempted some memory optimizations, but unfortunately + they can result in a memory leak problem. This can be + avoided by #define STRANGE_MALLOC. I do that here until + consensus is reached on a better strategy for handling the + memory optimizations. + + Include maxo for the maximum number of operations (needed + for the Safe extension). + +*** perl5.002b1g/perl.h Wed Nov 15 17:13:16 1995 +--- perl5.002b1h/perl.h Wed Jan 3 12:21:55 1996 + +Index: pod/Makefile + + Include -I../lib so that pod2* can find the appropriate libraries. + + The pod names are once again sorted. + + The PERL line is wrong. It should read + PERL = ../miniperl + This file is automatically generated, but I happened to do it on + a system without miniperl avaialable, so my script fell back on + the perl default. + +*** perl5.002b1g/pod/Makefile Fri Jan 5 11:41:56 1996 +--- perl5.002b1h/pod/Makefile Wed Jan 3 15:06:41 1996 + +Index: pod/perlmod.pod + + Mention the Safe extension. + +*** perl5.002b1g/pod/perlmod.pod Fri Jan 5 11:41:59 1996 +--- perl5.002b1h/pod/perlmod.pod Thu Jan 4 13:52:14 1996 + +Index: pod/perltoc.pod + + Rebuilt using pod/buildtoc and fmt. + +*** perl5.002b1g/pod/perltoc.pod Fri Jan 5 11:42:00 1996 +--- perl5.002b1h/pod/perltoc.pod Thu Jan 4 14:04:20 1996 + +Index: pod/pod2text.PL +*** perl5.002b1g/pod/pod2text.PL Fri Jan 5 11:42:01 1996 +--- perl5.002b1h/pod/pod2text.PL Tue Jan 2 14:28:24 1996 + +Index: pp_sys.c + + VMS changes ? + +*** perl5.002b1g/pp_sys.c Wed Nov 15 21:51:33 1995 +--- perl5.002b1h/pp_sys.c Tue Jan 2 16:32:50 1996 + +Index: t/lib/safe.t + + New test. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/t/lib/safe.t Tue Jan 2 15:43:53 1996 + +Index: utils/Makefile + + New file to build the utilities. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/utils/Makefile Wed Jan 3 14:06:18 1996 + +Index: utils/c2ph.PL + + Ungracefully merge the old c2ph.doc in as an embedded pod. + + Delete lots of trailing spaces and tabs that have crept in. + +Prereq: 1.7 +*** perl5.002b1g/utils/c2ph.PL Mon Nov 20 12:36:17 1995 +--- perl5.002b1h/utils/c2ph.PL Wed Jan 3 14:05:41 1996 + +Index: utils/h2ph.PL + + Add patch for AIX files which sometimes have #include, + i.e., no spaces after the word 'include'. + +*** perl5.002b1g/utils/h2ph.PL Mon Nov 27 10:14:50 1995 +--- perl5.002b1h/utils/h2ph.PL Tue Jan 2 16:13:31 1996 + +Index: utils/h2xs.PL + + Add version stuff. + + The old version didn't have a number. This one's called 1.12. + +*** perl5.002b1g/utils/h2xs.PL Sun Nov 19 22:37:58 1995 +--- perl5.002b1h/utils/h2xs.PL Tue Jan 2 13:50:55 1996 + +Index: utils/perlbug.PL + + New utility. + +*** /dev/null Fri Jan 5 12:48:01 1996 +--- perl5.002b1h/utils/perlbug.PL Sat Nov 18 16:15:13 1995 + +Index: utils/perldoc.PL + + Better error handling. + + Updated to use Pod::Text, if available. + + More VMS friendly. + + New -u option . + +*** perl5.002b1g/utils/perldoc.PL Tue Nov 14 14:57:57 1995 +--- perl5.002b1h/utils/perldoc.PL Tue Jan 2 14:28:08 1996 + +Index: utils/pl2pm.PL + + Changed into a .PL extract file for proper setting of + $startperl. + + Add _minimal_ pod documentation. + +*** perl5.002b1g/utils/pl2pm.PL Mon Jan 16 23:45:07 1995 +--- perl5.002b1h/utils/pl2pm.PL Wed Jan 3 14:14:57 1996 + +Index: vms/Makefile + + Updated for VMS. + +*** perl5.002b1g/vms/Makefile Wed Nov 15 22:05:15 1995 +--- perl5.002b1h/vms/Makefile Tue Jan 2 16:33:53 1996 + +Index: vms/config.vms + + Updated for VMS. + +*** perl5.002b1g/vms/config.vms Wed Nov 15 22:05:26 1995 +--- perl5.002b1h/vms/config.vms Tue Jan 2 16:33:09 1996 + +Index: vms/descrip.mms + + Updated for VMS. + +*** perl5.002b1g/vms/descrip.mms Wed Nov 15 22:05:38 1995 +--- perl5.002b1h/vms/descrip.mms Tue Jan 2 16:33:18 1996 + +Index: vms/ext/Filespec.pm + + Updated for VMS. + +*** perl5.002b1g/vms/ext/Filespec.pm Sun Mar 12 03:14:26 1995 +--- perl5.002b1h/vms/ext/Filespec.pm Tue Jan 2 16:33:25 1996 + +Index: vms/ext/MM_VMS.pm + + Updated for VMS. This might be obsolete now that we have + lib/ExtUtils/MM_VMS.pm. + +*** perl5.002b1g/vms/ext/MM_VMS.pm Wed Nov 15 22:05:48 1995 +--- perl5.002b1h/vms/ext/MM_VMS.pm Tue Jan 2 16:33:32 1996 + +Index: vms/gen_shrfls.pl + + Updated for VMS. + +*** perl5.002b1g/vms/gen_shrfls.pl Wed Nov 15 22:06:27 1995 +--- perl5.002b1h/vms/gen_shrfls.pl Tue Jan 2 16:33:47 1996 + +Index: vms/genconfig.pl + + Updated for VMS. + +*** perl5.002b1g/vms/genconfig.pl Sun Mar 12 03:14:36 1995 +--- perl5.002b1h/vms/genconfig.pl Tue Jan 2 16:33:39 1996 + +Index: vms/perlvms.pod + + Updated for VMS. + +*** perl5.002b1g/vms/perlvms.pod Wed Nov 15 22:06:32 1995 +--- perl5.002b1h/vms/perlvms.pod Tue Jan 2 16:33:59 1996 + +Index: vms/test.com + + Updated for VMS. + +*** perl5.002b1g/vms/test.com Wed Nov 15 22:06:59 1995 +--- perl5.002b1h/vms/test.com Tue Jan 2 16:34:07 1996 + +Index: vms/vms.c + + Updated for VMS. + +Prereq: 2.2 +*** perl5.002b1g/vms/vms.c Wed Nov 15 22:07:10 1995 +--- perl5.002b1h/vms/vms.c Tue Jan 2 16:34:13 1996 + +Index: vms/vmsish.h + + Updated for VMS. + +*** perl5.002b1g/vms/vmsish.h Wed Nov 15 22:07:24 1995 +--- perl5.002b1h/vms/vmsish.h Tue Jan 2 16:34:20 1996 + +Index: vms/writemain.pl + + Updated for VMS. + +*** perl5.002b1g/vms/writemain.pl Mon Mar 6 20:00:18 1995 +--- perl5.002b1h/vms/writemain.pl Tue Jan 2 16:34:26 1996 + +Index: x2p/a2py.c + + Use new config_h.SH STARTPERL #define. + +*** perl5.002b1g/x2p/a2py.c Tue Mar 7 11:53:10 1995 +--- perl5.002b1h/x2p/a2py.c Tue Jan 2 12:11:28 1996 + +Index: x2p/find2perl.PL + + Add missing "" around $Config{startperl}. + +*** perl5.002b1g/x2p/find2perl.PL Sun Nov 19 23:11:58 1995 +--- perl5.002b1h/x2p/find2perl.PL Tue Jan 2 12:11:27 1996 + +Index: x2p/s2p.PL + + Add missing "" around $Config{startperl}. + +*** perl5.002b1g/x2p/s2p.PL Sun Nov 19 23:14:59 1995 +--- perl5.002b1h/x2p/s2p.PL Tue Jan 2 12:11:27 1996 + + +------------- +Version 5.002b1g +------------- + +This is patch.2b1g to perl5.002beta1. + +This patch is just my packaging of Tom's documentation patches +he released as patch.2b1g. + +Index: MANIFEST +*** perl5.002b1f/MANIFEST Fri Dec 8 13:34:53 1995 +--- perl5.002b1g/MANIFEST Thu Dec 21 13:00:58 1995 + +Index: ext/DB_File/DB_File.pm +*** perl5.002b1f/ext/DB_File/DB_File.pm Tue Nov 14 14:14:25 1995 +--- perl5.002b1g/ext/DB_File/DB_File.pm Thu Dec 21 13:00:58 1995 + +Index: ext/POSIX/POSIX.pm +*** perl5.002b1f/ext/POSIX/POSIX.pm Fri Dec 8 10:23:54 1995 +--- perl5.002b1g/ext/POSIX/POSIX.pm Thu Dec 21 13:00:58 1995 + +Index: ext/POSIX/POSIX.pod +*** perl5.002b1f/ext/POSIX/POSIX.pod Fri Dec 8 10:30:40 1995 +--- perl5.002b1g/ext/POSIX/POSIX.pod Thu Dec 21 13:00:59 1995 + +Index: ext/Safe/Makefile.PL +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Makefile.PL Thu Dec 21 13:01:00 1995 + +Index: ext/Safe/Safe.pm +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Safe.pm Thu Dec 21 13:01:00 1995 + +Index: ext/Safe/Safe.xs +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/ext/Safe/Safe.xs Thu Dec 21 13:01:00 1995 + +Index: ext/Socket/Socket.pm +*** perl5.002b1f/ext/Socket/Socket.pm Wed Dec 6 13:58:41 1995 +--- perl5.002b1g/ext/Socket/Socket.pm Thu Dec 21 13:01:00 1995 + +Index: installman +*** perl5.002b1f/installman Mon Nov 6 11:16:43 1995 +--- perl5.002b1g/installman Thu Dec 21 13:01:00 1995 + +Index: lib/AutoSplit.pm +*** perl5.002b1f/lib/AutoSplit.pm Wed Nov 15 15:06:19 1995 +--- perl5.002b1g/lib/AutoSplit.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Cwd.pm +*** perl5.002b1f/lib/Cwd.pm Fri Dec 8 10:42:46 1995 +--- perl5.002b1g/lib/Cwd.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Devel/SelfStubber.pm +*** perl5.002b1f/lib/Devel/SelfStubber.pm Sun Nov 26 16:59:51 1995 +--- perl5.002b1g/lib/Devel/SelfStubber.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Env.pm +*** perl5.002b1f/lib/Env.pm Tue Oct 18 12:34:43 1994 +--- perl5.002b1g/lib/Env.pm Thu Dec 21 13:01:01 1995 + +Index: lib/Exporter.pm +*** perl5.002b1f/lib/Exporter.pm Wed Nov 15 15:19:33 1995 +--- perl5.002b1g/lib/Exporter.pm Thu Dec 21 13:01:01 1995 + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1f/lib/ExtUtils/Liblist.pm Tue Dec 5 07:56:53 1995 +--- perl5.002b1g/lib/ExtUtils/Liblist.pm Thu Dec 21 13:01:01 1995 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.115 +*** perl5.002b1f/lib/ExtUtils/MakeMaker.pm Tue Dec 5 13:20:56 1995 +--- perl5.002b1g/lib/ExtUtils/MakeMaker.pm Thu Dec 21 13:01:02 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1f/lib/ExtUtils/Manifest.pm Tue Dec 5 13:21:00 1995 +--- perl5.002b1g/lib/ExtUtils/Manifest.pm Thu Dec 21 13:01:02 1995 + +Index: lib/ExtUtils/Mkbootstrap.pm +*** perl5.002b1f/lib/ExtUtils/Mkbootstrap.pm Thu Oct 19 05:58:34 1995 +--- perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm Thu Dec 21 13:01:02 1995 + +Index: lib/FileHandle.pm +*** perl5.002b1f/lib/FileHandle.pm Thu May 25 11:18:20 1995 +--- perl5.002b1g/lib/FileHandle.pm Thu Dec 21 13:01:02 1995 + +Index: lib/IPC/Open2.pm +*** perl5.002b1f/lib/IPC/Open2.pm Thu May 25 11:31:07 1995 +--- perl5.002b1g/lib/IPC/Open2.pm Thu Dec 21 13:01:03 1995 + +Index: lib/IPC/Open3.pm +Prereq: 1.1 +*** perl5.002b1f/lib/IPC/Open3.pm Wed Nov 15 15:21:11 1995 +--- perl5.002b1g/lib/IPC/Open3.pm Thu Dec 21 13:01:03 1995 + +Index: lib/SelfLoader.pm +*** perl5.002b1f/lib/SelfLoader.pm Sun Nov 26 16:59:51 1995 +--- perl5.002b1g/lib/SelfLoader.pm Thu Dec 21 13:01:03 1995 + +Index: lib/Sys/Hostname.pm +*** perl5.002b1f/lib/Sys/Hostname.pm Tue Oct 18 12:38:25 1994 +--- perl5.002b1g/lib/Sys/Hostname.pm Thu Dec 21 13:01:03 1995 + +Index: lib/Sys/Syslog.pm +*** perl5.002b1f/lib/Sys/Syslog.pm Wed Dec 6 14:07:54 1995 +--- perl5.002b1g/lib/Sys/Syslog.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Term/Cap.pm +*** perl5.002b1f/lib/Term/Cap.pm Sun Mar 12 00:14:42 1995 +--- perl5.002b1g/lib/Term/Cap.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Term/Complete.pm +*** perl5.002b1f/lib/Term/Complete.pm Wed May 24 12:09:48 1995 +--- perl5.002b1g/lib/Term/Complete.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Test/Harness.pm +*** perl5.002b1f/lib/Test/Harness.pm Mon Nov 13 23:01:40 1995 +--- perl5.002b1g/lib/Test/Harness.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Soundex.pm +Prereq: 1.2 +*** perl5.002b1f/lib/Text/Soundex.pm Tue Oct 18 12:38:42 1994 +--- perl5.002b1g/lib/Text/Soundex.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Tabs.pm +*** perl5.002b1f/lib/Text/Tabs.pm Sat Nov 18 16:08:55 1995 +--- perl5.002b1g/lib/Text/Tabs.pm Thu Dec 21 13:01:04 1995 + +Index: lib/Text/Wrap.pm +*** perl5.002b1f/lib/Text/Wrap.pm Sat Nov 18 16:08:56 1995 +--- perl5.002b1g/lib/Text/Wrap.pm Thu Dec 21 13:01:05 1995 + +Index: lib/TieHash.pm +*** perl5.002b1f/lib/TieHash.pm Wed Nov 15 15:27:47 1995 +--- perl5.002b1g/lib/TieHash.pm Thu Dec 21 13:01:05 1995 + +Index: lib/Time/Local.pm +*** perl5.002b1f/lib/Time/Local.pm Tue Oct 18 12:38:47 1994 +--- perl5.002b1g/lib/Time/Local.pm Thu Dec 21 13:01:05 1995 + +Index: lib/less.pm +*** perl5.002b1f/lib/less.pm Thu May 25 11:19:59 1995 +--- perl5.002b1g/lib/less.pm Thu Dec 21 13:01:05 1995 + +Index: lib/overload.pm +*** perl5.002b1f/lib/overload.pm Sat Nov 18 16:03:33 1995 +--- perl5.002b1g/lib/overload.pm Thu Dec 21 13:01:05 1995 + +Index: lib/strict.pm +*** perl5.002b1f/lib/strict.pm Thu May 25 11:20:27 1995 +--- perl5.002b1g/lib/strict.pm Thu Dec 21 13:01:05 1995 + +Index: lib/syslog.pl +*** perl5.002b1f/lib/syslog.pl Tue Oct 18 12:37:13 1994 +--- perl5.002b1g/lib/syslog.pl Thu Dec 21 13:01:05 1995 + +Index: perl.c +*** perl5.002b1f/perl.c Sun Nov 19 16:11:29 1995 +--- perl5.002b1g/perl.c Thu Dec 21 13:01:06 1995 + +Index: pod/Makefile +*** perl5.002b1f/pod/Makefile Mon Nov 20 13:00:50 1995 +--- perl5.002b1g/pod/Makefile Thu Dec 21 13:01:06 1995 + +Index: pod/PerlDoc/Functions.pm +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/PerlDoc/Functions.pm Thu Dec 21 13:01:07 1995 + +Index: pod/PerlDoc/Functions.pm.POSIX +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/PerlDoc/Functions.pm.POSIX Thu Dec 21 13:01:07 1995 + +Index: pod/buildtoc +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/buildtoc Thu Dec 21 13:01:07 1995 + +Index: pod/perl.pod +*** perl5.002b1f/pod/perl.pod Sat Nov 18 17:23:58 1995 +--- perl5.002b1g/pod/perl.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perlbot.pod +*** perl5.002b1f/pod/perlbot.pod Fri Nov 10 17:27:33 1995 +--- perl5.002b1g/pod/perlbot.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perldata.pod +*** perl5.002b1f/pod/perldata.pod Sat Nov 18 17:23:59 1995 +--- perl5.002b1g/pod/perldata.pod Thu Dec 21 13:01:07 1995 + +Index: pod/perldiag.pod +*** perl5.002b1f/pod/perldiag.pod Sun Nov 19 22:10:58 1995 +--- perl5.002b1g/pod/perldiag.pod Thu Dec 21 13:01:08 1995 + +Index: pod/perldsc.pod +*** perl5.002b1f/pod/perldsc.pod Sat Nov 18 17:24:22 1995 +--- perl5.002b1g/pod/perldsc.pod Thu Dec 21 13:01:08 1995 + +Index: pod/perlembed.pod +*** perl5.002b1f/pod/perlembed.pod Tue Oct 18 12:39:24 1994 +--- perl5.002b1g/pod/perlembed.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlform.pod +*** perl5.002b1f/pod/perlform.pod Sat Nov 18 17:23:59 1995 +--- perl5.002b1g/pod/perlform.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlfunc.pod +*** perl5.002b1f/pod/perlfunc.pod Sat Nov 18 17:24:01 1995 +--- perl5.002b1g/pod/perlfunc.pod Thu Dec 21 13:01:09 1995 + +Index: pod/perlguts.pod +*** perl5.002b1f/pod/perlguts.pod Tue Oct 31 15:38:18 1995 +--- perl5.002b1g/pod/perlguts.pod Thu Dec 21 13:01:10 1995 + +Index: pod/perlipc.pod +*** perl5.002b1f/pod/perlipc.pod Sat Nov 18 17:24:02 1995 +--- perl5.002b1g/pod/perlipc.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perllol.pod +*** perl5.002b1f/pod/perllol.pod Sat Nov 18 17:24:22 1995 +--- perl5.002b1g/pod/perllol.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlmod.pod +*** perl5.002b1f/pod/perlmod.pod Sat Nov 18 17:24:03 1995 +--- perl5.002b1g/pod/perlmod.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlobj.pod +*** perl5.002b1f/pod/perlobj.pod Sun Mar 12 00:48:38 1995 +--- perl5.002b1g/pod/perlobj.pod Thu Dec 21 13:01:11 1995 + +Index: pod/perlop.pod +*** perl5.002b1f/pod/perlop.pod Sat Nov 18 17:24:03 1995 +--- perl5.002b1g/pod/perlop.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlovl.pod +*** perl5.002b1f/pod/perlovl.pod Mon Jan 23 13:25:35 1995 +--- perl5.002b1g/pod/perlovl.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlpod.pod +*** perl5.002b1f/pod/perlpod.pod Sun Nov 19 22:22:59 1995 +--- perl5.002b1g/pod/perlpod.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlre.pod +*** perl5.002b1f/pod/perlre.pod Sun Nov 26 16:57:20 1995 +--- perl5.002b1g/pod/perlre.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlref.pod +*** perl5.002b1f/pod/perlref.pod Sat Nov 18 17:24:04 1995 +--- perl5.002b1g/pod/perlref.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlrun.pod +*** perl5.002b1f/pod/perlrun.pod Wed Feb 22 18:32:59 1995 +--- perl5.002b1g/pod/perlrun.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlsec.pod +*** perl5.002b1f/pod/perlsec.pod Wed Feb 22 18:33:02 1995 +--- perl5.002b1g/pod/perlsec.pod Thu Dec 21 13:01:12 1995 + +Index: pod/perlstyle.pod +*** perl5.002b1f/pod/perlstyle.pod Tue Oct 18 12:40:13 1994 +--- perl5.002b1g/pod/perlstyle.pod Thu Dec 21 13:01:13 1995 + +Index: pod/perlsub.pod +*** perl5.002b1f/pod/perlsub.pod Sun Mar 12 22:42:58 1995 +--- perl5.002b1g/pod/perlsub.pod Thu Dec 21 13:01:13 1995 + +Index: pod/perlsyn.pod +*** perl5.002b1f/pod/perlsyn.pod Sat Nov 18 17:24:04 1995 +--- perl5.002b1g/pod/perlsyn.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltie.pod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/perltie.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltoc.pod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/perltoc.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perltrap.pod +*** perl5.002b1f/pod/perltrap.pod Wed Nov 15 21:36:11 1995 +--- perl5.002b1g/pod/perltrap.pod Thu Dec 21 13:01:14 1995 + +Index: pod/perlvar.pod +*** perl5.002b1f/pod/perlvar.pod Wed Nov 15 21:36:59 1995 +--- perl5.002b1g/pod/perlvar.pod Thu Dec 21 13:01:15 1995 + +Index: pod/perlxs.pod +*** perl5.002b1f/pod/perlxs.pod Sun Nov 19 22:12:44 1995 +--- perl5.002b1g/pod/perlxs.pod Thu Dec 21 13:01:15 1995 + +Index: pod/perlxstut.pod +*** perl5.002b1f/pod/perlxstut.pod Mon Nov 20 13:02:12 1995 +--- perl5.002b1g/pod/perlxstut.pod Thu Dec 21 13:01:15 1995 + +Index: pod/pod2man.PL +Prereq: 1.5 +*** perl5.002b1f/pod/pod2man.PL Wed Nov 15 22:32:51 1995 +--- perl5.002b1g/pod/pod2man.PL Thu Dec 21 13:01:15 1995 + +Index: pod/pod2text +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/pod2text Thu Dec 21 13:01:16 1995 + +Index: pod/roffitall +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/roffitall Thu Dec 21 13:01:16 1995 + +Index: pod/splitpod +*** /dev/null Wed Jan 3 14:35:56 1996 +--- perl5.002b1g/pod/splitpod Thu Dec 21 13:01:16 1995 + +------------- +Version 5.002b1f +------------- + +This is patch.2b1f to perl5.002beta1. + +Index: Changes.Conf + +Include 5.001m -> 5.002beta1 changes. + +*** perl5.002b1e/Changes.Conf Mon Nov 20 10:08:05 1995 +--- perl5.002b1f/Changes.Conf Wed Dec 6 15:29:48 1995 + +Index: Configure + + Include Jeff Okamoto's patch to allow arbitrary specification + of $startperl. + + As requested, I have moved site_perl to be under + $privlib, by default. The default will now be + /usr/local/lib/perl5/site_perl. This is in accord with the way + emacs used to do it :-). + + +Prereq: 3.0.1.8 +*** perl5.002b1e/Configure Fri Dec 8 14:55:26 1995 +--- perl5.002b1f/Configure Fri Dec 8 11:23:56 1995 + +Index: MANIFEST + Add in POSIX.pod. I didn't include Dean's mkposixman tool because + it seemed to confuse MakeMaker, and I didn't want to manually fix + the POSIX/Makefile.PL file today. + + Renamed minimod.PL. The idea is as follows: I'd like to reserve + the .PL suffix for files that are extracted during build time, and + then can be deleted after installation. That is, it will be + analogous to the .SH suffix. For example, h2xs.PL creates + h2xs, and a 'make realclean' will remove the h2xs. Minimod.PL + was an exception to this pattern. Eventually, the .PL dependencies + will be generated automatically, just as the .SH dependencies are + now. + + Add in socket test. + +*** perl5.002b1e/MANIFEST Fri Dec 8 14:55:27 1995 +--- perl5.002b1f/MANIFEST Fri Dec 8 13:34:53 1995 + +Index: Makefile.SH + + Renamed minimod.PL to minimod.pl + +*** perl5.002b1e/Makefile.SH Mon Nov 20 15:56:12 1995 +--- perl5.002b1f/Makefile.SH Fri Dec 8 10:36:33 1995 + +Index: XSUB.h + + Include (SV*) cast in the newXSproto #define. + +*** perl5.002b1e/XSUB.h Fri Dec 8 14:55:14 1995 +--- perl5.002b1f/XSUB.h Wed Dec 6 13:25:26 1995 + +Index: ext/POSIX/POSIX.pm + + I have included Dean's patch and the .pod generated by mkposixman. + +*** perl5.002b1e/ext/POSIX/POSIX.pm Wed Nov 15 14:54:09 1995 +--- perl5.002b1f/ext/POSIX/POSIX.pm Fri Dec 8 10:23:54 1995 + +Index: ext/POSIX/POSIX.pod + + I have included Dean's patch and the .pod generated by mkposixman. + +*** /dev/null Fri Dec 8 13:36:14 1995 +--- perl5.002b1f/ext/POSIX/POSIX.pod Fri Dec 8 10:30:40 1995 + +Index: ext/POSIX/POSIX.xs + + I have included Dean's patch and the .pod generated by mkposixman. + +*** perl5.002b1e/ext/POSIX/POSIX.xs Wed Nov 15 14:56:22 1995 +--- perl5.002b1f/ext/POSIX/POSIX.xs Fri Dec 8 10:23:54 1995 + +Index: ext/Socket/Socket.pm + + Replace errant sockaddr_in by correct sockaddr_un. + Remove an extra ')'. -- from Tom C. + +*** perl5.002b1e/ext/Socket/Socket.pm Fri Dec 8 14:55:28 1995 +--- perl5.002b1f/ext/Socket/Socket.pm Wed Dec 6 13:58:41 1995 + +Index: gv.c + + Fix from Nick Ing-Simmons to get HvNAME(stash) from caller's + package. + +*** perl5.002b1e/gv.c Wed Nov 15 14:58:39 1995 +--- perl5.002b1f/gv.c Fri Dec 8 10:37:22 1995 + +Index: lib/Cwd.pm + + Fix a long-standing problem where insufficient permissions higher + up in the directory tree caused getcwd to fail. This often showed + up on AFS. + +*** perl5.002b1e/lib/Cwd.pm Mon Nov 13 23:01:38 1995 +--- perl5.002b1f/lib/Cwd.pm Fri Dec 8 10:42:46 1995 + +Index: lib/Sys/Syslog.pm + + Modernize Syslog.pm to 'use Socket;' and 'use Sys::Hostname'. + Alas, I've lost the attribution for this patch. Sorry about + that. + +*** perl5.002b1e/lib/Sys/Syslog.pm Thu Feb 9 20:05:36 1995 +--- perl5.002b1f/lib/Sys/Syslog.pm Wed Dec 6 14:07:54 1995 + +Index: lib/diagnostics.pm + + Fixes from Tom. + +*** perl5.002b1e/lib/diagnostics.pm Tue Nov 14 16:16:36 1995 +--- perl5.002b1f/lib/diagnostics.pm Wed Dec 6 13:58:42 1995 + +Index: t/lib/socket.t + + New test from Tom. I've allowed it to fail if the echo service is + disabled, as is apparently the case on some systems. + +*** /dev/null Fri Dec 8 13:36:14 1995 +--- perl5.002b1f/t/lib/socket.t Fri Dec 8 11:16:01 1995 + +Index: toke.c + + A patch from Paul Marquess "purely for source filters". + +*** perl5.002b1e/toke.c Wed Nov 15 22:08:23 1995 +--- perl5.002b1f/toke.c Wed Dec 6 13:24:19 1995 + +------------- +Version 5.002b1e +------------- + +This is patch.2b1e to perl5.002beta1. This is simply +an upgrade from MakeMaker-5.10 to MakeMaker-5.11. + + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1d/lib/ExtUtils/Liblist.pm Sat Dec 2 16:50:47 1995 +--- perl5.002b1e/lib/ExtUtils/Liblist.pm Wed Dec 6 11:52:22 1995 + +Index: lib/ExtUtils/MakeMaker.pm +Prereq: 1.114 +*** perl5.002b1d/lib/ExtUtils/MakeMaker.pm Sat Dec 2 16:50:48 1995 +--- perl5.002b1e/lib/ExtUtils/MakeMaker.pm Wed Dec 6 11:52:22 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1d/lib/ExtUtils/Manifest.pm Sat Dec 2 16:50:48 1995 +--- perl5.002b1e/lib/ExtUtils/Manifest.pm Wed Dec 6 11:52:22 1995 + +------------- +Version 5.002b1d +------------- + +This is patch.2b1d to perl5.002beta1. + +This patch includes patches for the following items: + + NETaa14710: Included bsdi_bsdos.sh hint file. + + pod/perlre.pod: Mention 32bit limit. + + Configure Updates. + + Update Socket.xs to version 1.5. This handles + systems that might not have . + + Fix missing quotes in h2ph.PL + +These are each described in detail below, after the corresponding +index line. + +Index: Configure + + locincpth should now work as documented in INSTALL + + Improved guessing of man1dir + + Remove spurious semicolon in NONBLOCK testing. + + Send failed './loc' message to fd 4. + + Check for + + Allow 'unixisms' to be overridden by hint files. + + Remove -r test from './loc' since some executables are + not readable. + + Remove spurious doublings of -L/usr/local/lib when reusing old + config.sh. + + Improved domain name guessing, from + Hallvard B Furuseth + + Include sitelib (architecture-independent directory). + + +Prereq: 3.0.1.8 +*** perl5.002b1c/Configure Mon Nov 20 10:00:33 1995 +--- perl5.002b1d/Configure Sat Dec 2 15:35:13 1995 + +Index: INSTALL + + Consistently use "sh Configure" in examples. + + Add reminder that interactive use may be helpful. + +*** perl5.002b1c/INSTALL Mon Nov 20 10:46:48 1995 +--- perl5.002b1d/INSTALL Tue Nov 21 22:54:28 1995 + +Index: MANIFEST + + Include renamed hint file. + +*** perl5.002b1c/MANIFEST Sat Dec 2 16:20:21 1995 +--- perl5.002b1d/MANIFEST Sun Nov 26 17:03:31 1995 + +Index: config_h.SH + + Include check for . + + Include SITELIB_EXP definition for architecture-independent + site-specific modules. Usually, this will be + /usr/local/lib/site_perl. + +Prereq: 3.0.1.4 +*** perl5.002b1c/config_h.SH Mon Nov 20 10:00:33 1995 +--- perl5.002b1d/config_h.SH Sat Dec 2 15:35:13 1995 + +Index: ext/Socket/Makefile.PL + + Update version number to 1.5. + +*** perl5.002b1c/ext/Socket/Makefile.PL Sat Nov 18 15:36:56 1995 +--- perl5.002b1d/ext/Socket/Makefile.PL Sat Dec 2 16:23:52 1995 + +Index: ext/Socket/Socket.pm + + Update to version 1.5. + +*** perl5.002b1c/ext/Socket/Socket.pm Sat Nov 18 15:37:03 1995 +--- perl5.002b1d/ext/Socket/Socket.pm Sat Dec 2 16:25:17 1995 + +Index: ext/Socket/Socket.xs + + Update to version 1.5. + This only supports the sockaddr_un -related functions if your + system has . SVR3 systems generally don't. + +*** perl5.002b1c/ext/Socket/Socket.xs Sat Nov 18 15:36:57 1995 +--- perl5.002b1d/ext/Socket/Socket.xs Sat Dec 2 15:46:20 1995 + +Index: h2ph.PL + + Add missing quotes. + +*** perl5.002b1c/h2ph.PL Sun Nov 19 23:00:39 1995 +--- perl5.002b1d/h2ph.PL Mon Nov 27 10:14:50 1995 + +Index: hints/bsdi_bsdos.sh + + Updated and renamed file. + +*** perl5.002b1c/hints/bsdi_bsdos.sh Thu Jan 19 19:08:34 1995 +--- perl5.002b1d/hints/bsdi_bsdos.sh Sun Nov 26 16:50:26 1995 + +Index: pod/perlre.pod + + Mention 65536 limit explicitly. + +*** perl5.002b1c/pod/perlre.pod Wed Nov 15 21:35:31 1995 +--- perl5.002b1d/pod/perlre.pod Sun Nov 26 16:57:20 1995 + +------------- +Version 5.002b1c +------------- + +This is patch.2b1c to perl5.002beta1. This patch includes + lib/SelfLoader, version 1.06, and + lib/Devel/SelfStubber, version 1.01. +These versions include prototype support. + +This is simply re-posting these library modules. +I have also updated MANIFEST to include them. + + +Index: MANIFEST +*** perl5.002b1b/MANIFEST Sat Dec 2 16:13:24 1995 +--- perl5.002b1c/MANIFEST Sat Dec 2 16:12:54 1995 + +Index: lib/Devel/SelfStubber.pm +*** /dev/null Fri Dec 1 16:03:22 1995 +--- perl5.002b1c/lib/Devel/SelfStubber.pm Sun Nov 26 16:14:19 1995 + +Index: lib/SelfLoader.pm +*** /dev/null Fri Dec 1 16:03:22 1995 +--- perl5.002b1c/lib/SelfLoader.pm Sun Nov 26 16:14:50 1995 + +------------- +Version 5.002b1b +------------- + +This is patch.2b1b to perl5.002beta1. This is simply +MakeMaker-5.10. Nothing else is included. + +It contains: + +Upgrade to MakeMaker-5.10 +and a revised minimod.PL that now writes a pod section into ExtUtils::Miniperl. + +Index: lib/ExtUtils/Liblist.pm +*** perl5.002b1a/lib/ExtUtils/Liblist.pm Mon Nov 13 22:03:29 1995 +--- perl5.002b1b/lib/ExtUtils/Liblist.pm Sat Dec 2 15:58:00 1995 + +Index: lib/ExtUtils/MakeMaker.pm +*** perl5.002b1a/lib/ExtUtils/MakeMaker.pm Sat Nov 18 16:01:05 1995 +--- perl5.002b1b/lib/ExtUtils/MakeMaker.pm Sat Dec 2 15:58:01 1995 + +Index: lib/ExtUtils/Manifest.pm +*** perl5.002b1a/lib/ExtUtils/Manifest.pm Mon Nov 13 22:03:30 1995 +--- perl5.002b1b/lib/ExtUtils/Manifest.pm Sat Dec 2 15:58:02 1995 + +Index: minimod.PL +*** perl5.002b1a/minimod.PL Sun Nov 19 23:01:02 1995 +--- perl5.002b1b/minimod.PL Sat Dec 2 15:58:02 1995 + +------------- +Version 5.002b1a +------------- + +This is patch.2b1a to perl5.002beta1. This is simply +xsubpp-1.944. It includes perl prototype support. + +Index: XSUB.h + +Updated to match xsubpp-1.944. Includes perl prototype support. + +*** perl5.002beta1/XSUB.h Fri Nov 10 13:11:02 1995 +--- perl5.002b1a/XSUB.h Sat Dec 2 15:43:54 1995 + +Index: lib/ExtUtils/xsubpp + +Updated to xsubpp-1.944. Includes perl prototype support. + +*** perl5.002beta1/lib/ExtUtils/xsubpp Mon Nov 20 11:03:49 1995 +--- perl5.002b1a/lib/ExtUtils/xsubpp Sat Dec 2 15:43:55 1995 + + + +Here are the detailed changes from 5.001m to 5.002beta1: + +# rm -f Doc/perl5-notes # Obsolete +# rm -f c2ph.SH # Replaced by c2ph.PL +# rm -f emacs/cperl-mode # Obsolete +# rm -f emacs/emacs19 # Obsolete +# rm -f emacs/perl-mode.el # Obsolete +# rm -f emacs/perldb.el # Obsolete +# rm -f emacs/perldb.pl # Obsolete +# rm -f emacs/tedstuff # Obsolete +# rm -f h2ph.SH # Replaced by h2ph.PL +# rm -f h2xs.SH # Replaced by h2xs.PL +# rm -f hints/hpux_9.sh # Replaced by generic hpux.sh +# rm -f hints/sco_3.sh # Replaced by generic sco.sh +# rm -f perldoc.SH # Replaced by perldoc.PL +# rm -f pod/pod2html.SH # Replaced by pod2html.PL +# rm -f pod/pod2latex.SH # Replaced by pod2latex.PL +# rm -f pod/pod2man.SH # Replaced by pod2man.PL +# rm -f x2p/find2perl.SH # Replaced by find2perl.PL +# rm -f x2p/s2p.SH # Replaced by s2p.PL +# exit + + +Index: patchlevel.h +Incremented to 2! +*** perl5.001.lwall/patchlevel.h Sun Mar 12 22:29:12 1995 +--- perl5.002beta1/patchlevel.h Sat Nov 18 15:41:15 1995 + +Index: Changes +This includes the Changes file Larry sent me. I added the first +paragraph. +*** perl5.001.lwall/Changes Mon Mar 13 00:44:07 1995 +--- perl5.002beta1/Changes Sat Nov 18 15:43:29 1995 + +Index: Changes.Conf +An all too brief summary. +*** perl5.001.lwall/Changes.Conf Thu Oct 19 21:00:06 1995 +--- perl5.002beta1/Changes.Conf Mon Nov 20 10:08:05 1995 + +Index: Configure + +Upgraded to metaconfig PL60 (despite the erroneous metaconfig message. + +Layed some groundwork for support on non Unix systems, such as OS/2. +Define things such as .o vs. .obj, '' vs. .exe, .a vs. .lib, etc. + +Include I_LOCALE testing. + +Include checks for new library set-up. I don't want to ever have to +change this again. It's documented more clearly in INSTALL. + +Figure out correct string for $startperl (usually +#!/usr/local/bin/perl). + +Improve signal detection even more. Once again, the signal number +corresponding to sig_name[n] is n (up to NSIG-1). Gaps in signal +numbers (e.g. on Solaris) are allowed and are filled with +innocuous names such as NUM37 NUM38, etc., where the 37 or 38 +represents the actual signal number. + +Prereq: 3.0.1.8 +*** perl5.001.lwall/Configure Mon Oct 23 14:08:59 1995 +--- perl5.002beta1/Configure Mon Nov 20 10:00:33 1995 + +Index: INSTALL + +Explain the library directory structure. + +Remove some tailing whitespace. + +Indicate that only the interfaces to gdbm and db are provided, not +the libraries themselves. + +Add section on upgrading from previous versions of perl5.00x. + +Mention how to override old config.sh with Configure -D and -O. + +*** perl5.001.lwall/INSTALL Mon Oct 23 14:10:26 1995 +--- perl5.002beta1/INSTALL Mon Nov 20 10:46:48 1995 + +Index: MANIFEST + +In an attempt to make the distribution slightly less Unix specific, +I've changed .SH extraction to a .PL extraction where possible. +That way folks on systems without a shell can still get the +auxilliarly files such as find2perl (assuming they *can* build +perl). + +The emacs/ directory was hopelessly out of date. I don't use emacs, +but included a current cperl-mode.el + +*** perl5.001.lwall/MANIFEST Tue Nov 14 15:21:03 1995 +--- perl5.002beta1/MANIFEST Mon Nov 20 12:40:41 1995 + +Index: Makefile.SH + +Add variables for non unix systems. + +Add .PL file extraction logic. + +*** perl5.001.lwall/Makefile.SH Tue Nov 14 20:25:48 1995 +--- perl5.002beta1/Makefile.SH Mon Nov 20 15:56:12 1995 + +Index: XSUB.h + +Protect arguments of macros with (). + +*** perl5.001.lwall/XSUB.h Tue Mar 7 14:10:00 1995 +--- perl5.002beta1/XSUB.h Fri Nov 10 13:11:02 1995 + +Index: c2ph.PL +Replaces c2ph.SH. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/c2ph.PL Mon Nov 20 12:36:17 1995 + +Index: cflags.SH +Allow for .o or .obj in file names. +*** perl5.001.lwall/cflags.SH Thu Jan 19 19:06:13 1995 +--- perl5.002beta1/cflags.SH Tue Nov 14 15:18:41 1995 + +Index: config_H +Updated. +Prereq: 3.0.1.3 +*** perl5.001.lwall/config_H Thu Oct 19 21:01:14 1995 +--- perl5.002beta1/config_H Mon Nov 20 15:41:49 1995 + +Index: config_h.SH +Updated to match new Configure. +Prereq: 3.0.1.3 +*** perl5.001.lwall/config_h.SH Mon Oct 23 14:10:38 1995 +--- perl5.002beta1/config_h.SH Mon Nov 20 10:00:33 1995 + +Index: configpm +Add in routine to print out full config.sh file. +*** perl5.001.lwall/configpm Wed Jun 7 19:46:01 1995 +--- perl5.002beta1/configpm Tue Oct 31 11:51:52 1995 + +Index: doop.c +Check for sprintf memory overflow that can arise from things +like %999999s. + +*** perl5.001.lwall/doop.c Sun Jul 2 23:33:44 1995 +--- perl5.002beta1/doop.c Wed Nov 15 15:08:01 1995 + +Index: emacs/cperl-mode.el +New version. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/emacs/cperl-mode.el Sat Nov 11 16:29:33 1995 + +Index: embed.h +Remove unnecessary whichsigname introduced in patch.1n. +*** perl5.001.lwall/embed.h Tue Nov 14 15:21:08 1995 +--- perl5.002beta1/embed.h Wed Nov 15 14:48:47 1995 + +Index: ext/DB_File/DB_File.pm +Updated to version 1.01. +*** perl5.001.lwall/ext/DB_File/DB_File.pm Wed Jun 7 19:46:14 1995 +--- perl5.002beta1/ext/DB_File/DB_File.pm Tue Nov 14 14:14:25 1995 + +Index: ext/DB_File/DB_File.xs +Updated to version 1.01. +*** perl5.001.lwall/ext/DB_File/DB_File.xs Wed Jun 7 19:46:17 1995 +--- perl5.002beta1/ext/DB_File/DB_File.xs Tue Nov 14 14:14:37 1995 + +Index: ext/DB_File/Makefile.PL +Updated to version 1.01. +*** perl5.001.lwall/ext/DB_File/Makefile.PL Wed Feb 22 14:36:32 1995 +--- perl5.002beta1/ext/DB_File/Makefile.PL Tue Nov 14 14:14:17 1995 + +Index: ext/DB_File/typemap +Fix typemap to avoid core dump. +*** perl5.001.lwall/ext/DB_File/typemap Tue Oct 18 12:27:52 1994 +--- perl5.002beta1/ext/DB_File/typemap Tue Oct 31 11:53:28 1995 + +Index: ext/DynaLoader/DynaLoader.pm +Add parentheses to Carp::confess call. +*** perl5.001.lwall/ext/DynaLoader/DynaLoader.pm Thu Oct 19 20:13:25 1995 +--- perl5.002beta1/ext/DynaLoader/DynaLoader.pm Fri Nov 10 11:49:00 1995 + +Index: ext/DynaLoader/dl_os2.xs +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/ext/DynaLoader/dl_os2.xs Mon Nov 13 22:58:42 1995 + +Index: ext/Fcntl/Fcntl.xs +Add O_BINARY define for OS/2. +*** perl5.001.lwall/ext/Fcntl/Fcntl.xs Mon Oct 23 14:10:54 1995 +--- perl5.002beta1/ext/Fcntl/Fcntl.xs Mon Nov 13 23:01:40 1995 + +Index: ext/GDBM_File/GDBM_File.pm +Added a tiny bit of documentation, including how to get gdbm. +Shamelessly stolen from the DB_File.pm documentation. +*** perl5.001.lwall/ext/GDBM_File/GDBM_File.pm Wed Jun 7 19:46:34 1995 +--- perl5.002beta1/ext/GDBM_File/GDBM_File.pm Mon Nov 20 10:22:26 1995 + +Index: ext/GDBM_File/GDBM_File.xs +Add gdbm_EXISTS #define. +*** perl5.001.lwall/ext/GDBM_File/GDBM_File.xs Sat Jul 1 18:44:02 1995 +--- perl5.002beta1/ext/GDBM_File/GDBM_File.xs Sat Nov 11 14:25:50 1995 + +Index: ext/NDBM_File/hints/solaris.pl +Updated for MakeMaker 5.0x. +*** perl5.001.lwall/ext/NDBM_File/hints/solaris.pl Wed Jun 7 19:46:39 1995 +--- perl5.002beta1/ext/NDBM_File/hints/solaris.pl Fri Nov 10 10:39:23 1995 + +Index: ext/ODBM_File/hints/sco.pl +Updated for MakeMaker 5.0x. +*** perl5.001.lwall/ext/ODBM_File/hints/sco.pl Wed Jun 7 19:46:44 1995 +--- perl5.002beta1/ext/ODBM_File/hints/sco.pl Fri Nov 10 10:39:32 1995 + +Index: ext/ODBM_File/hints/solaris.pl +Updated for MakeMaker 5.0x. +*** perl5.001.lwall/ext/ODBM_File/hints/solaris.pl Wed Jun 7 19:46:46 1995 +--- perl5.002beta1/ext/ODBM_File/hints/solaris.pl Fri Nov 10 10:39:44 1995 + +Index: ext/ODBM_File/hints/svr4.pl +Updated for MakeMaker 5.0x. +*** perl5.001.lwall/ext/ODBM_File/hints/svr4.pl Wed Jun 7 19:46:48 1995 +--- perl5.002beta1/ext/ODBM_File/hints/svr4.pl Fri Nov 10 10:39:54 1995 + +Index: ext/POSIX/POSIX.pm +Remove POSIX_loadlibs relics from perl5alpha days. +*** perl5.001.lwall/ext/POSIX/POSIX.pm Thu Sep 21 19:14:19 1995 +--- perl5.002beta1/ext/POSIX/POSIX.pm Wed Nov 15 14:54:09 1995 + +Index: ext/POSIX/POSIX.xs +Change whichsigname(sig) back to sig_name[sig]. +*** perl5.001.lwall/ext/POSIX/POSIX.xs Mon Oct 23 14:11:01 1995 +--- perl5.002beta1/ext/POSIX/POSIX.xs Wed Nov 15 14:56:22 1995 + +Index: ext/SDBM_File/Makefile.PL +Updated for MakeMaker 5.0x to allow compilation on non-unix systems. +*** perl5.001.lwall/ext/SDBM_File/Makefile.PL Thu Jan 19 18:59:02 1995 +--- perl5.002beta1/ext/SDBM_File/Makefile.PL Tue Nov 14 11:16:43 1995 + +Index: ext/SDBM_File/sdbm/Makefile.PL +Updated for MakeMaker 5.0x to allow compilation on non-unix systems. +*** perl5.001.lwall/ext/SDBM_File/sdbm/Makefile.PL Wed Feb 22 14:36:47 1995 +--- perl5.002beta1/ext/SDBM_File/sdbm/Makefile.PL Tue Nov 14 11:17:16 1995 + +Index: ext/SDBM_File/sdbm/sdbm.c +Include OS/2 O_BINARY flag. +Prereq: 1.16 +*** perl5.001.lwall/ext/SDBM_File/sdbm/sdbm.c Wed Jun 7 19:46:57 1995 +--- perl5.002beta1/ext/SDBM_File/sdbm/sdbm.c Mon Nov 13 23:01:41 1995 + +Index: ext/Socket/Makefile.PL +Updated to 1.3. Actually we're up to 1.4, but I forgot to update +the Makefile.PL. +*** perl5.001.lwall/ext/Socket/Makefile.PL Thu Jan 19 18:59:06 1995 +--- perl5.002beta1/ext/Socket/Makefile.PL Sat Nov 18 15:36:56 1995 + +Index: ext/Socket/Socket.pm +Updated to 1.3. Actually we're up to 1.4, but I forgot to update +the version number. This adds some non-portable stuff to manipulate +structures in . I'll have to #ifdef it out in the next +patch. + +*** perl5.001.lwall/ext/Socket/Socket.pm Sat Jul 1 15:51:54 1995 +--- perl5.002beta1/ext/Socket/Socket.pm Sat Nov 18 15:37:03 1995 + +Index: ext/Socket/Socket.xs +Updated to 1.3. Actually we're up to 1.4, but I forgot to update +the version number. This adds some non-portable stuff to manipulate +structures in . I'll have to #ifdef it out in the next +patch. + +*** perl5.001.lwall/ext/Socket/Socket.xs Sat Jul 1 15:51:56 1995 +--- perl5.002beta1/ext/Socket/Socket.xs Sat Nov 18 15:36:57 1995 + +Index: global.sym +Remove unnecessary whichsigname that was added in patch.1n. +*** perl5.001.lwall/global.sym Tue Nov 14 15:21:11 1995 +--- perl5.002beta1/global.sym Wed Nov 15 14:58:14 1995 + +Index: h2ph.PL +Converted from h2ph.SH. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/h2ph.PL Sun Nov 19 23:00:39 1995 + +Index: h2xs.PL +Converted from h2xs.SH. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/h2xs.PL Sun Nov 19 22:37:58 1995 + +Index: hints/aix.sh +Add gcc-specific -Xlinker, if you're using gcc. +*** perl5.001.lwall/hints/aix.sh Thu Oct 19 21:02:08 1995 +--- perl5.002beta1/hints/aix.sh Mon Nov 13 23:03:33 1995 + +Index: hints/freebsd.sh +Warn about possible here-document problem. +*** perl5.001.lwall/hints/freebsd.sh Sat Jul 1 18:44:07 1995 +--- perl5.002beta1/hints/freebsd.sh Sat Nov 18 16:21:20 1995 + +Index: hints/hpux.sh +Replace old hpux_9.sh, since this works for 9 and 10. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/hints/hpux.sh Mon Nov 20 09:53:28 1995 + +Index: hints/irix_6_2.sh +New hint file. This should be merged with irix_6.sh, since it's +almost identical. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/hints/irix_6_2.sh Mon Nov 20 11:16:55 1995 + +Index: hints/ncr_tower.sh +Give pointers about directory functions. +*** perl5.001.lwall/hints/ncr_tower.sh Tue Oct 18 12:33:25 1994 +--- perl5.002beta1/hints/ncr_tower.sh Tue Oct 31 11:57:51 1995 + +Index: hints/netbsd.sh +Updated. +*** perl5.001.lwall/hints/netbsd.sh Wed Jun 7 19:47:45 1995 +--- perl5.002beta1/hints/netbsd.sh Mon Nov 13 23:04:17 1995 + +Index: hints/os2.sh +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/hints/os2.sh Tue Nov 14 11:07:33 1995 + +Index: hints/sco.sh +Renamed from sco_3, since it should apply to most recent versions. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/hints/sco.sh Mon Jun 5 11:50:11 1995 + +Index: hints/solaris_2.sh +Remove temporary file try.c. +*** perl5.001.lwall/hints/solaris_2.sh Thu Oct 19 21:02:37 1995 +--- perl5.002beta1/hints/solaris_2.sh Mon Nov 20 16:01:50 1995 + +Index: hints/ultrix_4.sh +Note that you can substitute sh5 for sh to get a big speed up. +*** perl5.001.lwall/hints/ultrix_4.sh Mon Feb 13 20:15:05 1995 +--- perl5.002beta1/hints/ultrix_4.sh Sat Nov 11 17:11:41 1995 + +Index: installman +Quit if they just asked for help with -h. +*** perl5.001.lwall/installman Sat Jul 1 18:44:09 1995 +--- perl5.002beta1/installman Mon Nov 6 11:16:43 1995 + +Index: installperl +Updated to use Config rather than hand-reading config.sh again. + +Install h2ph. + +Create site_perl and site_perl/archname directories. + +*** perl5.001.lwall/installperl Sat Jul 1 18:44:12 1995 +--- perl5.002beta1/installperl Mon Nov 20 12:55:08 1995 + +Index: lib/AutoSplit.pm +Handle OS/2 backslashes. + +Tim's prototype patch. + +Less enthusiastic checking of autoloader_seen. + +*** perl5.001.lwall/lib/AutoSplit.pm Sat Jul 1 15:52:03 1995 +--- perl5.002beta1/lib/AutoSplit.pm Wed Nov 15 15:06:19 1995 + +Index: lib/Cwd.pm +Updated for Unix, NT, and OS/2. +*** perl5.001.lwall/lib/Cwd.pm Wed Jun 7 19:48:18 1995 +--- perl5.002beta1/lib/Cwd.pm Mon Nov 13 23:01:38 1995 + +Index: lib/ExtUtils/Liblist.pm +Updated to MakeMaker 5.06. +*** perl5.001.lwall/lib/ExtUtils/Liblist.pm Wed Jun 7 19:48:27 1995 +--- perl5.002beta1/lib/ExtUtils/Liblist.pm Mon Nov 13 22:03:29 1995 + +Index: lib/ExtUtils/MakeMaker.pm +Updated to MakeMaker 5.06. +Prereq: 1.21 +*** perl5.001.lwall/lib/ExtUtils/MakeMaker.pm Thu Oct 19 21:02:57 1995 +--- perl5.002beta1/lib/ExtUtils/MakeMaker.pm Sat Nov 18 16:01:05 1995 + +Index: lib/ExtUtils/Manifest.pm +Updated to MakeMaker 5.06. +*** perl5.001.lwall/lib/ExtUtils/Manifest.pm Sat Jul 1 15:52:11 1995 +--- perl5.002beta1/lib/ExtUtils/Manifest.pm Mon Nov 13 22:03:30 1995 + +Index: lib/ExtUtils/xsubpp +Updated to xsubpp-1.923. +*** perl5.001.lwall/lib/ExtUtils/xsubpp Sat Jul 1 20:08:00 1995 +--- perl5.002beta1/lib/ExtUtils/xsubpp Mon Nov 20 11:03:49 1995 + +Index: lib/File/Find.pm +OS/2 patch for nlink. +*** perl5.001.lwall/lib/File/Find.pm Sat Jul 1 15:52:13 1995 +--- perl5.002beta1/lib/File/Find.pm Wed Nov 15 15:20:03 1995 + +Index: lib/Net/Ping.pm +Updated to Net::Ping 1.00. +*** perl5.001.lwall/lib/Net/Ping.pm Wed Jun 7 19:49:13 1995 +--- perl5.002beta1/lib/Net/Ping.pm Tue Oct 31 11:15:55 1995 + +Index: lib/Shell.pm +Updated for OS/2 or Unix. +*** perl5.001.lwall/lib/Shell.pm Tue Oct 18 12:34:59 1994 +--- perl5.002beta1/lib/Shell.pm Mon Nov 13 23:01:40 1995 + +Index: lib/Test/Harness.pm +Updated for OS/2 or Unix. +*** perl5.001.lwall/lib/Test/Harness.pm Tue Oct 18 12:38:35 1994 +--- perl5.002beta1/lib/Test/Harness.pm Mon Nov 13 23:01:40 1995 + +Index: lib/Text/Tabs.pm +Updated. +*** perl5.001.lwall/lib/Text/Tabs.pm Wed Jun 7 19:49:20 1995 +--- perl5.002beta1/lib/Text/Tabs.pm Sat Nov 18 16:08:55 1995 + +Index: lib/Text/Wrap.pm +New module. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/lib/Text/Wrap.pm Sat Nov 18 16:08:56 1995 + +Index: lib/diagnostics.pm +New module. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/lib/diagnostics.pm Tue Nov 14 16:16:36 1995 + +Index: lib/lib.pm +Automatically try to load an architecture-dependent library too. +*** perl5.001.lwall/lib/lib.pm Sat Jul 1 15:51:37 1995 +--- perl5.002beta1/lib/lib.pm Fri Nov 10 16:50:43 1995 + +Index: lib/overload.pm +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/lib/overload.pm Sat Nov 18 16:03:33 1995 + +Index: lib/perl5db.pl +Emacs and OS/2 fixes. +*** perl5.001.lwall/lib/perl5db.pl Sun Mar 12 22:34:53 1995 +--- perl5.002beta1/lib/perl5db.pl Wed Nov 15 22:37:45 1995 + +Index: lib/splain +New file -- same as diagnostics.pm. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/lib/splain Tue Nov 14 16:16:36 1995 + +Index: mg.c +Remove unnecessary whichsigname introduced in 5.001n. +*** perl5.001.lwall/mg.c Tue Nov 14 15:31:03 1995 +--- perl5.002beta1/mg.c Wed Nov 15 15:44:10 1995 + +Index: minimod.PL +Made c++ friendly. +*** perl5.001.lwall/minimod.PL Mon Feb 13 20:15:47 1995 +--- perl5.002beta1/minimod.PL Sun Nov 19 23:01:02 1995 + +Index: miniperlmain.c +Made c++ friendly. +*** perl5.001.lwall/miniperlmain.c Mon Feb 13 21:48:50 1995 +--- perl5.002beta1/miniperlmain.c Sat Nov 18 15:48:10 1995 + +Index: op.c +Larry's post 5.001mx prototype patch. +*** perl5.001.lwall/op.c Tue Nov 14 20:36:08 1995 +--- perl5.002beta1/op.c Wed Nov 15 22:10:36 1995 + +Index: os2/Makefile.SH +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/Makefile.SH Tue Nov 14 11:07:32 1995 + +Index: os2/POSIX.mkfifo +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/POSIX.mkfifo Tue Nov 14 10:48:16 1995 + +Index: os2/README +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/README Tue Nov 14 14:42:13 1995 + +Index: os2/diff.Makefile +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/diff.Makefile Tue Nov 14 11:09:29 1995 + +Index: os2/diff.configure +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/diff.configure Sun Nov 12 01:31:34 1995 + +Index: os2/diff.installperl +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/diff.installperl Tue Nov 14 11:09:28 1995 + +Index: os2/diff.mkdep +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/diff.mkdep Tue Nov 14 11:09:28 1995 + +Index: os2/diff.x2pMakefile +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/diff.x2pMakefile Tue Nov 14 11:09:29 1995 + +Index: os2/os2.c +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/os2.c Tue Nov 14 11:07:33 1995 + +Index: os2/os2ish.h +New file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/os2/os2ish.h Tue Nov 14 11:07:33 1995 + +Index: perl.c +Add -h option to print out usage. + +Add 'beta' to version number. + +Add new library hierarchy. See INSTALL. + +*** perl5.001.lwall/perl.c Tue Nov 14 20:09:28 1995 +--- perl5.002beta1/perl.c Sun Nov 19 16:11:29 1995 + +Index: perl.h + +Move around some includes for OS/2. + +Check for + +*** perl5.001.lwall/perl.h Thu Nov 9 19:50:43 1995 +--- perl5.002beta1/perl.h Wed Nov 15 17:13:16 1995 + +Index: perldoc.PL + +Moved from perldoc.SH. Updated to handle no nroff. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/perldoc.PL Tue Nov 14 14:57:57 1995 + +Index: pod/Makefile +Updated for new pods and for new .PL format. +*** perl5.001.lwall/pod/Makefile Wed Jun 7 19:50:02 1995 +--- perl5.002beta1/pod/Makefile Mon Nov 20 13:00:50 1995 + +Index: pod/perl.pod +Updated to refer to new pods. +*** perl5.001.lwall/pod/perl.pod Thu Oct 5 19:54:43 1995 +--- perl5.002beta1/pod/perl.pod Sat Nov 18 17:23:58 1995 + +Index: pod/perlbook.pod +Updated info. +*** perl5.001.lwall/pod/perlbook.pod Wed Feb 22 18:32:35 1995 +--- perl5.002beta1/pod/perlbook.pod Sat Nov 11 17:17:23 1995 + +Index: pod/perlbot.pod +Include SUPER stuff. +*** perl5.001.lwall/pod/perlbot.pod Wed Jun 7 19:50:14 1995 +--- perl5.002beta1/pod/perlbot.pod Fri Nov 10 17:27:33 1995 + +Index: pod/perlcall.pod +Change perlapi to perlxs. +*** perl5.001.lwall/pod/perlcall.pod Wed Jun 7 19:50:17 1995 +--- perl5.002beta1/pod/perlcall.pod Tue Oct 31 15:37:57 1995 + +Index: pod/perldata.pod +Tom's updates. +*** perl5.001.lwall/pod/perldata.pod Sun Mar 12 22:35:14 1995 +--- perl5.002beta1/pod/perldata.pod Sat Nov 18 17:23:59 1995 + +Index: pod/perldiag.pod +Tom's updates. +*** perl5.001.lwall/pod/perldiag.pod Tue Nov 14 22:04:11 1995 +--- perl5.002beta1/pod/perldiag.pod Sun Nov 19 22:10:58 1995 + +Index: pod/perldsc.pod +Tom's updates. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/perldsc.pod Sat Nov 18 17:24:22 1995 + +Index: pod/perlform.pod +Tom's updates. +*** perl5.001.lwall/pod/perlform.pod Wed Feb 22 18:32:41 1995 +--- perl5.002beta1/pod/perlform.pod Sat Nov 18 17:23:59 1995 + +Index: pod/perlfunc.pod +Tom's updates. +*** perl5.001.lwall/pod/perlfunc.pod Tue Nov 14 15:31:33 1995 +--- perl5.002beta1/pod/perlfunc.pod Sat Nov 18 17:24:01 1995 + +Index: pod/perlguts.pod +Change perlapi to perlxs. +*** perl5.001.lwall/pod/perlguts.pod Wed Jun 7 19:50:25 1995 +--- perl5.002beta1/pod/perlguts.pod Tue Oct 31 15:38:18 1995 + +Index: pod/perlipc.pod +New file from Tom. +*** perl5.001.lwall/pod/perlipc.pod Wed Feb 22 18:32:48 1995 +--- perl5.002beta1/pod/perlipc.pod Sat Nov 18 17:24:02 1995 + +Index: pod/perllol.pod +New file from Tom. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/perllol.pod Sat Nov 18 17:24:22 1995 + +Index: pod/perlmod.pod +Updates from Tom. +*** perl5.001.lwall/pod/perlmod.pod Wed Feb 22 18:32:51 1995 +--- perl5.002beta1/pod/perlmod.pod Sat Nov 18 17:24:03 1995 + +Index: pod/perlop.pod +Add missing '>'. +*** perl5.001.lwall/pod/perlop.pod Tue Nov 14 15:31:37 1995 +--- perl5.002beta1/pod/perlop.pod Sat Nov 18 17:24:03 1995 + +Index: pod/perlpod.pod +Add note about =cut operator. +*** perl5.001.lwall/pod/perlpod.pod Tue Oct 18 12:39:53 1994 +--- perl5.002beta1/pod/perlpod.pod Sun Nov 19 22:22:59 1995 + +Index: pod/perlref.pod +Updates from Tom. +*** perl5.001.lwall/pod/perlref.pod Tue Mar 7 00:56:46 1995 +--- perl5.002beta1/pod/perlref.pod Sat Nov 18 17:24:04 1995 + +Index: pod/perlsyn.pod +Updates from Tom. +*** perl5.001.lwall/pod/perlsyn.pod Sat Mar 11 14:13:48 1995 +--- perl5.002beta1/pod/perlsyn.pod Sat Nov 18 17:24:04 1995 + +Index: pod/perlxs.pod +Updated. +*** perl5.001.lwall/pod/perlxs.pod Tue Nov 14 15:31:42 1995 +--- perl5.002beta1/pod/perlxs.pod Sun Nov 19 22:12:44 1995 + +Index: pod/perlxstut.pod +New file from Jeff. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/perlxstut.pod Mon Nov 20 13:02:12 1995 + +Index: pod/pod2html.PL +Updated -- version 1.15 merges Tom's suggestions and ideas from +pod2fm. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/pod2html.PL Sun Nov 19 22:11:59 1995 + +Index: pod/pod2latex.PL +Changed to a .PL file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/pod2latex.PL Wed Nov 15 22:32:39 1995 + +Index: pod/pod2man.PL +Changed to a .PL file. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/pod/pod2man.PL Wed Nov 15 22:32:51 1995 + +Index: pp_ctl.c +Add OS/2 stuff. +*** perl5.001.lwall/pp_ctl.c Wed Nov 15 00:37:25 1995 +--- perl5.002beta1/pp_ctl.c Wed Nov 15 21:46:37 1995 + +Index: pp_sys.c +Add OS/2 stuff. +*** perl5.001.lwall/pp_sys.c Tue Nov 14 21:03:06 1995 +--- perl5.002beta1/pp_sys.c Wed Nov 15 21:51:33 1995 + +Index: proto.h +Add OS/2 stuff to better protect MYMALLOC. +*** perl5.001.lwall/proto.h Tue Nov 14 21:01:28 1995 +--- perl5.002beta1/proto.h Wed Nov 15 21:55:23 1995 + +Index: t/TEST +Add OS/2 check for perl.exe. +*** perl5.001.lwall/t/TEST Sat Jan 14 19:35:33 1995 +--- perl5.002beta1/t/TEST Tue Nov 14 11:22:08 1995 + +Index: t/lib/db-btree.t +Updated. +*** perl5.001.lwall/t/lib/db-btree.t Tue Oct 18 12:44:05 1994 +--- perl5.002beta1/t/lib/db-btree.t Tue Oct 31 11:53:29 1995 + +Index: t/op/overload.t +Updated. +*** perl5.001.lwall/t/op/overload.t Tue Nov 14 20:56:57 1995 +--- perl5.002beta1/t/op/overload.t Mon Nov 20 15:48:56 1995 + +Index: t/op/stat.t +Add note about tmpfs failures. +*** perl5.001.lwall/t/op/stat.t Tue Oct 18 12:46:23 1994 +--- perl5.002beta1/t/op/stat.t Wed Nov 15 22:00:50 1995 + +Index: toke.c +Patch from Paul M. for source filters. +*** perl5.001.lwall/toke.c Tue Nov 14 21:59:50 1995 +--- perl5.002beta1/toke.c Wed Nov 15 22:08:23 1995 + +Index: util.c +Varargs fixes. +*** perl5.001.lwall/util.c Wed Jun 7 19:51:19 1995 +--- perl5.002beta1/util.c Tue Nov 14 10:46:37 1995 + +Index: writemain.SH +Make c++ friendly. +*** perl5.001.lwall/writemain.SH Wed Feb 8 19:44:20 1995 +--- perl5.002beta1/writemain.SH Sat Nov 18 15:51:55 1995 + +Index: x2p/Makefile.SH +Updated for .PL extraction. +*** perl5.001.lwall/x2p/Makefile.SH Wed Jun 7 19:51:37 1995 +--- perl5.002beta1/x2p/Makefile.SH Sun Nov 19 23:17:39 1995 + +Index: x2p/a2p.h +Add OS/2 stuff. +*** perl5.001.lwall/x2p/a2p.h Thu Oct 19 21:03:58 1995 +--- perl5.002beta1/x2p/a2p.h Tue Nov 14 10:46:57 1995 + +Index: x2p/cflags.SH +Add .obj for OS/2. +*** perl5.001.lwall/x2p/cflags.SH Tue Oct 18 12:47:34 1994 +--- perl5.002beta1/x2p/cflags.SH Tue Nov 14 15:18:27 1995 + +Index: x2p/find2perl.PL +Changed from .SH to .PL. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/x2p/find2perl.PL Sun Nov 19 23:11:58 1995 + +Index: x2p/s2p.PL +Changed from .SH to .PL extraction. +*** /dev/null Mon Nov 20 17:28:51 1995 +--- perl5.002beta1/x2p/s2p.PL Sun Nov 19 23:14:59 1995 diff --git a/contrib/perl5/Changes5.003 b/contrib/perl5/Changes5.003 new file mode 100644 index 00000000000..daba248a9e5 --- /dev/null +++ b/contrib/perl5/Changes5.003 @@ -0,0 +1,100 @@ +------------- +Version 5.003 +------------- + + ***> IMPORTANT NOTICE: <*** +The main reason for this release was to fix a security bug affecting +suidperl on some systems. If you build suidperl on your system, it +is strongly recommended that you replace any existing copies with +version 5.003 or later immediately. + +The changes in 5.003 have been held to a minimum, in the hope that this +will simplify installation and testing at sites which may be affected +by the security hole in suidperl. In brief, 5.003 does the following: + +- Plugs security hole in suidperl mechanism on affected systems + +- MakeMaker was also updated to version 5.34, and extension Makefile.PLs + were modified to match it. + +- The following hints files were updated: bsdos.sh, hpux.sh, linux.sh, + machten.sh, solaris_2.sh + +- A fix was added to installperl to insure that file permissions were + set correctly for the installed C header files. + +- t/op/stat.t was modified to work around MachTen's belief that /dev/null + is a terminal device. + +- Incorporation of Perl version information into the VMS' version of + config.h was changed to make it compatible with the older VAXC. + +- Minor fixes were made to VMS-specific C code, and the routine + VMS::Filespec::rmsexpand was added. + +---------------- +Version 5.002_01 +---------------- + +- The EMBED namespace changes are now used by default, in order to better + segregate Perl's C global symbols from those belonging to embedding + applications or to libraries. This makes it necessary to rebuild dynamic + extensions built under previous versions of Perl without the EMBED option. + The default use of EMBED can be overridden by placing -DNO_EMBED on the + cc command line. + + The EMBED change is the beginning of a general cleanup of C global + symbols used by Perl, so binary compatibility with previously + compiled dynamic extensions may be broken again in the next few + releases. + +- Several bugs in the core were fixed, including the following: + - made sure FILE * for -e temp file was closed only once + - improved form of single-statement macro definitions to keep + as many ccs as possible happy + - fixed file tests to insure that signed values were used when + computing differences between times. + - fixed toke.c so implicit loop isn't doubled when perl is + invoked with both the -p and -n switches + +- The new SUBVERSION number has been included in the default value for + architecture-specific library directories, so development and + production architecture-dependent libraries can coexist. + +- Two new magic variables, $^E and $^O, have been added. $^E contains the + OS-specific equivalent of $!. $^O contains the name of the operating + system, in order to make it easily available to Perl code whose behavior + differs according to its environment. The standard library files have + been converted to use $^O in preference to $Config{'osname'}. + +- A mechanism was added to allow listing of locally applied patches + in the output of perl -v. + +- Miscellaneous minor corrections and updates were made to the documentation. + +- Extensive updates were made to the OS/2 and VMS ports + +- The following hints file were updated: bsdos.sh, dynixptx.sh, + irix_6_2.sh, linux.sh, os2.sh + +- Several changes were made to standard library files: + - reduced use of English.pm and $`, $', and $& in library modules, + since these degrade module loading and evaluation of regular expressions, + respectively. + - File/Basename.pm: Added path separator to dirname('.') + - File/Copy.pm: Added support for VMS and OS/2 system-level copy + - MakeMaker updated to v5.26 + - Symbol.pm now accepts old (') and new (::) package delimiters + - Sys/Syslog.pm uses Sys::Hostname only when necessary + - chat2.pl picks up necessary constants from socket.ph + - syslog.pl: Corrected thinko 'Socket' --> 'Syslog' + - xsubpp updated to v1.935 + + +- The perlbug utility is now more cautious about sending mail, in order + to reduce the chance of accidentally send a bug report by giving the + wrong response to a prompt. + +- The -m switch has been added to perldoc, causing it to display the + Perl code in target file as well as any documentation. + diff --git a/contrib/perl5/Changes5.004 b/contrib/perl5/Changes5.004 new file mode 100644 index 00000000000..d0601663ecf --- /dev/null +++ b/contrib/perl5/Changes5.004 @@ -0,0 +1,16073 @@ +Please note: This file provides a summary of significant changes +between versions and sub-versions of Perl, not necessarily a complete +list of each modification. If you'd like more detailed information, +please consult the comments in the patches on which the relevant +release of Perl is based. (Patches can be found on any CPAN +site, in the .../src/5.0 directory for full version releases, +or in the .../src/5/0/unsupported directory for sub-version +releases.) + + + --------------- + CAST AND CREW + --------------- + +To give due honor to those who have made Perl 5.004 what is is today, +here are some of the more common names in the Changes file, and their +current addresses (as of March 1997): + + Gisle Aas + Kenneth Albanowski + Graham Barr + Spider Boardman + Tom Christiansen + Hallvard B Furuseth + M. J. T. Guy + Gurusamy Sarathy + Jarkko Hietaniemi + Nick Ing-Simmons + Andreas Koenig + Doug MacEachern + Paul Marquess + Hans Mulder + Jeff Okamoto + Ulrich Pfeifer + Tom Phoenix + Norbert Pueschel + Dean Roehrich + Roderick Schertler + Larry W. Virden + Ilya Zakharevich + +And the Keepers of the Patch Pumpkin: + + Charles Bailey + Tim Bunce + Andy Dougherty + Chip Salzenberg + +And, of course, the Author of Perl: + + Larry Wall + +---------------- +Version 5.004_05 Maintenance release 5 for 5.004 +---------------- + +"I said to my soul, be still, and wait without hope + For hope would hope for the wrong thing; wait without love + For love would be love of the wrong thing; there is yet faith + But the faith and the love and the hope are all in the waiting. + Wait without thought, for you are not ready for thought: + So the darkness shall be light, and the stillness the dancing." + -- T.S.Eliot, East Coker + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + TBA + + +Change 996 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Negative array subscript unrecognized in regex" + From: Mark-Jason Dominus , + h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <19980425040819.13828.qmail@plover.com>, + <199805151514.RAA04121@dorlas.elsevier.nl> + Files: t/base/lex.t toke.c + + Title: "Remove e_fp from toke.c after change 955" + From: Tim Bunce + Files: toke.c + +Change 995 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Fix -e security hole (no longer uses temp file)" + From: Tim Bunce + Files: embed.h perl.h perl.c + +Change 992 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "install non-backwards compatible .pm files into archlib" + From: Tim Bunce + Files: installperl + + Title: "revert "Can't locate" message to original for maintenance" + From: Tim Bunce + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + +Change 990 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Add tests for die $ref" + From: Graham Barr + Msg-ID: <355C6297.121B576B@ti.com> + Files: MANIFEST t/op/die.t + +Change 989 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Fix t/op/ipcmsg.t for Digital UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805151337.QAA01174@alpha.hut.fi> + Files: t/op/ipcmsg.t + +Change 986 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Patches for BeOS port of Perl, courtesy of Tom Spindler" + From: Jarkko Hietaniemi , Tom Spindler + Msg-ID: <199805042312.CAA09025@alpha.hut.fi> + Files: MANIFEST Configure config_h.SH hints/beos.sh pod/perlfunc.pod + Porting/Glossary README.beos beos/nm.c lib/Term/ReadLine.pm + plan9/config.plan9 pp_sys.c t/io/pipe.t vms/config.vms + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc + +Change 985 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "allow die $ref" + From: Graham Barr , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199805151351.OAA01985@toad.ig.co.uk>, <355C3E67.AF25B9F7@ti.com> + Files: pp_ctl.c pp_sys.c util.c + + Title: "ExtUtils::Manifest could truncate files during "make dist"" + From: "James E Jurach Jr." , + koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: <199805111048.MAA02573@arrakis.int.ein.cz>, + + Files: lib/ExtUtils/Manifest.pm + + Title: "Autosplit doesn't like upper case letters in sub names on VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980330152332.009cb130@osshe.edu> + Files: lib/AutoSplit.pm + + Title: "AutoSplit/AutoLoaded subs: give useful line numbers in warnings etc" + From: "Jesse N. Glick" , koenig@anna.mind.de (Andreas + J. Koenig), larry@wall.org (Larry Wall) + Msg-ID: <199709292015.NAA09627@wall.org>, <342FCDDF.23534195@sig.bsh.com>, + , + + Files: lib/AutoSplit.pm + +Change 984 on 1998/05/15 by TimBunce@ig.co.uk + + ------ CORE LANGUAGE ------ + + Title: "Fix close pipe returning status from wrong child" + From: "M.J.T. Guy" , kstar@chapin.edu@ig.co.uk () + Msg-ID: <199805142313.TAA02684@chapin.edu>, + + Files: t/io/pipe.t util.c + + Title: "Avoid English.pm triggering load of Errno.pm" + From: Tim Bunce + Files: gv.c lib/English.pm + + ------ DOCUMENTATION ------ + + Title: "Document child exit cause a parent sleep to end early" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "BSD Platforms need STRUCT_TM_HASZONE for POSIX" + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/bsdos.pl ext/POSIX/hints/freebsd.pl + ext/POSIX/hints/netbsd.pl ext/POSIX/hints/openbsd.pl + + Title: "MM_VMS.pm fixes for building external library" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511160542.009dd480@ous.edu> + Files: lib/ExtUtils/MM_VMS.pm + + Title: "Appease picky DEC compiler in POSIX.xs" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980511161434.009f8bb0@ous.edu> + Files: ext/POSIX/POSIX.xs + + ------ TESTS ------ + + Title: "Fix constant detection in t/op/ipcsem.t for Digit UNIX" + From: Jarkko Hietaniemi + Msg-ID: <199805121212.PAA15351@alpha.hut.fi> + Files: t/op/ipcsem.t + + Title: "Fix doc bug for system() return value" + From: Daniel Grisinger + Msg-ID: + Files: pod/perlfunc.pod t/op/exec.t + + ------ UTILITIES ------ + + Title: "Avoid possible constant autoload loop" + From: "M.J.T. Guy" , Graham Barr , Ilya + Zakharevich + Msg-ID: <199805141910.PAA26994@monk.mps.ohio-state.edu>, + <355B475A.C5AD4B90@ti.com>, + + Files: utils/h2xs.PL + + Title: "Further improvements to h2ph.PL" + From: kstar@chapin.edu + Msg-ID: <199805130241.WAA25459@chapin.edu> + Files: utils/h2ph.PL + +Change 982 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "comment init_postdump_symbols issues" + From: Tim Bunce + Files: perl.c + + Title: "Improve sort docs re SUBNAME" + From: circle@azstarnet.com + Msg-ID: <199804281828.LAA22737@andromeda.azstarnet.com> + Files: pod/perlfunc.pod + +Change 981 on 1998/05/15 by TimBunce@ig.co.uk + + Title: "Add hook to tie %! to external Errno.pm module (not included)" + From: Graham Barr + Msg-ID: <355080CD.1111BC81@ti.com> + Files: gv.c + +Change 971 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "fix C (pp_refgen fumbles when G_SCALAR, no args)" + From: Gurusamy Sarathy + Msg-ID: <199805070402.AAA02858@aatma.engin.umich.edu> + Files: pp.c + +Change 970 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "perlbug reformatted" + From: Dominic Dunlop , Hugo van der Sanden + + Msg-ID: <199805110954.LAA20367@dorlas.elsevier.nl>, + , + + Files: utils/perlbug.PL + +Change 965 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "Sub declaration cost reduced from ~500 to ~100 bytes" + From: Ilya Zakharevich + Msg-ID: <199805050607.CAA02050@monk.mps.ohio-state.edu> + Files: gv.h gv.c op.c + +Change 949 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "while($x=<>) no longer warns (implicit defined added)" + From: Nick Ing-Simmons + Msg-ID: <199805051035.LAA27365@pluto.tiuk.ti.com> + Files: MANIFEST op.c t/op/defins.t + +Change 946 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "Fix PERL_DESTRUCT_LEVEL core dumps" + From: Gurusamy Sarathy + Msg-ID: <199805062301.TAA24599@aatma.engin.umich.edu> + Files: perl.c sv.c t/op/misc.t + +Change 944 on 1998/05/14 by TimBunce@ig.co.uk + + Title: "5.004_04-m2 Cleanup of test failures" + From: Gurusamy Sarathy + Msg-ID: <199805070416.AAA03082@aatma.engin.umich.edu> + Files: t/op/die_exit.t t/op/ipcmsg.t t/op/ipcsem.t t/op/taint.t + win32/config.bc win32/config.vc + +Change 922 on 1998/05/11 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "incorrect return value for hv_iterinit" + From: Gurusamy Sarathy + Msg-ID: <199805031848.OAA20618@aatma.engin.umich.edu> + Files: pod/perlguts.pod hv.c + + ------ DOCUMENTATION ------ + + Title: "perlvar.pod buglet E" + From: Achim Bohnet + Msg-ID: <9805041415.AA22185@o09.xray.mpe.mpg.de> + Files: pod/perlvar.pod + + Title: "Improve docs for warning about code after an exec()" + From: "M.J.T. Guy" , Chaim Frenkel + + Msg-ID: , + + Files: pod/perlfunc.pod + + Title: "Remove dead code from pod2man" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/pod2man.PL + + Title: "tweak doc for C" + From: Gurusamy Sarathy + Msg-ID: <199805090017.UAA06888@aatma.engin.umich.edu> + Files: pod/perlfunc.pod + + Title: "Document integer pragma effect on % operator" + From: Gisle Aas + Msg-ID: + Files: pod/perlop.pod + + Title: "Reduce rm command line length in pod/Makefile" + From: Hugo van der Sanden + Msg-ID: <199805041423.QAA13199@dorlas.elsevier.nl> + Files: pod/Makefile + + ------ EXTENSIONS ------ + + Title: "Clarify Termios usage in POSIX.pod" + From: Rocco Caputo + Msg-ID: <199805101952.PAA12738@ns.netrus.net> + Files: ext/POSIX/POSIX.pod + + ------ LIBRARY ------ + + Title: "Fix File::Find::finddepth typo in trial 2 release" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/File/Find.pm t/lib/filefind.t + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Porting/patching.pod document" + From: Daniel Grisinger + Msg-ID: <199805030305.XAA16147@relay.pair.com> + Files: MANIFEST Porting/patching.pod + + Title: "hints/machten.sh: disable semctl(), align with devel version" + From: Dominic Dunlop + Msg-ID: + Files: hints/machten.sh + + Title: "Add VMS specifics to Porting/makerel" + From: Charles Bailey + Msg-ID: <01IWDK1LONRQ0026P0@cor.newman.upenn.edu>, + <199804271732.SAA13762@toad.ig.co.uk>, + <9804250212.AA27695@forte.com> + Files: Porting/makerel + +Change 913 on 1998/05/01 by TimBunce@ig.co.uk + + Update MANIFEST for trial 2. + (Porting/Contract lib/Tie/Handle.pm t/op/tiehandle.t) + +Change 912 on 1998/05/01 by TimBunce@ig.co.uk + + Add t/op/tiehandle.t as xtext to repository (see change 911) + +Change 911 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Add ERRSV, ERRHV, DEFSV and SAVE_DEFSV for XS 5.005 compatibility" + From: timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804200854.JAA01482@toad.ig.co.uk> + Files: perl.h + + Title: "Add WRITE & CLOSE to TIEHANDLE" + From: Graham Barr + Msg-ID: <34F63DC8.CA95670F@pobox.com> + Files: pod/perltie.pod lib/Tie/Handle.pm pp_sys.c t/op/tiehandle.t + +Change 910 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Add warning for Illegal hex digit" + From: Stephen P Potter , Stephen Potter + , Tim.Bunce@ig.co.uk (Tim Bunce) + Msg-ID: <199804232219.SAA02267@spp.users.ds.net>, + <199804271409.PAA12819@toad.ig.co.uk>, + <199804280307.WAA12332@psasolar.psa.pencom.com> + Files: pod/perldiag.pod util.c + + Title: "perl_call_method() bug fix (corrupt op pointer)" + From: "Alterman, Eugene" + Msg-ID: <510415F72ECFD111A31700A0C9B3CCDE3098@efx98digmasa.bremer-inc.com> + Files: perl.c + + Title: "Fix printf segmentation fault" + From: Hugo van der Sanden + Msg-ID: + Files: pp_hot.c + + Title: "Document changed local($a[$i],$b{$j}) behaviour re delete/splice" + From: Charles Bailey + Msg-ID: <01IVMVIHNZ36001NKH@cor.newman.upenn.edu> + Files: pod/perlsub.pod + +Change 909 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Change Ilya's do_binmode to K&R prototype and move to doio.c" + Files: doio.c util.c + +Change 907 on 1998/05/01 by TimBunce@ig.co.uk + + Title: "Runtime Carp verbosity without aliasing" + From: Joshua.Pritikin@NewYork2.dmg.deuba.com, Tim Bunce + Msg-ID: + Files: lib/Carp.pm + + Title: "Fix File::Basename to not untaint results (using new //t flag)" + From: Eric Hammond , Tom Phoenix + + Msg-ID: <199710070515.WAA00682@finity.citysearch.com>, + + Files: lib/File/Basename.pm + +Change 906 on 1998/04/28 by TimBunce@ig.co.uk + + ------ CORE LANGUAGE ------ + + Title: "5.004_04m5t1: Fix dangling references in LVs", "Fix dangling + references in LVs" + From: Spider Boardman + Msg-ID: <199804010541.AAA32615@Orb.Nashua.NH.US>, + <19980422164037.D29222@perl.org> + Files: embed.h keywords.h opcode.h perl.h proto.h doop.c global.sym mg.c + pp.c sv.c + + Title: "Fix SvGMAGIC typo in change 904" + Files: doop.c + +Change 905 on 1998/04/28 by TimBunce@ig.co.uk + + Regexp patches + + Title: "New regex flag //t to leave $1 etc. tainted" + From: Chip Salzenberg , Tim Bunce + Msg-ID: <19980310192640.37826@cyprus> + Files: pod/perlop.pod pod/perlre.pod op.h dump.c mg.c pp_hot.c sv.c + t/op/taint.t toke.c + + Title: "Don't accidentally untaint target of s///" + From: Chip Salzenberg + Msg-ID: <19980310151756.24767@cyprus> + Files: pp_ctl.c pp_hot.c t/op/taint.t + + Title: "Allow but ignore embedded /...(?o).../ in regexp" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804201243.OAA08244@dorlas.elsevier.nl> + Files: regcomp.c + +Change 904 on 1998/04/27 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Protect join() against double reads on undef and SvGMAGICALs" + From: Chip Salzenberg , Tim Bunce + + Msg-ID: <19980424080630.D13985@perl.org> + Files: doop.c + + Title: "Better error message for require failure" + From: epeschko@den-mdev1 (Ed Peschko) + Msg-ID: <199804240047.SAA24155@den-mdev1.co.csgsystems.com> + Files: pod/perldiag.pod pp_ctl.c + + Title: "fixes for various noises under PERL_DESTRUCT_LEVEL" + From: Gurusamy Sarathy + Msg-ID: <199804231926.PAA23969@aatma.engin.umich.edu> + Files: perl.c + + Title: "Fix nice_chunk memory leak" + From: Gurusamy Sarathy + Msg-ID: <199804052347.TAA15699@aatma.engin.umich.edu> + Files: sv.c + + Title: "-2.0 vs. -2 (was Number representations)" + From: Chip Salzenberg + Msg-ID: <19980309185652.11231@cyprus> + Files: op.c + + Title: "perl.c fixes for -DUNEXEC" + From: Matt Wette , Matthew R Wette + + Msg-ID: <199710152146.OAA07283@mr-ed.jpl.nasa.gov> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "perlcall is Perl from C, not C from Perl" + From: Steve A Fink + Files: pod/perlembed.pod + + Title: "Clarify require "Foo::Bar" non-bareword issue" + From: Dominique Dumont + Msg-ID: <199804231527.AA153445256@ss7serv.grenoble.hp.com> + Files: pod/perlfunc.pod + + Title: "(repost) new text for perlsec", "new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + ------ EXTENSIONS ------ + + Title: "IO::Socket->socketpair broken (typo)" + From: Olaf Titz + Msg-ID: <19980425224535.2807.qmail@bigred.inka.de> + Files: ext/IO/lib/IO/Socket.pm + + Title: "NDBM_File man page needs Fcntl" + From: "Danny R. Faught" + Msg-ID: <199707011500.IAA00601@palrel3.hp.com> + Files: ext/NDBM_File/NDBM_File.pm + + ------ LIBRARY ------ + + Title: "Documentation discrepancy: pragmatic modules" + From: "M.J.T. Guy" , h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199804221525.RAA12695@dorlas.elsevier.nl>, + + Files: lib/strict.pm lib/subs.pm lib/vars.pm + + ------ PORTABILITY - GENERAL ------ + + Title: "Updated hints file for svr4" + From: Andy Dougherty + Msg-ID: + Files: hints/svr4.sh + + Title: "Pumpkin update -- shared libperl.so location" + From: Andy Dougherty + Msg-ID: + Files: Porting/pumpkin.pod + + Title: "perl compile fix for AIX 4.3" + From: Jens-Uwe Mager + Msg-ID: <199804261611.SAA34728@ans.helios.de> + Files: ext/DynaLoader/dl_aix.xs + + Title: "Dynaloader build on VMS", + From: pvhp@forte.com (Peter Prymmer), timbo@ig.co.uk (Tim Bunce) + Msg-ID: <199804271732.SAA13762@toad.ig.co.uk>, <9804250212.AA27695@forte.com> + Files: vms/descrip.mms + + ------ UTILITIES ------ + + Title: "Major update to h2ph.PL" + From: Billy + Msg-ID: + Files: utils/h2ph.PL + +Change 897 on 1998/04/23 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "fix for "Unbalanced string table refcount"" + From: Gurusamy Sarathy + Msg-ID: <199804042251.RAA25527@aatma.engin.umich.edu> + Files: sv.c + + Title: "Allow more lenient switch processing" + From: "John L. Allen" + Msg-ID: <199803251638.LAA22664@gateway.grumman.com> + Files: perl.c + + Title: "Add fourth arg to substr: substr EXPR,OFFSET,LEN,REPLACEMENT" + From: Gisle Aas + Msg-ID: + Files: pod/perlfunc.pod Todo opcode.pl pp.c t/op/substr.t + + Title: "Odd number of elements in hash list." + From: Tom Phoenix + Msg-ID: + Files: MANIFEST pod/perldiag.pod pp.c pp_hot.c t/op/hashwarn.t + + Title: "another destruct_level fix" + From: Gurusamy Sarathy + Msg-ID: <199804030105.UAA04400@aatma.engin.umich.edu> + Files: hv.c + + Title: "bidirectional pipe warning blues" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9804082151.AA20399@claudius.bfsec.bt.co.uk> + Files: doio.c + + Title: "stale pointers after realloc (MEXTEND in pp_print and pp_prtf)" + From: Malcolm Beattie + Msg-ID: <199801191107.LAA17979@sable.ox.ac.uk> + Files: pp_hot.c pp_sys.c + + Title: "unimplemented umask() should return undef not die" + From: kstar@chapin.edu (Kurt D. Starsinic) + Msg-ID: <199803120515.VAA08660@chapin.edu> + Files: pod/perlfunc.pod pp_sys.c + + Title: "warning for: bless $foo, """ + From: Joshua.Pritikin@NewYork2.dmg.deuba.com + Msg-ID: + Files: pod/perldiag.pod pp.c + + ------ DOCUMENTATION ------ + + Title: "Mention SWIG in perlxs.pod" + From: Steve A Fink + Msg-ID: + Files: pod/perlxs.pod + + Title: "fix-up of previous perlre.pod patch" + From: Ted Ashton + Msg-ID: <199803031540.KAA09388@ns.southern.edu> + Files: pod/perlre.pod + + Title: "long list of man page nitpicks" + From: Greg Bacon , Tom Christiansen + + Msg-ID: <199804221844.NAA08338@pluto.cs.uah.edu>, + <199804222204.QAA20805@jhereg.perl.com> + Files: pod/perlapio.pod pod/perlcall.pod pod/perldebug.pod pod/perldelta.pod + pod/perldiag.pod pod/perlembed.pod pod/perlfaq2.pod + pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlform.pod + pod/perlfunc.pod pod/perlguts.pod pod/perlipc.pod + pod/perllocale.pod pod/perlmodlib.pod pod/perlop.pod + pod/perlre.pod pod/perlref.pod pod/perlrun.pod + pod/perlstyle.pod pod/perlsub.pod pod/perlsyn.pod + pod/perltoot.pod pod/perlvar.pod pod/perlxs.pod + pod/pod2man.PL + + Title: "document that system() does not set $! when it fails" + From: "Mark R. Levinson" + Msg-ID: <199803011946.OAA31942@anaximander.dccs.upenn.edu> + Files: pod/perlfunc.pod + + Title: "Fix pod/roffitall execute permission" + From: lvirden@cas.org + Msg-ID: <1997Nov17.132031.2589892@cor.newman> + Files: pod/roffitall + + Title: "document when split ignores trailing empty fields" + From: Hugo van der Sanden + Msg-ID: + Files: pod/perlfunc.pod + + ------ EXTENSIONS ------ + + Title: "Buglet in Opcode.pm documentation" + From: Horst von Brand + Msg-ID: <199804170349.XAA32445@sleipnir.valparaiso.cl> + Files: ext/Opcode/Opcode.pm + + Title: "Failure to append to perllocal.pod should not be fatal" + From: koenig@kulturbox.de (Andreas J. Koenig) + Msg-ID: + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Document that IO.pm does not load IO::Select etc" + From: Graham Barr + Msg-ID: <353B48F1.64E35A63@ti.com> + Files: ext/IO/IO.pm + + Title: "Install extensions with bootstrap (again) in $archlib" + From: Achim Bohnet , koenig@kulturbox.de (Andreas J. + Koenig) + Msg-ID: <9804061909.AA12675@o09.xray.mpe.mpg.de>, + + Files: lib/ExtUtils/Install.pm + + Title: "glibc2.0.6 missing MSG_* defines." + From: Andy Dougherty + Msg-ID: + Files: ext/Socket/Socket.xs + + ------ LIBRARY ------ + + Title: "Benchmark.pm: add run-for-some-time mode" + From: Jarkko Hietaniemi + Msg-ID: <199804080647.JAA15136@alpha.hut.fi> + Files: lib/Benchmark.pm + + Title: "Comments added to Carp.pm" + From: Andy Wardley , Chip Salzenberg + , Tom Christiansen + + Msg-ID: <19980422164242.E29222@perl.org>, + <199804222033.OAA17959@jhereg.perl.com>, + <980409182357.ZM21638@bandanna> + Files: lib/Carp.pm + + Title: "chat2.pl fix" + From: Charles Bailey + Msg-ID: <01IVMVF507PO001NKH@cor.newman.upenn.edu> + Files: lib/chat2.pl + + Title: "lib/Pod/Html.pm" + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199710170718.DAA25472@staff1.cso.uiuc.edu>, + <199710180417.AAA19778@staff2.cso.uiuc.edu> + Files: lib/Pod/Html.pm + + Title: "ormaments method in Term/ReadLine.pm causes warning with string + arg." + From: hiroo.hayashi@computer.org + Msg-ID: <199804061519.AAA21907@mail.fb3.so-net.ne.jp> + Files: lib/Term/ReadLine.pm + + ------ OTHER CHANGES ------ + + Title: "ptags broken" + From: Ilya Zakharevich + Msg-ID: <199804120208.WAA29264@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ PORTABILITY - WIN32 ------ + + Title: "win32 tweaks (signals and crypt support)" + From: Gurusamy Sarathy + Msg-ID: <199804170505.BAA06413@aatma.engin.umich.edu> + Files: perl.h win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/win32.c + + ------ PORTABILITY - GENERAL ------ + + Title: "Add Social Contract (2nd Draft) as Porting/Contract" + From: Russ Allbery + Msg-ID: + Files: Porting/Contract + + Title: "Config: Irix 5 hints" + From: kstar@O2.chapin.edu + Msg-ID: <199804061712.NAA22823@O2.chapin.edu> + Files: hints/irix_5.sh + + Title: "VMS patches to 5.004_03" + From: Charles Bailey + Msg-ID: <01IVYJS0L8D200209B@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "hints/netbsd.sh - enable vfork" + From: Andy Dougherty + Msg-ID: + Files: hints/netbsd.sh + + ------ UTILITIES ------ + + Title: "support find2perl -follow" + From: Billy + Msg-ID: + Files: x2p/find2perl.PL + +Change 896 on 1998/04/22 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Additional regex-cache patch" + From: Chip Salzenberg + Msg-ID: <19980305104831.38100@cyprus> + Files: pp_ctl.c + + Title: "Conservative C<*x = undef> patch" + From: Chip Salzenberg + Msg-ID: <19980310163310.48509@cyprus> + Files: pod/perldiag.pod pod/perlfunc.pod pp.c sv.c t/op/gv.t + + Title: "Consider @ARGV to be plain files if inplace (-i)" + From: Chip Salzenberg + Msg-ID: <199802042106.QAA04082@nielsenmedia.com> + Files: doio.c + + Title: "Fix semctl for Linux, Sun and SVR4" + From: Graham Barr , lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <3484247D.BB036D39@ti.com>, <9712021313.AA11495@cas.org> + Files: doio.c + + Title: "C entails using C, not C" + From: Gurusamy Sarathy + Msg-ID: <199803070149.UAA12217@aatma.engin.umich.edu> + Files: pod/perlcall.pod pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod + doio.c doop.c ext/DB_File/DB_File.xs + ext/DynaLoader/dl_dld.xs ext/Opcode/Opcode.xs + ext/POSIX/POSIX.xs ext/Socket/Socket.xs gv.c + lib/ExtUtils/typemap mg.c os2/OS2/REXX/REXX.xs + win32/win32.c + + Title: "Make autouse -w-safe" + From: Ilya Zakharevich + Msg-ID: <199803030236.VAA13244@monk.mps.ohio-state.edu> + Files: lib/autouse.pm op.c sv.c + + Title: "Misleading error on close of unopened handle" + From: "M.J.T. Guy" + Msg-ID: + Files: doio.c + + Title: "Confusing error from perl -e "x'"" + From: Hans Mulder + Msg-ID: <1998Mar25.174320.2866352@cor.newman.upenn.edu> + Files: toke.c + + Title: "Add HAS_GNULIBC define" + From: Andy Dougherty + Msg-ID: + Files: config_H config_h.SH + + Title: "h_errno might not be an int" + From: Andy Dougherty + Msg-ID: + Files: pp_sys.c + + Title: "Revised taint hole closer", "Revised taint hole closer" + From: Chip Salzenberg , Ilya Zakharevich + + Msg-ID: <19980310222127.09350@cyprus>, + <199803110554.AAA29157@monk.mps.ohio-state.edu> + Files: doio.c + + Title: "SEGV compiling localised lexical in perl5.004_05t1" + From: Gurusamy Sarathy , h.sanden@elsevier.nl (Hugo + van der Sanden) + Msg-ID: <199803171530.QAA24053@dorlas.elsevier.nl>, + <199803171727.MAA05234@aatma.engin.umich.edu> + Files: op.c t/op/misc.t + + Title: "Stale SP in pp_substr" + From: Stephen McCamant + Msg-ID: + Files: pp.c + + Title: "Statement unlikely to be reached warning" + From: Hans Mulder + Msg-ID: <1997Dec24.171511.2683516@cor.newman> + Files: op.c + + Title: "Tainting propagates from nowhere" + From: Gurusamy Sarathy + Msg-ID: <199803140411.XAA09343@aatma.engin.umich.edu> + Files: pp.c + + Title: "two trivial tweaks to 5.004m5t1" + From: Gurusamy Sarathy + Msg-ID: <199803060553.AAA28461@aatma.engin.umich.edu> + Files: proto.h win32/Makefile + + Title: "unpacking negatives on Alpha" + From: Achim Bohnet + Msg-ID: <9710201503.AA24797@o09.xray.mpe.mpg.de> + Files: pp.c t/op/pack.t + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "Cwd.pm: abs_path() and fast_abs_path() plus code merge" + From: Graham Barr + Msg-ID: <3482F365.4A0486BA@ti.com> + Files: lib/Cwd.pm + + Title: "Math/BigInt.pm, fixed use of undefined value." + From: abigail@fnx.com + Msg-ID: <19980313052452.27365.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Math/BigInt.pm + + Title: "File::Find rewrite" + From: Ilya Zakharevich + Msg-ID: <199803052344.SAA01008@monk.mps.ohio-state.edu> + Files: lib/File/Find.pm + + Title: "efficient version of strict.pm" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: lib/strict.pm + + Title: "Socket occasional SEGV in pack_sockaddr_un" + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + + Title: "Warning on mis-use of 'use lib'" + From: "M.J.T. Guy" , Tom Phoenix + , chip@atlantic.net + Msg-ID: <199801270435.XAA14147@cyprus.atlantic.net>, + , + + Files: lib/lib.pm + + Title: "bug in Class::Struct" + From: Tom Christiansen + Msg-ID: <199803290814.KAA05699@toy.perl.com> + Files: lib/Class/Struct.pm + + Title: "Allow POSIX to export nice()" + From: bkeelerx@iwa.dp.intel.com (Bruce J. Keeler) + Msg-ID: + Files: ext/POSIX/POSIX.pm + + Title: "'use Env' on WinNT/95 fails" + From: Gurusamy Sarathy + Msg-ID: <199803280511.AAA15933@aatma.engin.umich.edu> + Files: lib/Env.pm + + ------ OTHER CHANGES ------ + + Title: "mv-if-diff" + From: Robin Barker + Msg-ID: <14572.9803271806@tempest.cise.npl.co.uk> + Files: mv-if-diff + + ------ PORTABILITY - WIN32 ------ + + Title: "fix various problems with backticks on win32" + From: Gurusamy Sarathy + Msg-ID: <199803070705.CAA15945@aatma.engin.umich.edu> + Files: win32/config_h.PL win32/win32.c + + ------ TESTS ------ + + Title: "Fix bug in locale.t" + From: Jarkko Hietaniemi + Msg-ID: <199801042148.XAA08599@alpha.hut.fi> + Files: t/pragma/locale.t + +Change 887 on 1998/04/10 by TimBunce@ig.co.uk + + Assorted patches: + + ------ CORE LANGUAGE ------ + + Title: "Re: die exits with 0" + From: Robin Barker + Files: perl.c t/op/die_exit.t + + Title: "More toke.c commentary; fix oddity" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803251022.LAA01308@dorlas.elsevier.nl> + Files: toke.c + + Title: "for semctl on solaris" + From: Graham Barr + Msg-ID: <34624B80.C014E841@ti.com> + Files: doio.c t/op/ipcmsg.t t/op/ipcsem.t + + ------ DOCUMENTATION ------ + + Title: "Add more 'see also's to perlre.pod.", "Perl regexp /g modifier bug" + From: Ilya Zakharevich , epeschko@den-mdev1 (Ed + Peschko), pjr@watcher.telstra.com.au (Peter Richardson) + Msg-ID: <199803050000.LAA11476@watcher.telecom.com.au>, + <199803050231.VAA19128@monk.mps.ohio-state.edu>, + <199803050605.XAA09785@den-mdev1.co.csgsystems.com> + Files: pod/perlre.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "BigFloat - small neagtive numbers cause panic" + From: Hugo van der Sanden + Msg-ID: <199711201325.NAA09732@crypt.compulink.co.uk> + Files: lib/Math/BigFloat.pm + + Title: "Update Getopt::Long to 2.16" + From: JVromans@Squirrel.nl (Johan Vromans), Johan Vromans + + Msg-ID: <13571.48089.726787.147769@plume.nl.compuware.com>, + <13572.6847.863219.973795@phoenix.squirrel.nl> + Files: lib/Getopt/Long.pm + + Title: "New Text::ParseWords" + From: pomeranz@netcom.com (Hal Pomeranz) + Msg-ID: <199710162118.OAA06275@netcom7.netcom.com> + Files: lib/Text/ParseWords.pm t/lib/parsewords.t + + Title: "Fixed Text/Wrap.pm bugs (2)" + From: Jacqui Caren + Msg-ID: <199709291548.QAA08645@toad.ig.co.uk> + Files: lib/Text/Wrap.pm + + Title: "Very *evil* File::CheckTree behavior! (now uses warn/die not + print/exit)" + From: Eryq , Randal Schwartz + Msg-ID: <34B542FD.190A@zeegee.com>, <8cen2i9k6f.fsf@gadget.cscaper.com> + Files: lib/File/CheckTree.pm + + ------ OTHER CHANGES ------ + + Title: "Add ./emacs/ptags" + From: Ilya Zakharevich + Msg-ID: <199803150847.DAA08196@monk.mps.ohio-state.edu> + Files: emacs/ptags + + ------ TESTS ------ + + Title: "Avoid stat test failure from build in /tmp (tmpfs)", "Build in /tmp" + From: Andy Dougherty , Greg Bacon + , pudge@pobox.com (Chris Nandor) + Msg-ID: <199710171616.LAA13435@crp-201.adtran.com>, + , + + Files: t/op/stat.t + + Title: "for failure with lib/timelocal" + From: "M.J.T. Guy" , jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <34c78f61.2529827@smtp1.ibm.net>, + + Files: t/lib/timelocal.t + + Title: "Make "localhost" related failures more clear" + From: Paul Hoffman + Msg-ID: <199801201859.KAA05686@mail.proper.com> + Files: t/lib/io_sock.t t/lib/io_udp.t + + ------ UTILITIES ------ + + Title: "Let h2xs read multiple header files" + From: Andy Dougherty , Benjamin Sugars + + Msg-ID: , + + Files: utils/h2xs.PL + +Change 886 on 1998/04/10 by TimBunce@ig.co.uk + + Changes relating primarily to portability. + + ------ CORE LANGUAGE ------ + + Title: "5.004_55: Another round of OS/2 patches" + From: Ilya Zakharevich + Msg-ID: <199803050945.EAA20153@monk.mps.ohio-state.edu> + Files: hints/os2.sh pod/perlguts.pod cop.h perl.h proto.h README.os2 + global.sym lib/ExtUtils/MM_OS2.pm lib/File/Path.pm op.c + os2/Changes os2/Makefile.SHs os2/os2.c os2/perl2cmd.pl + perl.c pod/pod2man.PL pp_ctl.c pp_hot.c pp_sys.c + t/lib/filecopy.t util.c utils/perldoc.PL + + Title: "VMS: chdir() with empty arg list" + From: lane@duphy4.drexel.edu (Charles Lane) + Msg-ID: <980317125556.222041c7@DUPHY4.Physics.Drexel.Edu> + Files: pp_sys.c + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "ExtUtils/MM_Unix.pm changed to use ld -rpath on IRIX" + From: "W. Phillip Moore" + Msg-ID: <199712011738.MAA21139@zappa.morgan.com> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "[Linux] POSIX::_[PS]C_.+ bug (add HINT_SC_EXIST)" + From: Yutaka OIWA + Msg-ID: <199712251923.EAA08260@tjms1f.is.s.u-tokyo.ac.jp> + Files: ext/POSIX/hints/linux.pl ext/POSIX/POSIX.xs + + Title: "5.004_04-m1] Use HAS_GNULIBC in POSIX.xs" + From: Andy Dougherty + Msg-ID: + Files: ext/POSIX/POSIX.xs + + Title: ""ODBM_File.c", line 275: NULL undefined" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9803091310.AA23264@claudius.bfsec.bt.co.uk> + Files: ext/ODBM_File/ODBM_File.xs + + ------ PORTABILITY - GENERAL ------ + + Title: "5.004_04 QNX getcwd" + From: Norton Allen + Msg-ID: <199802121838.NAA20452@dolores.harvard.edu>, + <199803061511.KAA22346@bottesini.harvard.edu> + Files: hints/qnx.sh lib/Cwd.pm t/op/magic.t + + Title: "hints/netbsd.sh d_setrgid d_setruid" + From: Jarkko Hietaniemi + Msg-ID: <199802281435.QAA10866@alpha.hut.fi> + Files: hints/netbsd.sh + + Title: "osname=unixware, osvers=2.03, archname=i386-unixware + d_casti32=undef" + From: Tom Hughes + Msg-ID: <465398da47%tom@compton.demon.co.uk> + Files: hints/svr4.sh + + Title: "hints/bsdos.sh patch for BSDI 3.1" + From: Jan-Pieter Cornet + Msg-ID: <6fbip6$3cp$1@xs1.xs4all.nl> + Files: hints/bsdos.sh + + Title: "Remove BIND_NOSTART from DynaLoader for HP" + From: Keong Lim + Msg-ID: <01BD1D03.53B65E90@sieplan2.sr.com.au> + Files: ext/DynaLoader/dl_hpux.xs + + Title: "Building Perl on AIX 4+ with shared libraries and dynamic loading" + From: Juan Gallego + Msg-ID: + Files: hints/aix.sh + + Title: "alpha-dec_osf 5.0" + From: Spider Boardman + Msg-ID: <199712232305.SAA08359@Orb.Nashua.NH.US> + Files: hints/dec_osf.sh + + Title: "Off-by-one error with OS2::PrfDB" + From: Ilya Zakharevich + Msg-ID: <199710170920.FAA00390@monk.mps.ohio-state.edu> + Files: os2/OS2/PrfDB/PrfDB.xs + + Title: "5.004_04-m1] Allow overrides in hints/openbsd.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/openbsd.sh + + Title: "5.004_04-m1] Linux shouldn't use -lnet" + From: Andy Dougherty + Msg-ID: + Files: hints/linux.sh + + Title: "5.004_(04|63)] Close VMS security hole" + From: Charles Bailey + Msg-ID: <01IV6LRJCSSC0009C4@cor.newman.upenn.edu> + Files: vms/vms.c + + Title: "Re: Perl online documentation on OpenVMS" + From: pvhp@forte.com (Peter Prymmer) + Msg-ID: <9803192143.AA28120@forte.com> + Files: README.vms + + Title: "Perl5.004_04m4t4 *almost* makes it for VMS", "Updated + vms/perly_c.vms and vms/perly_h.vms" + From: Andy Dougherty , Dan Sugalski + , larry@wall.org (Larry Wall) + Msg-ID: <199710151650.JAA29185@wall.org>, + <3.0.3.32.19971014150404.02fdef78@osshe.edu>, + + Files: vms/perly_c.vms + + Title: "Updated, non-wordwrapped, patch to README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980213133828.0092c870@osshe.edu> + Files: README.vms + + Title: "VMS patches to 5.004_03 (excluding installperl and timelocal.t)" + From: Charles Bailey + Msg-ID: <01INZT9G2LZS0006YW@cor.newman.upenn.edu> + Files: lib/File/Basename.pm lib/File/Path.pm vms/config.vms vms/descrip.mms + vms/genconfig.pl vms/test.com vms/vms.c vms/ext/Filespec.pm + vms/ext/filespec.t + + Title: "Re: VMSperl crashes on -Mblib argument" + From: bailey@newman.upenn.edu (Charles Bailey) + Msg-ID: <1997Dec10.004439.2635060@cor.newman> + Files: lib/blib.pm vms/vms.c + + Title: "hints/linux.sh (MkLinux / PPC)" + From: pudge@pobox.com (Chris Nandor) + Msg-ID: + Files: hints/linux.sh + + Title: "hpux.sh hints file clarification suggestion" + From: root@qad.com + Msg-ID: <199802192351.QAA09096@jhereg.perl.com> + Files: hints/hpux.sh + + Title: "new hints/solaris_2.sh" + From: "M.J.T. Guy" + Msg-ID: + Files: hints/solaris_2.sh + +Change 873 on 1998/04/03 by TimBunce@ig.co.uk + + Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + Files: lib/FileHandle.pm + +Change 872 on 1998/04/03 by TimBunce@ig.co.uk + + Documentation and documentation related patches: + + ------ BUILD PROCESS ------ + + Title: "Docs re /usr/bin/perl quasi-standard location" + From: Tom Phoenix + Msg-ID: + Files: INSTALL pod/perlrun.pod + + ------ DOCUMENTATION ------ + + Title: "/RFC|RFC-1305/ non-greedy" + From: Jan-Pieter Cornet + Msg-ID: <6epo02$c4r$1@xs1.xs4all.nl> + Files: pod/perlre.pod + + Title: "5.004_04: perlhist.pod, buildtoc, perltoc.pod" + From: Jarkko Hietaniemi + Msg-ID: <199802191543.RAA29231@alpha.hut.fi> + Files: pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + + Title: "5.004_04: pod/perlfunc.pod: i18n example for localtime()" + From: Jarkko Hietaniemi + Msg-ID: <199711141555.RAA18875@alpha.hut.fi> + Files: pod/perlfunc.pod + + Title: "typo-fix and suggestion for perlguts.pod" + From: h.sanden@elsevier.nl (Hugo van der Sanden) + Msg-ID: <199803051543.QAA03097@dorlas.elsevier.nl> + Files: pod/perlguts.pod + + Title: "perlfunc/syscall curiosity" + From: Roderick Schertler , Tkil + + Msg-ID: <199711302259.PAA02134@reptile.scrye.com>, + + Files: pod/perlfunc.pod + + Title: "Document sprintf %#x behaviour for zero value" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Nov5.185959.2539604@cor.newman> + Files: pod/perlfunc.pod + + Title: "NUL termination (was Re: STOP THE PRESSES)" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod + + Title: "Typo fix." + From: abigail@fnx.com + Msg-ID: <19971101120114.1030.qmail@betelgeuse.wayne.fnx.com> + Files: pod/perlop.pod pod/perlvar.pod + + Title: "5.004_63 perlrun.pod: _DEBUG_MSTATS" + From: Achim Bohnet + Msg-ID: <9803181940.AA22587@o09.xray.mpe.mpg.de> + Files: pod/perlrun.pod + + Title: "Re: Conservative C<*x = undef> patch" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perltrap.pod + + Title: "perlfunc.pod for flock()" + From: "Jeremy D. Zawodny" + Msg-ID: <3.0.5.32.19971118203119.00a723e0@woody.wcnet.org> + Files: pod/perlfunc.pod + + Title: "buglet: 'perltoc' not mentioned in perl.pod" + From: Tkil + Msg-ID: <19971127035036.17668.qmail@scrye.com> + Files: pod/perl.pod + + Title: "for() and map() peculiarity" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlsyn.pod + + Title: "Re: new text for perlsec" + From: Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + Title: "perldsc's debugger x command" + From: Roderick Schertler + Msg-ID: <10669.878352893@eeyore.ibcinc.com> + Files: pod/perldsc.pod + + Title: "perlre.pod" + From: Ted Ashton + Msg-ID: <199802271501.KAA09279@ns.southern.edu> + Files: pod/perlre.pod + + Title: "Re: printf and $\", "printf and $\" + From: Roderick Schertler , Tom Phoenix + , nag + Msg-ID: <199711141918.TAA08096@flirble.org>, + , + Files: pod/perlfunc.pod + + Title: "recv() typo" + From: Roderick Schertler + Msg-ID: <12064.877012073@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "truncate return value" + From: Roderick Schertler + Msg-ID: <5490.878337883@eeyore.ibcinc.com> + Files: pod/perlfunc.pod + + Title: "update to perlbook.pod" + From: "Nathan V. Patwardhan" , Randal Schwartz + , Stephen Potter + , Tom Phoenix + + Msg-ID: <199803241354.HAA23938@psasolar.psa.pencom.com>, + <199803241441.OAA01261@mediaone.net>, + <8clnu0i05k.fsf@gadget.cscaper.com>, + + Files: pod/perlbook.pod + + Title: "utime documentation" + From: "Brandon S. Allbery KF8NH" , "M.J.T. Guy" + + Msg-ID: <199802180256.VAA11369@speaker.kf8nh.apk.net>, + + Files: pod/perlfunc.pod + + Title: "(well, doc patch) use of // requires successful match" + From: Roderick Schertler + Msg-ID: + Files: pod/perlop.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "MakeMaker PM doc patch and a DIR buglet" + From: Achim Bohnet + Msg-ID: <9711101050.AA13868@o09.xray.mpe.mpg.de> + Files: lib/ExtUtils/MakeMaker.pm + + Title: "bareword clarification for constant.pm" + From: Roderick Schertler + Msg-ID: <6460.878143077@eeyore.ibcinc.com> + Files: lib/constant.pm + + Title: "integer rand - bug or feature?" + From: Roderick Schertler + Msg-ID: + Files: lib/integer.pm + + ------ OTHER CHANGES ------ + + Title: "FileHandle Documentation patch" + From: "Darren/Torin/Who Ever..." + Msg-ID: <87emzqo49g.fsf@perv.daft.com> + + Title: "perl5.004_61 myconfig updates" + From: Andy Dougherty + Msg-ID: + Files: myconfig + + Title: "small fixups in pod2latex.PL" + From: "Darren/Torin/Who Ever..." + Msg-ID: <873eg6o3v2.fsf@perv.daft.com> + + ------ PORTABILITY - GENERAL ------ + + Title: "Misc doc fixes for README.VMS" + From: Dan Sugalski + Msg-ID: <3.0.5.32.19980121113134.00924a20@osshe.edu> + Files: README.vms + + Title: "moved DynaLib" + From: John Tobey + Msg-ID: <199710182332.XAA21630@remote212> + Files: ext/DynaLoader/DynaLoader.pm.PL + + ------ UTILITIES ------ + + Title: "Searching for FAQs (patch to perldoc)" + From: Piers Cawley , Russ Allbery + Msg-ID: , + + Files: utils/perldoc.PL + + Title: "perldoc" + From: Ted Ashton + Msg-ID: <199802271510.KAA10506@ns.southern.edu> + Files: utils/perldoc.PL + + Title: "perldoc -f not using pod2man" + From: Russ Allbery + Msg-ID: + Files: utils/perldoc.PL + + Title: "perldoc -m should not require pod" + From: Robin Houston + Msg-ID: <199803241319.NAA24777@stringfellow.guardian.co.uk> + Files: utils/perldoc.PL + + Title: "small fix for perldoc in perl 5.004_04" + From: Julian Yip + Msg-ID: + Files: utils/perldoc.PL + +Change 764 on 1998/03/05 by TimBunce@ig.co.uk + + APPLLIB_EXP now has arch and version dirs added to @INC + +Change 761 on 1998/03/05 by TimBunce@ig.co.uk + + Title: "properly refcount localization, fix C" + From: Gurusamy Sarathy + Msg-ID: <199802191207.MAA10742@toad.ig.co.uk> + Files: av.c hv.c scope.c t/op/local.t + +Change 758 on 1998/03/04 by TimBunce@ig.co.uk + + perldoc -f now uses pager if text is too long for screen + +Change 757 on 1998/03/04 by TimBunce@ig.co.uk + + Added OpenBSD hint file from + Document 'warn with no args' behaviour, from + +Change 756 on 1998/03/04 by TimBunce@ig.co.uk + + Fix for new gnulibc stdio.h when using sfio+perlio + +Change 755 on 1998/03/04 by TimBunce@ig.co.uk + + Fixed typo in vms/ext/Stdio/Stdio.pm AUTOLOAD + Added details of split in scalar context to perlfunc.pod + +Change 754 on 1998/03/04 by TimBunce@ig.co.uk + + Updated perl -v info to include reference to docs and home page. + +Change 753 on 1998/03/04 by TimBunce@ig.co.uk + + Updated hints/bsdos.sh for BSD/OS 3.1 + Fixed typo in pod/perlsyn.pod + Added workaround for old gmake in ext/SDBM_File/sdbm/Makefile.PL + Fixed typo in ext/GDBM_File/GDBM_File.pm + +Change 752 on 1998/03/04 by TimBunce@ig.co.uk + + Changed bug address in README to perlbug@perl.com + Changed Copyright in perl.c to 1998 + Added op/pos.t test from Robin Houston + +Change 751 on 1998/03/04 by TimBunce@ig.co.uk + + Make t/comp/require.t and t/lib/ph.t executable in repository + +Change 750 on 1998/03/04 by TimBunce@ig.co.uk + + Added dTHR definition to ease backwards compatibility for XS + source code from 5.005. + +Change 749 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "rename local 'op' variables to 'o'", #F114 + From: Gurusamy Sarathy + Files: op.h opcode.h proto.h dump.c op.c opcode.pl pp_ctl.c run.c scope.c + toke.c + +Change 748 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "consolidated win32 patch", #F112 + From: Gurusamy Sarathy + Files: MANIFEST pod/perlfaq2.pod pod/perlrun.pod win32/include/sys/socket.h + EXTERN.h INTERN.h dosish.h lib/ExtUtils/Command.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Win32.pm + lib/ExtUtils/Mksymlists.pm lib/File/DosGlob.pm t/TEST + t/harness win32/win32.h win32/win32iop.h README.win32 + doio.c installhtml installperl pp_sys.c win32/Makefile + win32/config.bc win32/config.vc win32/config_H.bc + win32/config_H.vc win32/config_h.PL win32/config_sh.PL + win32/dl_win32.xs win32/makedef.pl win32/makefile.mk + win32/perllib.c win32/runperl.c win32/win32.c + win32/win32sck.c win32/bin/perlglob.pl x2p/a2p.h x2p/a2p.c + x2p/a2py.c + +Change 747 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "initialize @INC in ph.t, and fix up MANIFEST", #F111 + From: Gurusamy Sarathy + Files: MANIFEST t/lib/ph.t + +Change 746 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "properly save STDOUT during system() in debugger", #F110 + From: Jason Smith + Files: lib/perl5db.pl + +Change 745 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "generate DynaLoader.pm at build time", #F109 + From: Achim Bohnet + Msg-ID: <9802111938.AA26224@o09.xray.mpe.mpg.de> + Files: MANIFEST ext/DynaLoader/DynaLoader.pm.PL ext/DynaLoader/Makefile.PL + +Change 744 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Install extensions with bootstrap in $archlib", #F108 + From: koenig@anna.mind.de (Andreas J. Koenig), koenig@kulturbox.de (Andreas + J. Koenig) + Msg-ID: + Files: lib/ExtUtils/Install.pm + +Change 743 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Pod::Html trips over "C<0>"", #F107 + From: Chip Salzenberg + Files: lib/Pod/Html.pm + +Change 742 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_58 | _04: pod2*,perlpod: L", #F106 + From: Achim Bohnet + Msg-ID: <9802111629.AA00595@o09.xray.mpe.mpg.de> + Files: pod/perlpod.pod lib/Pod/Html.pm lib/Pod/Text.pm pod/pod2man.PL + +Change 741 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "New patch for $^E==GetLastError() under Win32", #F105 + From: Gurusamy Sarathy , Tye McQueen + , ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <199801040630.AA29298@metronet.com>, + <199801041826.NAA11568@aatma.engin.umich.edu>, + <1998Jan4.130412.2719461@cor.newman> + Files: pod/perlfunc.pod pod/perlvar.pod doio.c lib/dumpvar.pl lib/perl5db.pl + win32/win32.h mg.c util.c win32/makedef.pl win32/win32.c + +Change 740 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "5.004_56: Patch to Tie::Hash and docs", #F104 + From: Ilya Zakharevich + Msg-ID: <199801120134.UAA05437@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod lib/Tie/Hash.pm + +Change 739 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "more doc for perldoc", #F103 + From: Gurusamy Sarathy + Files: utils/perldoc.PL + +Change 738 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make perldoc look for an index file ", #F102 + From: Gisle Aas + Msg-ID: <199801221220.NAA22902@furu.g.aas.no> + Files: utils/perldoc.PL + +Change 737 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "perldoc -F filename", #F101 + From: Ilya Zakharevich + Msg-ID: <199712120037.TAA00176@math.mps.ohio-state.edu> + Files: utils/perldoc.PL + +Change 736 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "sv_grow can fail for HAS_64K_LIMIT systems", #F100 + From: Gisle Aas + Msg-ID: + Files: sv.c + +Change 735 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Benchmark.pm: timethese corrupts $_", #F099 + From: abigail@fnx.com + Msg-ID: <19980201114609.7779.qmail@betelgeuse.wayne.fnx.com> + Files: lib/Benchmark.pm + +Change 734 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "STRANGE_MALLOC should test failed alloc", #F098 + From: Gisle Aas + Msg-ID: <199802021406.PAA03285@furu.g.aas.no> + Files: hv.c + +Change 733 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "support caseless %ENV", #F097 + From: Gurusamy Sarathy + Files: hv.c t/op/magic.t win32/win32.h + +Change 732 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "newer cperl-mode.el (from 5.004_60)", #F096 + From: Ilya Zakharevich + Files: emacs/cperl-mode.el + +Change 731 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Handle set magic on xsub OUTPUT args, add API functions that handle + magic", #F095 + From: Gurusamy Sarathy + Msg-ID: <199801190409.XAA26710@aatma.engin.umich.edu> + Files: pod/perlguts.pod pod/perlxs.pod embed.h proto.h sv.h global.sym + lib/ExtUtils/xsubpp sv.c + +Change 730 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Fix flawed cleanup when signal handlers are not defined", #F094 + From: Gurusamy Sarathy + Msg-ID: <199710290106.UAA11485@aatma.engin.umich.edu> + Files: mg.c + +Change 729 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Tests for C", #F093 + From: Hugo van der Sanden + Msg-ID: <199711021247.MAA01743@crypt.compulink.co.uk> + Files: t/op/sort.t + +Change 728 on 1998/03/04 by TimBunce@ig.co.uk + + Title: "Make search.pl work on win32", #F092 + From: Gurusamy Sarathy + Files: win32/bin/search.pl + +Change 721 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix spurious perldoc warnings on DOSISH platforms", #F091 + From: Molnar Laszlo + Msg-ID: <34475659.1AA69855@cdata.tvnet.hu> + Files: utils/perldoc.PL + +Change 720 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make ExtUtils::MM_Unix::fixin() do something meaningful on win32", + #F090 + From: Gurusamy Sarathy + Msg-ID: <199801070016.TAA17766@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + +Change 719 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix inconsistent case $ENV{Path} (vs $ENV{PATH})", #F089 + From: Gurusamy Sarathy + Files: lib/FindBin.pm + +Change 718 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix File::Find's longstanding confusion about win32 being like VMS", + #F088 + From: Gurusamy Sarathy + Msg-ID: <199802020459.XAA04964@aatma.engin.umich.edu> + Files: lib/File/Find.pm + +Change 717 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "do_postponed breaks with multiple interpreters", #F087 + From: Gurusamy Sarathy + Msg-ID: <199710290316.WAA15888@aatma.engin.umich.edu> + Files: op.c + +Change 716 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make warning on C optional, add to perl{diag,delta}.pod", + #F086 + From: Gurusamy Sarathy + Files: pod/perldelta.pod pod/perldiag.pod toke.c + +Change 715 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Pod::Html bug and fix: missing in index", #F085 + From: Gurusamy Sarathy + Msg-ID: <199802192314.SAA23326@aatma.engin.umich.edu> + Files: lib/Pod/Html.pm + +Change 714 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New pod: perlhist", #F084 + From: Jarkko Hietaniemi + Msg-ID: <199802191556.RAA09578@alpha.hut.fi> + Files: MANIFEST pod/perl.pod pod/perlhist.pod pod/perltoc.pod pod/buildtoc + +Change 713 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix restoration of locals on scope unwinding", #F083 + From: Gurusamy Sarathy + Msg-ID: <199802110515.AAA23700@aatma.engin.umich.edu> + Files: pp_ctl.c t/op/local.t + +Change 712 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "after an eval-ed bad require, requiring a string ref SEGVs", #F082 + From: Gurusamy Sarathy + Msg-ID: <199802102349.SAA16001@aatma.engin.umich.edu> + Files: pp_ctl.c + +Change 711 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix seg fault on eval/require and syntax errors", #F081 + From: Gurusamy Sarathy + Msg-ID: <199802102321.SAA15346@aatma.engin.umich.edu> + Files: MANIFEST scope.h op.c pp_ctl.c scope.c t/comp/require.t toke.c + +Change 710 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_58: the locale.t problem in IRIX", #F080 + From: Jarkko Hietaniemi + Msg-ID: <199802091747.TAA01735@alpha.hut.fi> + Files: t/pragma/locale.t + +Change 709 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "sv_setnv will upgrade SVt_NV to SVt_PVNV", #F079 + From: Gisle Aas + Msg-ID: + Files: sv.c + +Change 708 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate double warnings under C", #F077 + From: "M.J.T. Guy" + Msg-ID: + Files: gv.c op.c toke.c + +Change 707 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix infinite loop on unlink() failure in File::Path::rmtree()", + #F076 + From: Murray Nesbitt , Tim Bunce + Msg-ID: <199802061100.LAA16423@toad.ig.co.uk> + Files: lib/File/Path.pm + +Change 706 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update of h2ph", #F075 + From: kstar@www.chapin.edu (Kurt D. Starsinic) + Msg-ID: <199802051354.FAA11452@www.chapin.edu> + Files: t/lib/ph.t utils/h2ph.PL + +Change 705 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix AutoLoader for deep packages", #F074 + From: Zachary Miller + Msg-ID: <199710092348.SAA02108@zappy.er.usgs.gov> + Files: lib/AutoLoader.pm + +Change 704 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix order of warnings for misplaced subscripts", #F073 + From: Hugo van der Sanden + Msg-ID: <199710131023.LAA16796@crypt.compulink.co.uk> + Files: op.c + +Change 703 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make recursive lexical analysis more robust", #F072 + From: Ilya Zakharevich and Chip Salzenberg + Msg-ID: <199710160102.VAA28817@monk.mps.ohio-state.edu> + Files: toke.c + +Change 702 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix random whitespace errors in docs", #F070 + From: Roderick Schertler + Msg-ID: <12726.877706444@eeyore.ibcinc.com> + Files: pod/perlfunc.pod pod/checkpods.PL + +Change 701 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix line numbers after here documents in eval STRING", #F069 + From: Ilya Zakharevich + Msg-ID: <199710241745.NAA08166@monk.mps.ohio-state.edu> + Files: toke.c + +Change 700 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV from combining caller and C", #F068 + From: James Duncan , Nicholas Clark + + Msg-ID: <199710241248.NAA00163@flirble.org>, + + Files: pp_ctl.c sv.c + +Change 699 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't fold string comparison under C", #F067 + From: Jarkko Hietaniemi + Msg-ID: <199711151506.RAA26287@alpha.hut.fi> + Files: op.c + +Change 698 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on constant at end of sort block", #F066 + From: Administration + Msg-ID: <199711170838.JAA26073@thetis.fi.muni.cz> + Files: op.c + +Change 697 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow C to mean C", #F065 + From: Chip Salzenberg + Files: op.c + +Change 696 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix extension version mismatch message", #F064 + From: Chip Salzenberg + Files: XSUB.h + +Change 695 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Better handle and test struct tm of Linux and SunOS", #F063 + From: Andy Dougherty + Msg-ID: + Files: MANIFEST ext/POSIX/hints/linux.pl ext/POSIX/hints/sunos_4.pl + hints/linux.sh hints/sunos_4_1.sh t/lib/posix.t + +Change 694 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix doc bug in getservbyname() examples", #F062 + From: Tom Christiansen + Files: ext/Socket/Socket.pm + +Change 693 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Kill warning about parameter type", #F061 + From: Chip Salzenberg + Files: op.c + +Change 692 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Socket occasional SEGV", #F060 + From: Trevor Blackwell + Msg-ID: <199710281804.NAA09632@wagg.viaweb.com> + Files: ext/Socket/Socket.xs + +Change 691 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid SEGV from local($@)", #F059 + From: Gurusamy Sarathy + Msg-ID: <199710290251.VAA14362@aatma.engin.umich.edu> + Files: pp_ctl.c + +Change 690 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't use broken pad_reset() (was Re: Perl bug in 5.004_03 )", #F058 + From: Gurusamy Sarathy + Msg-ID: <199710300036.TAA01004@aatma.engin.umich.edu> + Files: op.c + +Change 689 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Use STMT_{START,END} in XSRETURN", #F057 + From: Gurusamy Sarathy + Msg-ID: <199710300245.VAA04244@aatma.engin.umich.edu> + Files: XSUB.h + +Change 688 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: Sort grammar bug", #F056 + From: Gurusamy Sarathy + Msg-ID: <199711011946.OAA18882@aatma.engin.umich.edu> + Files: toke.c + +Change 687 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Document indirect object cases for exec(), system()", #F055 + From: Dominic Dunlop + Msg-ID: + Files: pod/perlfunc.pod + +Change 686 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Update docs on tr///", #F054 + From: Tom Phoenix + Msg-ID: + Files: pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + pod/perllocale.pod pod/perlmod.pod pod/perlop.pod + pod/perlstyle.pod toke.c + +Change 685 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: perlop bitwise & | ^ documentation", #F053 + From: Tom Phoenix + Msg-ID: + Files: pod/perlop.pod + +Change 684 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix SEGV on C<*glob{'SCALAR','ARRAY'}>", #F052 + From: "Joseph N. Hall" + Msg-ID: <199711110552.WAA12613@gadget.cscaper.com> + Files: perly.c perly.c.diff perly.y vms/perly_c.vms + +Change 683 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "for perlguts.pod: document sv_derived_from, sv_vcatpfn and + sv_vsetpfn", #F051 + From: jan.dubois@ibm.net (Jan Dubois) and Chip Salzenberg + Msg-ID: <346ae970.7444534@smtp1.ibm.net> + Files: pod/perlguts.pod + +Change 682 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "5.004_04: locale startup failure (at last) documented", #F050 + From: Jarkko Hietaniemi + Msg-ID: <199711172054.WAA08261@alpha.hut.fi> + Files: INSTALL pod/perldiag.pod pod/perllocale.pod + +Change 681 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Cope with lack of args in Fcntl::AUTOLOAD", #F049 + From: Jerome Abela + Msg-ID: <19971120183248.23588@coredump.hsc.fr> + Files: ext/Fcntl/Fcntl.pm + +Change 680 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Commenting toke.c", #F048 + From: gnat@frii.com + Msg-ID: <199801082138.OAA14186@prometheus.frii.com> + Files: toke.c + +Change 679 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re: 5.004_04 vec() fails with 32-bit values", #F047 + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perlguts.pod pp.c t/op/vec.t + +Change 678 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "A few perl5.004_03 bugs", #F046 + From: Hugo van der Sanden + Msg-ID: <199801221211.MAA05315@crypt.compulink.co.uk> + Files: mg.c t/op/magic.t + +Change 677 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Faster, cleaner av_unshift() ", #F045 + From: Gisle Aas + Msg-ID: <199801221850.TAA23111@furu.g.aas.no> + Files: av.c + +Change 676 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "New hints/solaris2.sh", #F044 + From: Stephen Zander + Msg-ID: <87oh12y458.fsf@wsuse5.mckesson.com> + Files: hints/solaris_2.sh + +Change 675 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Refresh Complex.pm and test", #F043 + From: Jarkko Hietaniemi + Msg-ID: <199802051608.SAA20262@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + +Change 674 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (\@@) proto", #F042 + From: "Joseph N. Hall" + Msg-ID: <199801240132.SAA25111@gadget.cscaper.com> + Files: op.c t/comp/proto.t + +Change 673 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Allow empty BLOCK in code", #F041 + From: Vladimir Alexiev + Msg-ID: <19980129002112Z13378-6931+226@scapa.cs.ualberta.ca> + Files: toke.c + +Change 672 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix name of $Foo::{'Bar::'}: '*Foo::Bar::'", #F040 + From: Chip Salzenberg + Files: gv.c t/op/gv.t + +Change 671 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Keep accurate reference count on globs' stashes", #F038 + From: Gisle Aas + Msg-ID: + Files: gv.c sv.c + +Change 670 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Avoid memory allocation in gv_fetchpv(), for speed", #F037 + From: Chip Salzenberg + Files: gv.c + +Change 669 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Configure less negative about PerlIO", #F036 + From: chip@atlantic.net + Msg-ID: <199801312323.SAA15237@cyprus.atlantic.net> + Files: Configure + +Change 668 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix (mostly) pseudo-same-REs due to embedded NULs", #F035 + From: Martin Plechsmid + Msg-ID: <199802021217.NAA05230@albert.karlin.mff.cuni.cz> + Files: pp_ctl.c + +Change 667 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Make Getopt::Long avoid $&, $`, $'", #F034 + From: Irving Reid + Msg-ID: <98Feb3.005102est.11655@janus.tor.securecomputing.com> + Files: lib/Getopt/Long.pm + +Change 666 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "adding the newSVpvn API function", #F033 + From: Matthias Ulrich Neeracher + Msg-ID: <199801310532.GAA23798@solar.ethz.ch> + Files: pod/perlguts.pod pod/perltoc.pod proto.h global.sym sv.c + +Change 665 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Support C as function-blind bearword", #F032 + From: Chip Salzenberg + Files: toke.c + +Change 664 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Re-optimize character classes", #F031 + From: Chip Salzenberg + Files: regcomp.h regcomp.c regexec.c + +Change 663 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C which needed ENTER/LEAVE", #F030 + From: dfh@dwroll.lucent.com (D461-David_F_Haertig(Dave)83040) + Msg-ID: + Files: op.c t/op/local.t + +Change 662 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Dramatically improve performance of // with parens or $&", #F029 + From: Chip Salzenberg + Files: cop.h perl.h proto.h regexp.h gv.c interp.sym perl.c pp.c pp_ctl.c + pp_hot.c regexec.c scope.c + +Change 661 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't warn on $x{shift}, ne => 1, or -f => 1", #F028 + From: Chip Salzenberg + Files: toke.c + +Change 660 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Protect against weirdness with unreal @_ in C", #F027 + From: Chip Salzenberg + Files: scope.c + +Change 659 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C", #F026 + From: Hugo van der Sanden + Msg-ID: <199711021331.NAA01826@crypt.compulink.co.uk> + Files: sv.c t/op/sprintf.t + +Change 658 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Tiny core patch for source filters", #F025 + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9711202312.AA02937@claudius.bfsec.bt.co.uk> + Files: toke.c + +Change 657 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Here-doc in s///e (was: Bug)", #F024 + From: Hugo van der Sanden + Msg-ID: <199711221445.OAA14153@crypt.compulink.co.uk> + Files: t/base/lex.t toke.c + +Change 656 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix duplicate warnings on C<-e undef>", #F023 + From: Hugo van der Sanden + Msg-ID: <199711221252.MAA14000@crypt.compulink.co.uk> + Files: doio.c t/pragma/warn-1global + +Change 655 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix '*' prototype", #F022 + From: Ilya Zakharevich + Msg-ID: <199711212225.RAA00755@monk.mps.ohio-state.edu> + Files: toke.c + +Change 654 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "File::Find bugs (and patches)", "File::Find bugs & patches", #F021 + From: "Conrad E. Kimball" + Msg-ID: <199711260703.XAA21257@mailgate2.boeing.com> + Files: lib/File/Find.pm + +Change 653 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix typo: FORM{,AT}LINE", #F020 + From: Chip Salzenberg + Files: sv.c + +Change 652 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix use of unref mem when blessed object goes out of scope", #F019 + From: Gurusamy Sarathy + Msg-ID: <199711282326.SAA15090@aatma.engin.umich.edu> + Files: scope.c + +Change 651 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix C", #F018 + From: Stephane Payrard + Msg-ID: <199712040054.BAA04612@www.zweig.com> + Files: op.c t/op/my.t + +Change 650 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "enhanced "use strict" warning", #F017 + From: Tkil + Msg-ID: <199712040938.CAA07628@reptile.scrye.com> + Files: gv.c t/pragma/strict-subs t/pragma/strict-vars + +Change 649 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "eval of sub gives spurious "uninitialised" warning", #F016 + From: Gurusamy Sarathy + Msg-ID: <199712061025.FAA14396@aatma.engin.umich.edu> + Files: pod/perldelta.pod pod/perlfunc.pod op.c t/op/eval.t + +Change 648 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Assigning result of pop scrambles unrelated reference", #F015 + From: Gurusamy Sarathy + Msg-ID: <199712061100.GAA14864@aatma.engin.umich.edu> + Files: sv.c + +Change 647 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "[PERL] Filedescriptor leak in 5.004_55 (and earlier)", #F014 + From: Ilya Zakharevich + Msg-ID: <199712151922.OAA06410@monk.mps.ohio-state.edu> + Files: os2/os2.c util.c + +Change 646 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix fdopen() on STD{IN,OUT,ERR}", #F013 + From: Roderick Schertler + Msg-ID: + Files: doio.c t/op/misc.t + +Change 645 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix local $a[0] and local $h{a}", #F012 + From: Stephen McCamant + Msg-ID: + Files: embed.h scope.h global.sym pp.c pp_hot.c scope.c t/op/local.t + +Change 644 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Eliminate redundant mg_get() in SvTRUE()", #F011 + From: Spider Boardman + Msg-ID: <199712251839.NAA14800@Orb.Nashua.NH.US> + Files: sv.c + +Change 643 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Don't force scalar context on C or C", #F010 + From: Chip Salzenberg + Files: op.c t/op/my.t + +Change 642 on 1998/03/03 by TimBunce@ig.co.uk + + Title: "Fix assignment to $_[0] in DESTROY", #F009 + From: Gurusamy Sarathy + Msg-ID: <199801010030.TAA14274@aatma.engin.umich.edu> + Files: pod/perlobj.pod sv.c t/op/ref.t + +Change 627 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix inefficient checks for TIEHANDLE", #F008 + From: Gurusamy Sarathy + Msg-ID: <199801080106.UAA05048@aatma.engin.umich.edu> + Files: pp_hot.c pp_sys.c + +Change 626 on 1998/03/02 by TimBunce@ig.co.uk + + This is the change description for change 625 + Title: "Fix tr///s option", #F007 + From: Inaba Hiroto + Msg-ID: <19980110155333D.inaba@st.rim.or.jp> + Files: doop.c + +Change 623 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix lexical lookup in eval-sub-eval", #F006 + From: Chip Salzenberg + Files: pp_ctl.c + +Change 622 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Don't upgrade target of assignment from LVALUE", #F005 + From: Chip Salzenberg + Files: sv.c + +Change 621 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix compile-time warning line in while ()", #F004 + From: Chip Salzenberg + Files: op.c + +Change 620 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "STMT foreach LIST;", #F002 + From: Chip Salzenberg + Files: pod/perlsyn.pod perly.c perly.c.diff perly.y t/cmd/mod.t toke.c + vms/perly_c.vms + +Change 619 on 1998/03/02 by TimBunce@ig.co.uk + + Title: "Fix SIGSEGV on C<42 until forever>", #F001 + From: Chip Salzenberg + Files: op.c + +---------------- +Version 5.004_04 Maintenance release 4 for 5.004 +---------------- + +"1. Out of clutter, find simplicity. + 2. From discord, find harmony. + 3. In the middle of difficulty lies opportunity." + -- Albert Einstein, three rules of work + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + Fixed gaps in tainting (readdir, readlink, gecos, bit vector ops). + Fixed memory leak in splice(@_). + Fixed debugger core dumps. + IO::Socket now sets autoflush by default. + Several perldoc bugs fixed, now faster and more helpful. + Fixed Win32 handle leak. + Many other improvements to Win32 support. + Many many other bug fixes and enhancements. + + + ------ BUILD PROCESS ------ + + Title: "ExtUtils::Liblist prints diagnostics to STDOUT (vs. STDERR)" + From: Andy Dougherty , jesse@ginger + (Jesse Glick) + Msg-ID: <199708290032.UAA15663@ginger>, + + Files: MANIFEST lib/ExtUtils/Liblist.pm + + Title: "Set LD_RUN_PATH when building suidperl" + From: Chip Salzenberg , Tony Sanders + + Msg-ID: <199708272226.QAA10206@austin.bsdi.com> + Files: Makefile.SH + + Title: "INSTALL version 1.26" + From: Andy Dougherty + Msg-ID: + Files: INSTALL + + Title: "Propagate MAKE=$(MAKE) through perl build" + From: Andy Dougherty + Msg-ID: + Files: Makefile.SH makedepend.SH x2p/Makefile.SH ext/util/make_ext + + Title: "update to installperl for perl5.004_02 to skip CVS dir" + From: Tony Sanders + Msg-ID: <199708272307.RAA13451@austin.bsdi.com> + Files: installperl + + Title: "makedepend loop on HP-UX 10.20" + Msg-ID: <1997Sep20.183731.2297443@cor.newman> + Files: Makefile.SH + + Title: "Tiny Grammaro in INSTALL" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: INSTALL + + Title: "Fix Configured osvers under Linux 1" + From: Andy Dougherty , Hugo van der + Sanden + Msg-ID: <199709241439.PAA17114@crypt.compulink.co.uk>, + + Files: Configure + + Title: "INSTALL-1.28" + From: Andy Dougherty + Msg-ID: + Files: INSTALL + + Title: "makedepend.SH fix for UNICOS" + From: Jarkko Hietaniemi + Msg-ID: <199710132039.XAA21459@alpha.hut.fi> + Files: makedepend.SH + + ------ CORE LANGUAGE ------ + + Title: "Re: "perl -d" dumps core when loading syslog.ph" + From: Jochen Wiedmann , Stephen McCamant + , ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <1997Aug30.034921.2297381@cor.newman.upenn.edu>, + <3407639E.FEBF20BA@neckar-alb.de>, + + Files: pp_ctl.c + + Title: "Allow $obj->$coderef()" + From: Chip Salzenberg + Msg-ID: <199708291649.MAA23276@nielsenmedia.com> + Files: pp_hot.c + + Title: "Localize PV value in save_gp()", "typeglob differences in perl4 and + perl5" + From: Gurusamy Sarathy , Stephen McCamant + + Msg-ID: <199708272348.TAA03139@aatma.engin.umich.edu>, + + Files: scope.c t/op/ref.t + + Title: "Avoid assumption that STRLEN == I32" + From: Chip Salzenberg , Hallvard B Furuseth + + Msg-ID: <199708242310.BAA05497@bombur2.uio.no> + Files: hv.c + + Title: "Fix memory leak in splice(@_)" + From: "Tuomas J. Lukka" , Chip Salzenberg + + Msg-ID: + Files: proto.h av.c global.sym pp.c + + Title: "Fix line number of warnings in while() conditional", "misleading + uninit value warning" + From: Chip Salzenberg , Greg Bacon + + Msg-ID: <199708271607.LAA01403@crp-201.adtran.com> + Files: proto.h op.c perly.c perly.y + + Title: "-t and POSIX::isatty on IO::Handle objects", "Fix C<-t $handle>" + From: Chip Salzenberg , Greg Ward + + Msg-ID: <199708261754.NAA24826@bottom.bic.mni.mcgill.ca> + Files: pp_sys.c + + Title: "Fix output of invalid printf formats" + From: Chip Salzenberg , Hugo van der Sanden + + Msg-ID: <199708241529.QAA02457@crypt.compulink.co.uk> + Files: sv.c t/op/sprintf.t + + Title: "regexec.c regcppartblow declaration missing an arg" + From: Hugo van der Sanden + Msg-ID: <199708290059.BAA05808@crypt.compulink.co.uk> + Files: regexec.c + + Title: "taint readlink, readdir, gecos" + From: Jarkko Hietaniemi + Msg-ID: <199709131651.TAA13471@alpha.hut.fi> + Files: pod/perlfunc.pod pod/perlsec.pod pp_sys.c t/op/taint.t + + Title: "clean up old style package' usage in op.c" + From: Stephen Potter + Msg-ID: <199709151813.NAA14433@psisa.psa.pencom.com> + Files: op.c + + Title: "beautifying usage() code in perl.c" + From: "John L. Allen" <"John L. Allen"> + Msg-ID: + Files: perl.c + + Title: "debugger to fix core dumps, adds $^S" + From: Ilya Zakharevich + Msg-ID: <199709170823.EAA21359@monk.mps.ohio-state.edu> + Files: pod/perlvar.pod perl.h gv.c lib/perl5db.pl mg.c perl.c toke.c + + Title: "downgrade "my $foo masks earlier" from mandatory to "-w"" + From: Gurusamy Sarathy , Stephen Potter + + Msg-ID: <199709091832.NAA14763@psisa.psa.pencom.com>, + <199709102019.QAA09591@aatma.engin.umich.edu> + Files: pod/perldelta.pod pod/perldiag.pod op.c + + Title: "fix overridden glob() problems" + From: Gurusamy Sarathy + Msg-ID: <199709171645.MAA13988@aatma.engin.umich.edu> + Files: MANIFEST pod/perlsub.pod lib/File/DosGlob.pm op.c t/lib/dosglob.t + toke.c + + Title: "Reverse previous "Fix C" patch" + From: Chip Salzenberg , Kenneth Albanowski + , Tom Christiansen + + Msg-ID: <199707050155.VAA27394@rio.atlantic.net>, + <199708172326.RAA19344@jhereg.perl.com>, + + Files: toke.c + + Title: "printf type warning buglets in m3t2" + From: Hallvard B Furuseth + Msg-ID: <199708141017.MAA10225@bombur2.uio.no> + Files: regcomp.c regexec.c scope.c sv.c util.c x2p/util.c + + Title: "Localize PV value in save_gp()", "typeglob differences in perl4 and + perl5" + From: Gurusamy Sarathy , Stephen McCamant + + Msg-ID: <199708272348.TAA03139@aatma.engin.umich.edu>, + + Files: scope.c t/op/ref.t + + Title: "unpack now allows commas but -w warns", "unpack() difference + 5.003->5.004" + From: "John L. Allen" , Chip Salzenberg + , Jarkko Hietaniemi , + Jim Esten , Jim Esten + , timbo (Tim Bunce) + Msg-ID: <199709031632.LAA29584@wepco.com>, + <199709090257.WAA32670@rio.atlantic.net>, + <199709090917.MAA05602@alpha.hut.fi>, + <199709091000.LAA24094@toad.ig.co.uk>, + <341077FE.132F@wdynamic.com>, + + Files: pod/perldiag.pod pp.c + + Title: "5.004_04 trial 1 assorted minor details" + From: Hallvard B Furuseth + Msg-ID: + Files: Porting/pumpkin.pod hv.c op.c sv.c x2p/util.c + + Title: "A couple of 4_04t1 problems" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9709210959.AA28772@claudius.bfsec.bt.co.uk> + Files: lib/Cwd.pm perl.c + + Title: "Minor changes to ease port to MVS" + From: Len Johnson , SMTP%"BAHUFF@us.oracle.com" , + SMTP%"pfuntner@vnet.ibm.com" , pvhp@forte.com (Peter + Prymmer) + Msg-ID: <199709162058.NAA00952@mailsun2.us.oracle.com> + Files: unixish.h miniperlmain.c + + Title: "Truer version string and more robust perlbug" + From: "Michael A. Chase" , Hugo van der Sanden + + Msg-ID: <199709201514.QAA21187@crypt.compulink.co.uk>, + <1997Sep22.090701.2297448@cor.newman> + Files: perl.c utils/perlbug.PL + + Title: "Fix locale bug for constant (readonly) strings" + From: Jarkko Hietaniemi + Msg-ID: <199709262125.AAA28292@alpha.hut.fi> + Files: sv.c t/pragma/locale.t + + Title: "Enable truly global glob()" + From: Gurusamy Sarathy + Msg-ID: <199710080000.UAA18972@aatma.engin.umich.edu> + Files: op.c + + Title: "Fix for $0 truncation" + From: Tim Bunce + Msg-ID: <199710081703.SAA02653@toad.ig.co.uk> + Files: mg.c + + Title: "Fix for missing &import leaving stack untidy" + From: Chip Salzenberg + Msg-ID: <199709282252.SAA22915@nielsenmedia.com> + Files: pp_hot.c + + Title: "Larry's proto fix" + From: Chip Salzenberg + Msg-ID: <199709290004.UAA07559@nielsenmedia.com> + Files: op.c t/comp/proto.t + + Title: "Fix bugs with magical arrays and hashes (@ISA)" + From: Chip Salzenberg + Msg-ID: <199709232148.RAA29967@rio.atlantic.net> + Files: perl.h proto.h av.c global.sym gv.c mg.c pp.c pp_hot.c scope.c + t/op/method.t + + Title: "Perl_debug_log stream used for all DEBUG_*(...) macro uses" + From: Nick Ing-Simmons , Tim Bunce + Msg-ID: <199709230820.JAA11945@tiuk.ti.com> + Files: perl.c taint.c util.c + + Title: "Tainting bitwise vector ops" + From: Chip Salzenberg + Msg-ID: <199710061726.NAA16438@rio.atlantic.net> + Files: doop.c t/op/taint.t + + Title: "Enhance $^E on OS/2" + From: Ilya Zakharevich + Msg-ID: <199709232236.SAA04463@monk.mps.ohio-state.edu> + Files: pod/perlvar.pod mg.c os2/Changes + + Title: "option "!#... -- ..." in perl 5.004.03 seems not to work" + From: "John L. Allen" , Urs Thuermann + + Msg-ID: <199709232030.WAA30425@isnogud.escape.de>, + + Files: perl.c + + Title: "syswrite will again write a zero length buffer" + From: Cameron Simpson , Jarkko Hietaniemi , + aml@world.std.com (Andrew M. Langmead) + Msg-ID: <199710042107.AAA28561@alpha.hut.fi>, + <19971007104652-cameron-1-10391@sid.research.canon.com.au> + Files: pp_sys.c + + Title: "make Odd number of elements in hash list warning non-mandatory" + From: Jason Varsoke {81530} + Msg-ID: <199710021651.MAA15690@caesun7.msd.ray.com> + Files: pp.c pp_hot.c + + Title: "Fix defined() bug in m4t3 affecting LWP" + From: chip@atlantic.net@ig.co.uk () + Msg-ID: <199710101822.OAA14249@cyprus.atlantic.net> + Files: pp.c + + Title: "Include $archname in perl -v output" + From: Tim Bunce + Files: perl.c + + Title: "-I flag can easily lead to whitespace in @INC" + From: Kenneth Stephen , Tim Bunce , + pvhp@forte.com (Peter Prymmer) + Msg-ID: <199710130922.KAA07780@toad.ig.co.uk>, + <5040400007001448000002L082*@MHS>, + <9710132015.AA12457@forte.com> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "perldiag.pod: gotcha in short pattern/char ops" + From: Jarkko Hietaniemi + Msg-ID: <199709050718.KAA31405@alpha.hut.fi> + Files: pod/perldiag.pod + + Title: "Documenting the perl-thanks address" + From: Tom Phoenix + Msg-ID: + Files: pod/perl.pod + + Title: "Missing section for @_ in perlvar." + From: abigail@fnx.com (Abigail) + Msg-ID: <199708142146.RAA13146@fnx.com> + Files: pod/perlvar.pod + + Title: "Promised information about AvHASH in perguts is not delivered" + From: mjd@plover.com + Files: pod/perlguts.pod + + Title: "perlfunc.doc - $_ aliasing in map, grep, foreach etc" + From: Ted Ashton + Msg-ID: <199708181852.OAA15901@ns.southern.edu> + Files: pod/perlfunc.pod + + Title: "-U Unsafe operations need -w to warn" + From: Tom Phoenix + Msg-ID: + Files: pod/perlrun.pod + + Title: "document the return value of syscall" + From: Hans Mulder + Msg-ID: <1997Sep7.160817.2297395@cor.newman> + Files: pod/perlfunc.pod + + Title: "minor fix for perltrap.pod" + From: abigail@fnx.com (Abigail) + Msg-ID: <199709170500.BAA14805@fnx.com> + Files: pod/perltrap.pod + + Title: "xsubpp: document advanced dynamic typemap usage" + From: "Rujith S. de Silva" + Files: pod/perlxs.pod + + Title: "Improved diagnostic docs for here-documents" + From: Tom Phoenix + Msg-ID: + Files: pod/perldiag.pod + + Title: "[POD patch] do-FILE forces scalar context." + From: Robin Houston + Msg-ID: <199709221553.QAA28409@carryon.oneworld.org> + Files: pod/perlfunc.pod + + Title: "perlop.pop. Behaviour of C vs C." + From: abigail@fnx.com (Abigail) + Msg-ID: <199709220107.VAA27064@fnx.com> + Files: pod/perlop.pod + + Title: "Clarify exec docs in perlfunc.pod" + From: Hugo van der Sanden + Msg-ID: <199710081353.OAA00834@crypt.compulink.co.uk> + Files: pod/perlfunc.pod + + Title: "Documentation patch for perlguts.pod--document tainting routines" + From: Dan Sugalski + Msg-ID: <3.0.3.32.19971007165226.02fd2cd4@osshe.edu> + Files: pod/perlguts.pod + + Title: "Man perlfunc: incorrect split example" + From: Joerg Porath + Msg-ID: <199709240620.IAA30928@pandora.hrz.tu-chemnitz.de> + Files: pod/perlfunc.pod + + Title: "Improve "Use of inherited AUTOLOAD for non-method" disgnostic" + From: rjray@uswest.com (Randy J. Ray) + Msg-ID: <199709231710.LAA08854@tremere.ecte.uswc.uswest.com> + Files: pod/perldiag.pod + + Title: "Document split-with-limit on empty string perl4/perl5 change" + From: "M.J.T. Guy" , Gisle Aas , Hugo + van der Sanden + Msg-ID: <199709221419.PAA03987@crypt.compulink.co.uk>, + + Files: pod/perlfunc.pod pod/perltrap.pod URI/URL/http.pm t/op/split.t + + Title: "Clarify close() docs" + From: Ilya Zakharevich + Msg-ID: <199710081653.MAA20611@monk.mps.ohio-state.edu> + Files: pod/perlfunc.pod + + Title: "perldiag log & sqrt - refer to Math::Complex package" + From: Jarkko Hietaniemi + Msg-ID: <199710042129.AAA20367@alpha.hut.fi> + Files: pod/perldiag.pod + + Title: "perlfunc.pod: sysread, syswrite docs" + From: Jarkko Hietaniemi + Msg-ID: <199710061910.WAA15266@alpha.hut.fi> + Files: pod/perlfunc.pod + + Title: "Document //gc" + From: abigail@fnx.com (Abigail) + Msg-ID: <199709232302.TAA27947@fnx.com> + Files: pod/perlop.pod + + Title: "repeating #! switches" + From: Chip Salzenberg , Robin Barker + + Msg-ID: <199709241736.NAA25855@rio.atlantic.net>, + <24778.9709241501@tempest.cise.npl.co.uk> + Files: pod/perlrun.pod + + Title: "Re: taint documentation bug" + From: Ken Estes , Tom Phoenix + Msg-ID: + Files: pod/perlsec.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "FileHandle.pm fails if Exporter has not been loaded previously" + From: jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <3445e05b.17874041@smtp2.ibm.net> + Files: lib/FileHandle.pm + + Title: "Prefer startperl path over perlpath in MakeMaker" + From: Andreas Klussmann + Msg-ID: <199709162017.WAA05043@troubadix.infosys.heitec.net> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Sys::Hostname fails under Solaris 2.5 when setuid" + From: Patrick Hayes + Msg-ID: <199708201240.OAA04243@goblin.renault.fr> + Files: lib/Sys/Hostname.pm + + Title: "Cwd::getcwd cannot handle path contains '0' element" + From: Hironori Ikura , Hironori Ikura + , Stephen Zander + Msg-ID: <19970830060142J.hikura@matsu.tcc.co.jp>, + + Files: lib/Cwd.pm + + Title: "Getopt::Long 2.11" + From: JVromans@squirrel.nl (Johan Vromans) + Msg-ID: + Files: lib/Getopt/Long.pm + + Title: "IO::Socket autoflush by default, assume tcp and PeerAddr" + From: "M.J.T. Guy" , Andy Dougherty + , Gisle Aas + + Msg-ID: , + , + + Files: ext/IO/lib/IO/Socket.pm + + Title: "Syslog.pm and missing _PATH_LOG" + From: Ulrich Pfeifer + Msg-ID: + Files: lib/Sys/Syslog.pm + + Title: "Undocumented: $Test::Harness::switches" + From: Achim Bohnet + Msg-ID: <9708272110.AA26904@o09.xray.mpe.mpg.de> + Files: lib/Test/Harness.pm + + Title: "Patches for lib/Math/Complex.pm and t/lib/complex.t" + From: Jarkko Hietaniemi + Msg-ID: <199709102009.WAA27428@anna.in-berlin.de> + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Win32: Install.pm not correctly comparing binary files." + From: Jeff Urlwin + Msg-ID: <01BCBFAA.E325C4A0.jurlwin@access.digex.net> + Files: lib/ExtUtils/Install.pm + + Title: "Document that File::Find doesn't follow symlinks" + From: Greg Ward + Msg-ID: <199708191853.OAA07111@bottom.bic.mni.mcgill.ca> + Files: lib/File/Find.pm + + Title: "fix subroutines called in a void context in perl5db.pl" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/perl5db.pl + + Title: "xsubpp fix to allow #ifdef's around entire XSubs" + From: John Tobey + Msg-ID: <199709070034.AAA16457@remote119> + Files: lib/ExtUtils/xsubpp + + Title: "Banishing eval from getopt.pl and Getopt/Std.pm" + From: "John L. Allen" + Msg-ID: + Files: lib/getopt.pl lib/Getopt/Std.pm + + Title: "further complex number patches" + From: Jarkko Hietaniemi , d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199709221009.FAA21216@staff2.cso.uiuc.edu>, + <199709221216.PAA15130@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Trap Time::Local infinite loop" + From: Hugo van der Sanden + Msg-ID: <199710030030.BAA17372@crypt.compulink.co.uk> + Files: lib/Time/Local.pm + + Title: "Cosmetic Test::Harness patch" + From: Ilya Zakharevich + Msg-ID: <199710032226.SAA15354@monk.mps.ohio-state.edu> + Files: lib/Test/Harness.pm + + Title: "ExtUtil::Install sub my_cmp needs to binmode its files" + From: Gurusamy Sarathy , Stephen Potter + + Msg-ID: <199710010617.BAA02037@psisa.psa.pencom.com>, + <199710011819.OAA03288@aatma.engin.umich.edu> + Files: lib/ExtUtils/Install.pm + + Title: "Enable make test "TEST_FILES=t/*.t.were_failing"" + From: Ilya Zakharevich + Msg-ID: <199710032231.SAA15364@monk.mps.ohio-state.edu> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Fix for autouse.pm" + From: Ilya Zakharevich + Msg-ID: <199710071734.NAA19462@monk.mps.ohio-state.edu> + Files: lib/autouse.pm + + Title: "Math::Complex fixes - fixes problems on m68-linux" + From: Jarkko Hietaniemi + Msg-ID: <199709301422.HAA24368@koah.research.nokia.com> + Files: lib/Math/Complex.pm + + Title: "Updated CPAN.pm for 5.004_04" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: lib/CPAN.pm lib/CPAN/FirstTime.pm + + Title: "debugger bug with 'c subname'" + From: Ilya Zakharevich + Msg-ID: <199709232331.TAA04546@monk.mps.ohio-state.edu> + Files: lib/perl5db.pl + + Title: "Fix atan2 & restrict $t to (-pi,pi] instead of to [-pi,pi]" + From: Daniel S. Lewart, Jarkko Hietaniemi + + Msg-ID: <199710010939.CAA00964@koah.research.nokia.com> + Files: lib/Math/Complex.pm + + Title: "Cwd::fastcwd needs changes to work with tainting" + From: Hugo van der Sanden , Ulrich Pfeifer + , Tim Bunce + Msg-ID: + Files: lib/Cwd.pm + + Title: "use autouse: requires prototype now" + From: user@agate.berkeley.edu + Msg-ID: <9709220450.AA0380@tuzik.HIP.Berkeley.EDU> + Files: lib/autouse.pm + + Title: ""use base qw(Foo Bar);" to set @ISA at compile time" + From: Gisle Aas , Graham Barr , Graham Barr + , Tim Bunce , + jan.dubois@ibm.net (Jan Dubois), larry@wall.org (Larry + Wall) + Msg-ID: <199710022151.WAA21250@toad.ig.co.uk>, + <199710031613.JAA11286@wall.org>, + <199710040829.KAA16739@furu.g.aas.no>, + <3434E4C6.AE24135E@ti.com>, <343C2278.7DC1ADC6@pobox.com>, + <343ec306.50394803@smtp-gw01.ny.us.ibm.net> + Files: lib/base.pm + + Title: "Further Math/Complex.pm enhancements" + From: Jarkko Hietaniemi + Msg-ID: <199710132055.XAA02086@alpha.hut.fi> + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Further Math::Complex fixes" + From: Jarkko Hietaniemi + Msg-ID: <199710120933.MAA01165@alpha.hut.fi> + Files: lib/Math/Complex.pm + + ------ OTHER CHANGES ------ + + Title: "POD patches w.r.t. $^S" + From: Ilya Zakharevich + Msg-ID: <199710030001.UAA14241@monk.mps.ohio-state.edu> + Files: ../pod/perlfunc.pod ../pod/perlvar.pod + + Title: "libperl.sl on HP-UX 10.20" + From: "Darren/Torin/Who Ever..." , Hugo van der Sanden + + Msg-ID: <199709250003.BAA18085@crypt.compulink.co.uk>, + <873emkbpit.fsf@perv.daft.com> + Files: + + Title: "myconfig / perl -V: remove randbits and add prototype" + From: Tim Bunce + Msg-ID: <199709290857.JAA07706@toad.ig.co.uk> + Files: myconfig + + Title: "Emacs CPerl update for 5.004_04" + From: Ilya Zakharevich + Msg-ID: <199710140835.EAA26825@monk.mps.ohio-state.edu> + Files: emacs/cperl-mode.el + + Title: "Enhance perly.fixer to help porters." + From: Tim Bunce + Files: perly.fixer + + ------ PORTABILITY - WIN32 ------ + + Title: "Fix win32/Makefile for perl95" + From: Gurusamy Sarathy + Files: win32/Makefile win32/makefile.mk + + Title: "Win32 archnames" + From: Bill Middleton , Gurusamy Sarathy + , Peter Prymmer , Tim + Bunce + Msg-ID: <199709111929.PAA22488@aatma.engin.umich.edu>, + <341719E4.4923@forte.com>, + + Files: win32/config_H.bc win32/config_H.vc + + Title: "pl2bat.bat -> pl2bat.pl change in win32/pod.mak" + From: jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <3411ee6f.9143607@smtp-gw01.ny.us.ibm.net> + Files: win32/pod.mak + + Title: "Add test-notty target to Win32 Makefile" + From: jan.dubois@ibm.net (Jan Dubois) + Msg-ID: <343f5106.12461608@smtp2.ibm.net> + Files: win32/Makefile + + Title: "Bug in Win32::GetShortPathName" + From: Gurusamy Sarathy + Msg-ID: <199710092229.SAA21556@aatma.engin.umich.edu> + Files: win32/win32.c + + Title: "Fix NT handles leak." + From: Gurusamy Sarathy + Msg-ID: <199710111319.JAA10918@aatma.engin.umich.edu> + Files: win32/win32io.c win32/win32sck.c + + Title: "fix socket init duality on win32" + From: Gurusamy Sarathy + Msg-ID: <199710111523.LAA12407@aatma.engin.umich.edu> + Files: win32/win32sck.c + + ------ PORTABILITY - GENERAL ------ + + Title: "Tweak to hints/machten.sh: stop t/lib/complex.t from failing" + From: Dominic Dunlop + Msg-ID: + Files: hints/machten.sh + + Title: "Irix 6.2 build problem - so_locations" + From: "Billinghurst, David" + Msg-ID: + Files: hints/irix_6.sh + + Title: "Porting/pumpkin.pod version 1.13" + From: Andy Dougherty + Msg-ID: + Files: Porting/pumpkin.pod + + Title: "lib/timelocal.t fails test 1 for VMS 7.1" + From: Dan Sugalski + Msg-ID: <3.0.3.32.19970908112449.0087bc90@stargate.lbcc.cc.or.us> + Files: vms/vmsish.h vms/vms.c + + Title: "Patches to updated README.VMS for Perl 5.004_04" + From: Dan Sugalski + Msg-ID: <3.0.3.32.19970918100648.008b1c60@stargate.lbcc.cc.or.us> + Files: README.vms + + Title: "Fix perl build on Digital UNIX after JDK installs libnet.so" + From: Spider Boardman + Msg-ID: <199709191826.OAA18040@Orb.Nashua.NH.US> + Files: hints/dec_osf.sh + + Title: "Updated README.VMS for Perl 5.004_04" + From: Dan Sugalski + Msg-ID: <3.0.3.32.19970912091524.008a3620@stargate.lbcc.cc.or.us> + Files: README.vms + + Title: "Dynixptx hints" + From: bruce@aps.org ("Bruce P. Schuck") + Msg-ID: + Files: hints/dynixptx.sh + + Title: "Minor OS/2 patch for 4_03" + From: Ilya Zakharevich + Msg-ID: <199710032224.SAA15345@monk.mps.ohio-state.edu> + Files: os2/os2.c + + Title: "OS2::REXX improvements" + From: Ilya Zakharevich + Msg-ID: <199709272214.SAA08638@monk.mps.ohio-state.edu> + Files: os2/Changes os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm + + Title: "hints/qnx.sh update" + From: Norton Allen + Msg-ID: <199709261508.LAA07889@dolores.harvard.edu> + Files: hints/qnx.sh + + Title: "New hints file for IBM OS/390 OpenEdition (MVS)" + From: pvhp@forte.com (Peter Prymmer) + Msg-ID: <9709240106.AA26484@forte.com> + Files: hints/os390.sh + + Title: "OS/2 Hints" + From: Ilya Zakharevich + Msg-ID: <199710130631.CAA25426@monk.mps.ohio-state.edu> + Files: hints/os2.sh + + ------ TESTS ------ + + Title: "op/glob.t test failure under Win32 with CVS" + From: Warren Jones + Msg-ID: <97Aug26.091048pdt.35761-1@gateway.fluke.com> + Files: t/op/glob.t + + Title: "tests fail if localhost/loopback address not defined" + From: David McLean >, David McLean + + Msg-ID: <34048947.2944@icc.gsfc.nasa.gov> + Files: t/lib/io_sock.t t/lib/io_udp.t + + Title: "Improve pragma/locale test 102 - and don't fail, just warn" + From: Jarkko Hietaniemi + Files: t/pragma/locale.t + + Title: "Invalid test output in t/op/taint.t in trial 1" + From: Dan Sugalski + Msg-ID: <3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us> + Files: t/op/taint.t + + Title: "Identify t/*/*.t test failing because of file permissions" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: t/TEST + + Title: "fix poor t/op/runlevel.t test" + From: Gurusamy Sarathy , Hugo van der Sanden + , Norton Allen + + Msg-ID: <199709261458.KAA28611@dolores.harvard.edu> + Files: t/op/runlevel.t + + ------ UTILITIES ------ + + Title: "Missing 'require' in auto-generated .pm by h2xs" + From: davidk@tor.securecomputing.com (David Kerry) + Msg-ID: <97Aug27.131618edt.11650@janus.tor.securecomputing.com> + Files: utils/h2xs.PL + + Title: "Perldoc tiny patch to avoid $0" + From: Ilya Zakharevich + Msg-ID: <199709122141.RAA16846@monk.mps.ohio-state.edu> + Files: utils/perldoc.PL + + Title: "h2ph broken in 5.004_02" + From: David Mazieres , + kstar@www.chapin.edu (Kurt D. Starsinic) + Msg-ID: <199708201454.KAA05122@reeducation-labor.lcs.mit.edu>, + <199708201700.KAA02621@www.chapin.edu> + Files: utils/h2ph.PL + + Title: "add key_t caddr_t to h2ph", "eg/sysvipc/ipcsem bug", "update + hints/bsdos.sh" + From: Tony Sanders + Msg-ID: <199708272301.RAA12803@austin.bsdi.com> + Files: eg/sysvipc/ipcsem utils/h2ph.PL + + Title: "perldoc search ., lib and blib/* if -f 'Makefile.PL'" + From: Tim Bunce + Msg-ID: <199708251732.KAA19299@gadget.cscaper.com> + Files: utils/perldoc.PL + + Title: "5.004m4t1: perlbug: NIS domainname gets into wrong places" + From: koenig@anna.mind.de (Andreas J. Koenig) + Msg-ID: + Files: utils/perlbug.PL + + Title: "add better local patch info to perlbug", "perlbug checks perl + build/run version changes" + From: Tim.Bunce@ig.co.uk + Files: utils/perlbug.PL + + Title: "perldoc - suggest modules if requested module not found" + From: Anthony David + Msg-ID: <3439CD83.6969@netinfo.com.au> + Files: utils/perldoc.PL + + Title: "perldoc mail::foo tries to read binary /usr/ucb/mail" + From: "Joseph Moof-in' Hall" , Tim Bunce + Msg-ID: <199710082014.NAA00808@gadget.cscaper.com> + Files: utils/perldoc.PL + + Title: "perldoc -f setpwent (for example) returns no descriptive text" + From: Tim Bunce + Files: utils/perldoc.PL + + Title: "perldoc diffs: don't search auto - much faster" + From: "Joseph N. Hall" + Msg-ID: + Files: utils/perldoc.PL + + + +---------------- +Version 5.004_03 Maintenance release 3 for 5.004 +---------------- + +"To err is human, to forgive divine." + -- Alexander Pope + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + Fixed 5.004_02 compilation failure on VMS. + Fixed Configure (non)errors being displayed to user. + Better support for Windows 95. + Assorted documentation and hint file improvements. + perl --foo no longer silently ignored. + + + ------ BUILD PROCESS ------ + + Title: "Show Configure failure reason even with -s" + From: Andy Dougherty + Msg-ID: + Files: Configure + + Title: "Configure can stop without fully explaining itself" + From: Jim Anderson + Msg-ID: <199708111328.JAA28976@nsd15.ny-swaps-develop.ml.com>, + <199708111952.PAA29346@nsd15.ny-swaps-develop.ml.com> + Files: Configure + + ------ CORE LANGUAGE ------ + + Title: "typos in perl -h output" + From: "Richard A. Wells" + Msg-ID: <6D0BF914BC@gateuhs.harvard.edu> + Files: perl.c + + Title: "Some perldb -> PERLDB_* macro changes were missed" + From: Ilya Zakharevich + Msg-ID: <199708100323.XAA27155@monk.mps.ohio-state.edu> + Files: pp_ctl.c + + Title: "Further fix to lseek's in lockf_emulate_flock" + From: Hallvard B Furuseth + Msg-ID: <199708060031.CAA07387@bombur2.uio.no>, + <199708102225.AAA16970@bombur2.uio.no> + Files: pp_sys.c + + Title: "GNU style perl --version (or any other --foo) ignored" + From: "M.J.T. Guy" , Kenneth Albanowski + , Stephen McCamant + Msg-ID: , + , + + Files: pod/perldiag.pod perl.c + + Title: "seen_dot declaration in perl.c needed for VMS" + From: Gurusamy Sarathy + Msg-ID: <199708072033.QAA09167@aatma.engin.umich.edu> + Files: perl.c + + ------ DOCUMENTATION ------ + + Title: "[PATCH] -D info in perlrun", "[PATCH] Re: -D info in perlrun" + From: Stephen McCamant , ilya@math.ohio-state.edu (Ilya + Zakharevich) + Msg-ID: <1997Aug10.195832.2224477@hmivax.humgen.upenn.edu>, + , + + Files: pod/perlrun.pod + + Title: "perlop pod inconsistent in presentation of regexp options" + From: "M.J.T. Guy" , Hans Mulder , + jmr@whirlwind.fmr.com + Msg-ID: <199708061404.KAA06717@whirlwind.fmr.com>, + <199708081505.LAA09810@whirlwind.fmr.com>, + <1997Aug7.160530.2196011@hmivax.humgen.upenn.edu>, + , + + Files: pod/perlop.pod + + Title: "pod2man generated .IX lines upset whatis on Solaris" + From: "M.J.T. Guy" , jmr@whirlwind.fmr.com (John + Redford) + Msg-ID: + Files: pod/pod2man.PL + + Title: "The description of the \Q metacharacter is confusing to novices" + From: aml@world.std.com (Andrew M. Langmead) + Msg-ID: <199708101946.AA06339@world.std.com> + Files: pod/perlre.pod + + Title: "doc patch for pack("p",undef) packing a NULL pointer" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9708102159.AA11726@claudius.bfsec.bt.co.uk> + Files: pod/perldelta.pod pod/perlfunc.pod + + Title: "perlfunc.pod error" + From: Tom Christiansen + Msg-ID: <199708102235.QAA18420@jhereg.perl.com> + Files: pod/perlfunc.pod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "patch for documentation error in FileCache.pm" + From: Mike Stok , mikebo@tellabs.com + Msg-ID: + Files: lib/FileCache.pm + + Title: "[PATCH] 5.004_02: Complex/Trig: update" + From: Jarkko Hietaniemi + Msg-ID: <199708081842.VAA31214@alpha.hut.fi> + Files: lib/Math/Complex.pm lib/Math/Trig.pm t/lib/complex.t + + Title: "CPAN Use of uninitialized value in newest perl" + From: tom@amber.ssd.hcsc.com (Tom Horsley) + Msg-ID: <9708091738.AA16435@amber.ssd.hcsc.com> + Files: lib/CPAN.pm + + ------ PORTABILITY - WIN32 ------ + + Title: "[PATCH] /x is not a valid shell switch on Win95" + From: Gurusamy Sarathy + Msg-ID: <199708121720.NAA14760@aatma.engin.umich.edu> + Files: win32/win32.c + + Title: "[PATCH] Win95-proofing pl2bat" + From: Gurusamy Sarathy + Msg-ID: <199708121733.NAA14888@aatma.engin.umich.edu> + Files: MANIFEST win32/Makefile win32/makefile.mk win32/bin/pl2bat.pl + win32/bin/runperl.pl win32/bin/search.pl + win32/bin/webget.pl + + Title: "[PATCH] [OK] Perl5.004_02 on Alpha NT" + From: wmiddlet@adobe.com (William Middleton) + Msg-ID: <199708072100.OAA13141@ducks> + Files: win32/win32.c + + ------ PORTABILITY - OTHER ------ + + Title: "Improve dual-universe comments in hints/sunos_4_1.sh" + From: Andy Dougherty + Msg-ID: + Files: hints/sunos_4_1.sh + + Title: "Dynamic Loading on MkLinux (osname=linux,archname=ppc-linux)" + From: Chris Nandor , Shimpei Yamashita + + Msg-ID: <33EF1634.B36B6500@pobox.com> + Files: hints/linux.sh + + Title: "5.004_02 Configure - worrying but normal errors displayed to user" + From: Paul Marquess , pmarquess@bfsec.bt.co.uk + (Paul Marquess) + Msg-ID: <01BCA3DE.E257BFC0.pmarquess@bfsec.bt.co.uk>, + <9708102159.AA11726@claudius.bfsec.bt.co.uk> + Files: Configure os2/diff.configure + + Title: "Minor glitch with Perl 5.004_01 on SunOS 4.1.3 (groupstype)" + From: thad@thadlabs.com (Thad Floryan) + Msg-ID: <9708111415.AA03808@thadlabs.com> + Files: hints/sunos_4_1.sh + + Title: "SCO Openserver 5.0.4 - add comment to hint file re compiler bug" + From: Bill Glicker + Msg-ID: + Files: hints/sco.sh + + ------ UTILITIES ------ + + Title: "perlbug -d non-interactive (with patch)" + From: Ted Ashton + Msg-ID: <199708071418.KAA15711@ns.southern.edu> + Files: utils/perlbug.PL + + + +---------------- +Version 5.004_02 Maintenance release 2 for 5.004 +---------------- + +"When you work you are a flute through whose + heart the whispering of the hours turns to music." + -- from The Prophet by Kahlil Gibran + + + HEADLINES FOR THIS MAINTENANCE RELEASE + + Major memory growth bug fixed. + Object destruction is more timely and orderly. + Further major enhancements to Win32 support, including: + Win32 binary compatibility between Visual C++ and Borland C++. + The -S option is now more useful on dos/Win32 (see perlrun). + Implicit -p print now checks for write errors. + DB_File now sub-classable (and other fixes). + Memory usage stats available with perl's malloc (see perldelta). + 'use UNIVERSAL;' deprecated (see perldelta). + Internal integer to string conversions are faster. + Carp can be forced to give stack traces (see perldoc Carp). + Many other bug fixes and enhancements. + + + ------ BUILD PROCESS ------ + + Title: "[PATCH] m2t3: Configure: cf_time always in C locale" + From: Jarkko Hietaniemi + Msg-ID: <199708061827.VAA09623@alpha.hut.fi> + Files: Configure + + Title: "Configure can't find open3 on NeXTstep" + From: Andy Dougherty , hans@icgned.nl + (Hans Mulder) + Msg-ID: <9706271816.AA10551@ icgned.icgned.nl > + Files: Configure + + Title: "Don't use undef value in Config::myconfig" + From: "Andreas J. Koenig" , Chip Salzenberg + + Msg-ID: <199706271525.RAA13517@sissy.in-berlin.de> + Files: configpm + + Title: "make Configure recognize powerux hint (perl5.004_01)" + From: tom@amber.ssd.hcsc.com (Tom Horsley) + Msg-ID: <9707301938.AA08352@amber.ssd.hcsc.com> + Files: Configure + + Title: "[PATCH]: HP-UX 10 w/o transition links" + From: Jeff Okamoto + Msg-ID: <199706181851.AA093329906@hpcc123.corp.hp.com>, + <199706231650.AA070364627@hpcc123.corp.hp.com> + Files: Configure + + Title: "INSTALL updates for GNU ld and __inet_* errors" + From: Andy Dougherty + Files: INSTALL + + ------ CORE LANGUAGE ------ + + Title: "[PATCH] Additional patch for "Can't execute ..."" + From: Ilya Zakharevich + Msg-ID: <199707191651.MAA04897@monk.mps.ohio-state.edu> + Files: pod/perldiag.pod perl.c + + Title: "[PATCH] Band-aid fix for local([@%]$x)" + From: Stephen McCamant + Msg-ID: + Files: pod/perldiag.pod op.c pp_hot.c t/op/local.t + + Title: "[PATCH] Re: Bug in Regular Expressions when using colon as + delimiter" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perldiag.pod regcomp.c t/op/re_tests t/op/regexp.t + + Title: "[PATCH] Re: Can't pack literals as pointers" + From: Gurusamy Sarathy + Msg-ID: <199708012250.SAA20278@aatma.engin.umich.edu> + Files: pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t + + Title: "[PATCH] Do not constant-fold ops that depend on locale if C" + From: Chip Salzenberg + Msg-ID: <199707210519.BAA13785@nielsenmedia.com> + Files: op.c + + Title: "Eval fails in certain situations (eval "{'...")" + From: Gurusamy Sarathy + Msg-ID: <199707211753.NAA14940@aatma.engin.umich.edu> + Files: t/comp/term.t toke.c + + Title: "Fix memory leak on eval 'sub {}'" + From: Chip Salzenberg + Files: pp_ctl.c + + Title: "stringify looses integerness" + From: Gisle Aas + Msg-ID: + Files: sv.c + + Title: "Fix intolerance of a space between "print" and opening paren" + From: Gurusamy Sarathy + Msg-ID: <199707011421.KAA15836@aatma.engin.umich.edu> + Files: toke.c + + Title: "[PATCH] Re: Calling Perl from within C from within Perl" + From: Gurusamy Sarathy + Msg-ID: <199706301842.OAA05569@aatma.engin.umich.edu> + Files: perl.c + + Title: "UNIVERSAL.pm and import methods (tests)" + From: "M.J.T. Guy" + Msg-ID: + Files: t/op/universal.t universal.c + + Title: "Avoid core dump on some paren'd regexp matches", "One-liner regex + causes SEGV on 5.003 under HP-UX and Linux" + From: Hugo van der Sanden + Msg-ID: <199706261236.NAA03472@crypt.compulink.co.uk>, + <199707061144.MAA04443@crypt.compulink.co.uk> + Files: regexec.c t/op/re_tests + + Title: "Forbid negative splice offset beyond array start" + From: "John L. Allen" , Chip Salzenberg + + Msg-ID: + Files: pp.c + + Title: "Forbid "goto" into middle of foreach loop" + From: Chip Salzenberg + Files: pod/perldiag.pod pp_ctl.c + + Title: "Fix C" + From: Chip Salzenberg + Files: toke.c + + Title: "bless file handles as FileHandle if loaded else IO::Handle" + From: Gisle Aas + Msg-ID: + Files: gv.c lib/FileHandle.pm + + Title: "infinite recursion in malloc() with some compile flags" + From: Hans Mulder + Msg-ID: <199706240050.CAA10550@xs2.xs4all.nl> + Files: malloc.c + + Title: "sv_vcatpvfn hogs memory [Patch included]" + From: Matthias Neeracher + Msg-ID: <199706211521.RAA12778@solar.ethz.ch> + Files: sv.c + + Title: "Fix '-' flag on sprintf() of floats" + From: Chip Salzenberg , Jarkko Hietaniemi + + Msg-ID: <199705270646.JAA02510@alpha.hut.fi> + Files: sv.c + + Title: "Free temps before calling END blocks", "Too late destruction" + From: Chip Salzenberg + Msg-ID: + Files: perl.c + + Title: "Fix C parsing" + From: "Chuck D. Phillips (NON-HP Employee)" , Chip + Salzenberg + Msg-ID: <199706121737.KAA00503@palrel3.hp.com> + Files: toke.c + + Title: "Fix lockf_emulate_flock() positioning" + From: Chip Salzenberg , gen@atd.rdc.ricoh.co.jp + Msg-ID: <199706091132.UAA00895@wampa.atd.rdc.ricoh.co.jp> + Files: pp_sys.c + + Title: "Don't use atol() for unsigned values", "signedness problem in + pack("N", "value");" + From: Chip Salzenberg , Roger Espel Llima + + Msg-ID: <19970531200007.40218@llaic.univ-bpclermont.fr> + Files: sv.c + + Title: "Don't warn about "${foo}" in string, even if &foo exists" + From: Chip Salzenberg + Files: toke.c + + Title: "[PATCH] -p does not check for failure of implicit print" + From: Dominic Dunlop + Msg-ID: + Files: pod/perldiag.pod pod/perlrun.pod toke.c + + Title: "Fix double form() in XS version check" + From: Ilya Zakharevich + Msg-ID: <199707150010.UAA00816@monk.mps.ohio-state.edu> + Files: XSUB.h + + Title: "Constant-fold sprintf()" + From: Chip Salzenberg + Files: opcode.pl + + Title: "[PATCH] Fix double form() in XS version check" + From: Chip Salzenberg + Msg-ID: <199707210518.BAA13771@nielsenmedia.com> + Files: XSUB.h + + Title: "[PATCH] Make DEBUGGING_MSTATS info consistent" + From: Andy Dougherty + Msg-ID: + Files: INSTALL pod/perldelta.pod perl.h + + Title: "Minor Win32 glitch with -S flag" + From: Warren Jones + Msg-ID: <97Jun19.150511pdt.35717-2@gateway.fluke.com> + Files: perl.c + + Title: "Slightly safer signals" + From: Ilya Zakharevich + Files: mg.c perl.c + + Title: "Time::Local patch (plus perl.c and filehand.t)" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Files: lib/Time/Local.pm perl.c t/lib/filehand.t + + Title: "[PATCH] Weirdness in sv_peek()" + From: Stephen McCamant + Msg-ID: , + + Files: sv.c + + Title: "Win32 UNC path causes autoload to fail" + From: Warren Jones + Msg-ID: <97Jun18.163826pdt.35714-1@gateway.fluke.com> + Files: pp_ctl.c + + Title: "[PATCH]: reduced malloc patch" + From: Ilya Zakharevich + Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu> + Files: av.c + + Title: "[PATCH] $\1 and serious bug in evalling" + From: Ilya Zakharevich + Msg-ID: <199707262127.RAA12883@monk.mps.ohio-state.edu> + Files: pp_ctl.c + + Title: "Faster int to string conversion", "[PATCH} Re: memory leak in buffer + safety code" + From: Chip Salzenberg , Hugo van der Sanden + , Tim Bunce + Msg-ID: <199707140912.KAA09935@crypt.compulink.co.uk>, + <199707142050.QAA20976@rio.atlantic.net>, + <199707182035.VAA20990@crypt.compulink.co.uk>, + <9707151040.AA02883@toad.ig.co.uk> + Files: global.sym sv.c + + Title: "object never destructs" + From: Gurusamy Sarathy + Msg-ID: <199707131955.PAA29655@aatma.engin.umich.edu> + Files: scope.c t/op/ref.t + + Title: "[PATCH] -S flag fixes for DOSISH platforms", "[RESEND] [PATCH] -S + flag fixes for DOSISH platforms" + From: Gurusamy Sarathy + Msg-ID: <199707250043.UAA02385@aatma.engin.umich.edu>, + <199707301828.OAA19508@aatma.engin.umich.edu> + Files: pod/perldiag.pod pod/perlrun.pod perl.c + + Title: "Perldb internal flag rehaul" + From: Ilya Zakharevich + Files: pod/perldebug.pod pod/perlvar.pod perl.h gv.c mg.c op.c perl.c + pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c + + Title: "[PATCH] Re: q and escaping paired delimiters" + From: Gurusamy Sarathy , Kenneth Albanowski + + Msg-ID: <199707280516.BAA14055@aatma.engin.umich.edu>, + , + + Files: t/base/lex.t toke.c + + Title: "Enable PERL_DEBUG_MSTATS without -DDEBUGGING_MSTATS" + From: Ilya Zakharevich + Msg-ID: <199707150829.EAA01291@monk.mps.ohio-state.edu> + Files: malloc.c perl.c + + Title: "semctl broken under Linux" + From: Andreas Schwab , Andreas + Schwab , Graham + Barr , Tim Bunce + Msg-ID: <33C38291.2D9302DA@ti.com>, + <9707040912.AA03470@issan.informatik.uni-dortmund.de>, + <9707041538.AA08946@toad.ig.co.uk>, + <9707070924.AA11774@issan.informatik.uni-dortmund.de>, + <9707090933.AA19012@issan.informatik.uni-dortmund.de> + Files: doio.c + + Title: "[PATCH] m2t2: problem in NetBSD 1.2D with sfio" + From: Jarkko Hietaniemi + Files: perl.h + + Title: "fix substr fix (tests 27 etc)", "perl5.004_02 trial 1 available + (with substr bug and still some" + From: "M.J.T. Guy" , Hugo van der Sanden + , Jarkko Hietaniemi + Msg-ID: <199707301759.SAA02899@crypt.compulink.co.uk>, + <199707302228.BAA18032@alpha.hut.fi>, + <199707310929.KAA06515@crypt.compulink.co.uk>, + + Files: pp.c + + Title: "Fwd: substr("foo", -1000)", "substr: warn if substring doesn't + intersect original at all" + From: "M.J.T. Guy" , Jarkko Hietaniemi + Msg-ID: <199707100655.JAA14924@alpha.hut.fi>, + + Files: pod/perlfunc.pod pp.c t/op/substr.t + + Title: "[PATCH] work around compiler bug on CX/UX (perl5.004_01)" + From: tom@amber.ssd.hcsc.com (Tom Horsley) + Msg-ID: <9707301934.AA18594@amber.ssd.hcsc.com> + Files: hints/cxux.sh pp.c + + ------ DOCUMENTATION ------ + + Title: "Duplicates in perlguts.pod" + From: hans@icgned.nl (Hans Mulder) + Msg-ID: <9707082346.AA13231@ icgned.icgned.nl > + Files: pod/perlguts.pod + + Title: "Better "Can't locate auto/%s.al in @INC" error documentation" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Jun24.195847.2091744@hmivax.humgen.upenn.edu> + Files: pod/perldiag.pod + + Title: "new perlembed.pod:match.c" + From: Doug MacEachern + Msg-ID: <199707170355.XAA21370@postman.opengroup.org> + Files: pod/perlembed.pod + + Title: "Document bug fix in localization of $1 etc." + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "[PATCH] Major goof in XS Tutorial regarding subdirs" + From: Ilya Zakharevich + Msg-ID: <199707260920.FAA12453@monk.mps.ohio-state.edu> + Files: pod/perlxstut.pod + + Title: "[PATCH] Magic info in perlguts, take 2" + From: Stephen McCamant + Msg-ID: + Files: pod/perlguts.pod + + Title: "[BUG:PATCH] Missing semicolon message wrong in perldiag" + From: "M.J.T. Guy" + Msg-ID: , + + Files: pod/perldiag.pod + + Title: "[PATCH] Updates to perlguts (repost)" + From: Ilya Zakharevich + Msg-ID: <199707152223.SAA00776@monk.mps.ohio-state.edu> + Files: pod/perlguts.pod + + Title: "[BUG:47:LOG] Dropped "and" in pod2man" + From: hans@icgned.nl (Hans Mulder) + Msg-ID: <9707082355.AA13254@ icgned.icgned.nl > + Files: pod/pod2man.PL + + Title: "[BUG] perlembed.pod:power.c example" + From: Doug MacEachern + Msg-ID: <199707181344.JAA10565@postman.opengroup.org> + Files: pod/perlembed.pod + + Title: "[PATCH] arguments swapped in perlapio.pod" + From: Hans Mulder + Msg-ID: <199706240049.CAA10534@xs2.xs4all.nl> + Files: pod/perlapio.pod + + Title: "[PATCH] cool quote for perldebug" + From: Greg Bacon + Msg-ID: <199707292140.QAA28579@adtrn-srv4.adtran.com> + Files: pod/perldebug.pod + + Title: "[PATCH] multiline commands in qx//" + From: Gurusamy Sarathy + Msg-ID: <199707212350.TAA18496@aatma.engin.umich.edu> + Files: pod/perlfunc.pod pod/perlop.pod + + Title: "patch to 5.004_01 perltrap.pod" + From: jmm@revenge.elegant.com (John Macdonald) + Msg-ID: <9706231525.AA22790@revenge.elegant.com> + Files: pod/perltrap.pod + + Title: "perl4 to perl5.004 converion with debugger problem" + From: "M.J.T. Guy" + Msg-ID: + Files: pod/perltrap.pod + + Title: "done3/perlbook.pod" + From: Randal Schwartz + Files: pod/perlbook.pod + + Title: "[PATCH] readline and readpipe are undocumented" + From: Hans Mulder + Files: pod/perlfunc.pod + + Title: "Document use of - in a regex char class." + From: Dominic Dunlop + Msg-ID: + Files: pod/perlre.pod + + Title: "[PATCH] splitpod broken in 5.004_01" + From: Hans Mulder , Tim Bunce + Msg-ID: <199706240048.CAA10515@xs2.xs4all.nl>, + <9706241612.AA09119@toad.ig.co.uk> + Files: pod/splitpod + + ------ LIBRARY AND EXTENSIONS ------ + + Title: "Carp::cluck() and -MCarp=verbose" + From: Tim.Bunce@ig.co.uk, epeschko@elmer.tci.com (Ed Peschko) + Msg-ID: <199708060607.AAA16681@den-mdev1.tci.com>, + <199708062105.PAA09878@den-mdev1.tci.com> + Files: lib/Carp.pm + + Title: "Warning from calls using "use Shell"" + From: Andrew Pimlott + Msg-ID: + Files: lib/Shell.pm + + Title: "confessing a carp" + From: Chip Salzenberg , Hugo van der Sanden + , Nick Ing-Simmons + , Tim Bunce + Msg-ID: <199708052155.WAA25393@crypt.compulink.co.uk>, + <199708060721.IAA30894@crypt.compulink.co.uk>, + <199708061533.LAA01313@rio.atlantic.net>, + <33E79BE2.4E6F@ni-s.u-net.com>, + <33E8E3C5.62C@ni-s.u-net.com>, + <9708051619.AA13764@toad.ig.co.uk> + Files: lib/Carp.pm + + Title: "[BUG:PATCH] dumpvar.pl parses some references incorrectly" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/dumpvar.pl + + Title: "[PATCH] m2t3: minor doc patch (to obsolete I18N::Collate)" + From: Jarkko Hietaniemi + Msg-ID: <199708060732.KAA02675@alpha.hut.fi> + Files: lib/I18N/Collate.pm + + Title: "[PATCH] Binary installers for Perl modules" + From: Ilya Zakharevich + Msg-ID: <199707210006.UAA06165@monk.mps.ohio-state.edu> + Files: lib/ExtUtils/Install.pm + + Title: "m2t2 broke CPAN.pm :-(" + From: a.koenig@kulturbox.de (Andreas J. Koenig) + Files: lib/CPAN.pm lib/Bundle/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm + + Title: "[PATCH] CPAN.pm on OS/2" + From: "Andreas J. Koenig" , Ilya Zakharevich + + Msg-ID: <199707180415.AAA03180@monk.mps.ohio-state.edu>, + <199707181407.QAA12920@anna.in-berlin.de> + Files: lib/CPAN.pm + + Title: "Docs of IO::Handle [PATCH]" + From: Ilya Zakharevich + Msg-ID: <199707222307.TAA08380@monk.mps.ohio-state.edu> + Files: ext/IO/lib/IO/Handle.pm + + Title: "Exporter errors give wrong location" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Exporter.pm + + Title: "[PATCH] Exporter new export_to_level method" + From: epeschko@elmer.tci.com (Ed Peschko) + Files: lib/Exporter.pm + + Title: "DB_File produces spurious output when trapping __DIE__" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9706302125.AA28254@claudius.bfsec.bt.co.uk> + Files: ext/DB_File/DB_File.pm + + Title: "Remove 'use UNIVERSAL;', switch to UNIVERSAL::isa()" + From: "M.J.T. Guy" + Msg-ID: + Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm + + Title: "perl5.004 Time::Local still broken" + From: Mathias Koerber + Msg-ID: <199706260452.MAA22647@dnssec1.singnet.com.sg> + Files: lib/Time/Local.pm + + Title: "Sys::Hostname should localize $SIG{__DIE__}" + From: Ken Shan + Msg-ID: <199707070357.XAA18065@digitas.harvard.edu> + Files: lib/Sys/Hostname.pm + + Title: "xsubpp patch" + From: John Tobey + Msg-ID: <199707010221.CAA01234@remote133> + Files: lib/ExtUtils/xsubpp + + Title: "DB_File 1.15 patch" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9707192117.AA01973@claudius.bfsec.bt.co.uk> + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DB_File/typemap + t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t + + Title: "Problems with setvbuf" + From: Ilya Zakharevich + Msg-ID: <199707250040.UAA11000@monk.mps.ohio-state.edu> + Files: ext/IO/IO.xs + + Title: "[PATCH] Repost of fork() debugger patch" + From: Ilya Zakharevich + Msg-ID: <199707252101.RAA11846@monk.mps.ohio-state.edu> + Files: lib/perl5db.pl lib/Term/ReadLine.pm + + Title: "IO::File and DB_File pollutes namespace with Fcntl constants" + From: Gisle Aas + Msg-ID: + Files: ext/IO/lib/IO/File.pm + + Title: "[MM] [PATCH] Re: Liblist problems for MSWin32" + From: Gurusamy Sarathy + Msg-ID: <199706182152.RAA20273@aatma.engin.umich.edu> + Files: lib/ExtUtils/Liblist.pm + + Title: "Net::hostent documentation error" + From: gnat@frii.com + Msg-ID: <199707082222.QAA24728@elara.frii.com> + Files: lib/Net/hostent.pm + + Title: "PATCH: make DBM*_File modules sub-classable" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Msg-ID: <9707121854.AA19472@claudius.bfsec.bt.co.uk> + Files: ext/GDBM_File/typemap ext/NDBM_File/typemap + ext/ODBM_File/ODBM_File.xs ext/SDBM_File/typemap + t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t + + Title: "Sys::Syslog patch to allow unix domain sockets" + From: Sean Robinson + Msg-ID: <33B31342.7EB16A44@sc.maricopa.edu> + Files: lib/Sys/Syslog.pm + + Title: "'use UNIVERSAL;' deprecated, do C instead", + "UNIVERSAL.pm and import methods" + From: "M.J.T. Guy" , Gisle Aas , + Graham Barr , Gurusamy Sarathy + , Hugo van der Sanden + + Msg-ID: <199706271701.NAA25664@aatma.engin.umich.edu>, + <199706271904.UAA00120@crypt.compulink.co.uk>, + <199706272054.QAA28913@aatma.engin.umich.edu>, + <199706301554.LAA03763@aatma.engin.umich.edu>, + <33B22248.7D7C1985@ti.com>, + , + , + , + , + , + + Files: lib/Class/Struct.pm lib/File/Compare.pm lib/File/Copy.pm + t/op/universal.t universal.c + + Title: "[MM] Small patch to MakeMaker, new release" + From: "Andreas J. Koenig" + Msg-ID: <199706281603.SAA10869@anna.in-berlin.de> + Files: lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm + lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm + lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm + + Title: "ExtUtils-Embed upgrade" + From: Doug MacEachern + Files: lib/ExtUtils/Embed.pm + + Title: "[PATCH] icmp tweak for IO::Socket" + From: Nick.Ing-Simmons@tiuk.ti.com + Msg-ID: <199707041240.NAA21484@pluto.tiuk.ti.com> + Files: ext/IO/lib/IO/Socket.pm + + Title: "Allow concurrent mkdir in File::Path::mkpath" + From: schattev@imb-jena.de (Ruben Schattevoy) + Msg-ID: <199707300943.LAA21574@kant.imb-jena.de> + Files: lib/File/Path.pm + + Title: "CPAN.pm, $VERSION and nested (bundled) modules." + From: a.koenig@kulturbox.de (Andreas J. Koenig) + Files: lib/ExtUtils/Install.pm lib/ExtUtils/Liblist.pm + lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Mksymlists.pm + + Title: "[PATCH] perl debugger, win32, and emacs" + From: Jay Rogers + Msg-ID: <199707311759.NAA13276@crooked-i.mitre.org> + Files: lib/perl5db.pl + + Title: "[PATCH] pod2html mangles C<&foo(42);>" + From: Hans Mulder + Msg-ID: <199706250057.CAA10162@xs1.xs4all.nl> + Files: lib/Pod/Html.pm + + Title: "[PATCH] posix.xs broken on VMS 7.1" + From: Dan Sugalski + Msg-ID: <3.0.2.32.19970718095755.00875ba0@stargate.lbcc.cc.or.us> + Files: ext/POSIX/POSIX.xs + + Title: "MM_Unix.pm nits for Win32 DMAKE" + From: Gurusamy Sarathy + Msg-ID: <199708032051.QAA14248@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Sys::Hostname -w unclean in trial 2" + From: Gurusamy Sarathy + Msg-ID: <199708032055.QAA14278@aatma.engin.umich.edu> + Files: lib/Sys/Hostname.pm + + Title: "(3) File::Find::find()/finddepth() bugs with toplevel paths" + From: "Conrad E. Kimball" + Msg-ID: <199707040045.RAA24459@mailgate2.boeing.com> + Files: lib/File/Find.pm + + ------ OTHER CHANGES ------ + + Title: "EMERGENCY_SBRK or PERL_EMERGENCY_SBRK ?" + From: Andy Dougherty , + ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Aug1.191631.2167470@hmivax.humgen.upenn.edu>, + + Files: + Files: + + ------ PORTABILITY - WIN32 ------ + + Title: "[PATCH] Embedding threaded apps in perl.dll" + From: Gurusamy Sarathy + Msg-ID: <199707261518.LAA24346@aatma.engin.umich.edu>, + <199707301833.OAA19570@aatma.engin.umich.edu> + Files: win32/win32.c + + Title: "Minor fix for pl2bat.bat", "[PATCH] Re: Minor fix for pl2bat.bat" + From: Gurusamy Sarathy , Warren Jones + + Msg-ID: <199707061843.OAA23874@aatma.engin.umich.edu>, + <97Jun24.115804pdt.35752-2@gateway.fluke.com> + Files: win32/bin/pl2bat.bat + + Title: "WIN32 Build - pod2xxx.bat Missing?", "[PATCH] Re: WIN32 Build - + pod2xxx.bat Missing?" + From: Chris Williams , Gurusamy Sarathy + + Msg-ID: <199707011423.KAA15855@aatma.engin.umich.edu>, + <33B8B962.D96FA1F5@netinfo.com.au> + Files: win32/Makefile win32/makefile.mk + + Title: "[PATCH] Win32 sitelib intuition from DLL location" + From: Gurusamy Sarathy + Msg-ID: <199706231647.MAA23260@aatma.engin.umich.edu> + Files: win32/win32.h win32/config_h.PL win32/win32.c + + Title: "[PATCH] binary coexistence on win32", "[RESEND] [PATCH] binary + coexistence on win32" + From: Gurusamy Sarathy + Msg-ID: <199707250109.VAA02666@aatma.engin.umich.edu>, + <199707301829.OAA19516@aatma.engin.umich.edu> + Files: lib/ExtUtils/Mksymlists.pm win32/win32.h win32/win32io.h + win32/win32iop.h win32/makedef.pl win32/win32.c + win32/win32io.c + + Title: "[PATCH] docs for win32 utilities" + From: Gurusamy Sarathy + Msg-ID: <199707250045.UAA02510@aatma.engin.umich.edu> + Files: win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] exec() fixed on win32" + From: Gurusamy Sarathy + Msg-ID: <199706241525.LAA06554@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32io.h win32/win32iop.h README.win32 doio.c + win32/config_H.bc win32/config_H.vc win32/makedef.pl + win32/win32.c win32/win32io.c + + Title: "[PATCH] getenv() after my_setenv() gets old entry on Win32" + From: Gurusamy Sarathy + Msg-ID: <199706231700.NAA23400@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32.c + + Title: "[PATCH] getservby*() calls fail on Windows NT" + From: Gurusamy Sarathy + Msg-ID: <199706231654.MAA23276@aatma.engin.umich.edu> + Files: win32/win32sck.c + + Title: "[PATCH] minor win32 scribbles" + From: Gurusamy Sarathy , Hugo van der Sanden + + Msg-ID: <199707262307.TAA28410@aatma.engin.umich.edu>, + <199707270832.JAA19399@crypt.compulink.co.uk> + Files: pod/perldelta.pod README.win32 win32/Makefile win32/config.bc + win32/config.vc win32/makefile.mk + + Title: "[PATCH] trial2: some batch files won't run" + From: Gurusamy Sarathy + Msg-ID: <199708040226.WAA17301@aatma.engin.umich.edu> + Files: win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] win32 docs and runperl.bat" + From: Gurusamy Sarathy + Msg-ID: <199707070446.AAA29560@aatma.engin.umich.edu> + Files: MANIFEST README.win32 win32/bin/pl2bat.bat win32/bin/runperl.bat + + Title: "[PATCH] win32 extras and embedding" + From: Gurusamy Sarathy + Msg-ID: <199707250232.WAA03421@aatma.engin.umich.edu>, + <199707301831.OAA19528@aatma.engin.umich.edu> + Files: dosish.h win32/win32.h perl.c win32/config.bc win32/config_H.bc + win32/makedef.pl win32/perllib.c win32/win32.c + + Title: "[PATCH] win32 tweaks" + From: Gurusamy Sarathy + Msg-ID: <199707042150.RAA01065@aatma.engin.umich.edu> + Files: win32/win32.h win32/win32.c + + Title: "[PATCH] win32_stat() fixes (2nd try)" + From: Gurusamy Sarathy + Msg-ID: <199708040137.VAA16810@aatma.engin.umich.edu> + Files: t/op/stat.t win32/win32iop.h win32/win32.c + + ------ PORTABILITY - OTHER ------ + + Title: "Additional OS/2 patches" + From: Gurusamy Sarathy , Ilya Zakharevich + + Msg-ID: <199708020823.EAA19521@monk.mps.ohio-state.edu>, + <199708021424.KAA28561@aatma.engin.umich.edu>, + <199708042108.RAA27671@aatma.engin.umich.edu> + Files: README.os2 os2/Changes perl.c + + Title: "Additional patch is needed for os2/diff.configure" + From: Ilya Zakharevich + Msg-ID: <199708020745.DAA19483@monk.mps.ohio-state.edu> + Files: os2/diff.configure + + Title: "Assorted OS/2 fixes" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Jun16.163234.2091727@hmivax.humgen.upenn.edu> + Files: hints/os2.sh os2/diff.configure os2/os2ish.h README.os2 os2/Changes + os2/Makefile.SHs os2/os2.c util.c + + Title: "[PATCH] Changes for VMS 7.1 support" + From: Charles Bailey , Dan Sugalski + + Msg-ID: <01ILDXUH0J1W00026U@hmivax.humgen.upenn.edu>, + <3.0.2.32.19970718095935.0087a2d0@stargate.lbcc.cc.or.us> + Files: vms/sockadapt.h vms/config.vms vms/sockadapt.c + + Title: "[PATCH] Easier TCP stack selection for VMS" + From: Dan Sugalski + Msg-ID: <3.0.1.32.19970624151939.00994490@stargate.lbcc.cc.or.us> + Files: vms/descrip.mms + + Title: "Minor VMS patches" + From: Charles Bailey + Msg-ID: <01ILCUO6XXTE000WFK@hmivax.humgen.upenn.edu> + Files: lib/ExtUtils/MM_VMS.pm vms/vmsish.h vms/descrip.mms vms/test.com + vms/vms.c vms/ext/filespec.t + + Title: "[PATCH] Two un-disabled tests for VMS" + From: Dan Sugalski + Msg-ID: <3.0.2.32.19970718095842.00879220@stargate.lbcc.cc.or.us> + Files: vms/test.com + + Title: "fixes for hints/svr4 for UnixWare >= 2.1.1" + From: John Hughes + Msg-ID: <199707021230.OAA24230@titanic.AtlanTech.COM> + Files: hints/svr4.sh + + Title: "make depend loop fix and minor OS/2 improvements to build process" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Files: Makefile.SH hints/os2.sh os2/Makefile.SHs + + ------ TESTS ------ + + Title: "Add xor tests to test suite" + From: Hugo van der Sanden + Msg-ID: <199706250730.IAA06097@crypt.compulink.co.uk> + Files: t/comp/cmdopt.t + + Title: "[PATCH] enable some tests on Win32" + From: Gurusamy Sarathy + Msg-ID: <199707250029.UAA02351@aatma.engin.umich.edu> + Files: t/op/magic.t + + Title: "Fix up problems with *DBM tests" + From: Paul Marquess + Files: t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t + + ------ UTILITIES ------ + + Title: "[PATCH] m2t3: utils/perlbug.PL: -ok report is not a bug" + From: Jarkko Hietaniemi + Msg-ID: <199708071022.NAA13008@alpha.hut.fi> + Files: utils/perlbug.PL + + Title: "perlbug - check sendmail and fix win32 tmp path" + From: Gurusamy Sarathy + Msg-ID: <199708060349.XAA15895@aatma.engin.umich.edu> + Files: utils/perlbug.PL + + Title: "OK: perl on (corrected)", "enhancements + to perlbug -ok" + From: "M.J.T. Guy" , Stephen McCamant + Msg-ID: , + , + + Files: utils/Makefile utils/perlbug.PL + + Title: "perlbug -ok [PATCH]" + From: "Charles F. Randall" + Msg-ID: <199706181824.MAA04082@free.click-n-call.com> + Files: utils/perlbug.PL + + Title: "perlbug broken" + From: Andreas Schwab + Msg-ID: <9707040912.AA03466@issan.informatik.uni-dortmund.de> + Files: utils/perlbug.PL + + Title: "[PATCH] perlbug under OS/2" + From: Ilya Zakharevich + Msg-ID: <199707180333.XAA03102@monk.mps.ohio-state.edu> + Files: utils/perlbug.PL + + Title: "perldoc doesn't grok Win32 UNC paths" + From: Warren Jones + Msg-ID: <97Jun17.184420pdt.35728-1@gateway.fluke.com>, + <97Jun18.165618pdt.35713-1@gateway.fluke.com> + Files: utils/perldoc.PL + + Title: "[PATCH] perldoc under OS/2" + From: Ilya Zakharevich + Msg-ID: <199707180340.XAA03114@monk.mps.ohio-state.edu> + Files: utils/perldoc.PL + + Title: "h2ph corrections to avoid redefined sub warnings" + From: wdconsta + Msg-ID: + Files: utils/h2ph.PL + + + +---------------- +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 , Chip Salzenberg + + 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 + Files: sv.c + + Title: "No DESTROY on untie. Tie memory leak fixed." + From: Gurusamy Sarathy , Jay Rogers , + 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 + 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 + Files: pod/perlembed.pod + + Title: "perldiag.pod patch - "(W) substr outside string" is "(S)evere" if + used as lvalue." + From: John Hughes + Files: pod/perldiag.pod + + Title: "local(%ENV) looses magic - document behaviour" + From: Gurusamy Sarathy + Files: pod/perlsub.pod + + Title: "[PATCH] perlguts caveats", "perlguts additions" + From: Gurusamy Sarathy , 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 , Hans Mulder + 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" + Msg-ID: + Files: pod/perlfunc.pod + + Title: "Error in perllol manpage", "Error in perllol manpage (fwd)" + From: Chris Wick + 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 + 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..." , "Paul D. Smith" + , Gurusamy Sarathy + , Jarkko Hietaniemi , + Michael R Cook , 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 + 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 + Files: lib/AutoLoader.pm + + Title: "Memory Consumption of autosplit_lib_modules/sv_gets (workaround)" + From: Matthias Neeracher + 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 , Russ Allbery , + 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." + Msg-ID: <337FBAC8.167EB0E7@monmouth.com> + Files: lib/CPAN.pm + + Title: "[PATCH] Harness.pm bug w/perl5.004 & VMS" + From: Dan Sugalski + 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 + 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 + Msg-ID: + Files: INSTALL + + Title: "improved gnuwin32 Configure support" + From: Chris Faylor + 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 + Files: Configure + + Title: "perl5.004 on AIX: Patches", "perl5.004 on FreeBSD and AIX" + From: Peter van Heusden + Msg-ID: , + + 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=?=) + + Msg-ID: <19970521132814F.matusita@ics.es.osaka-u.ac.jp> + Files: Configure hints/newsos4.sh + + PORTABILITY + + Title: "win32: additional default libraries" + From: Gurusamy Sarathy + Msg-ID: <199705291332.JAA21560@aatma.engin.umich.edu> + Files: lib/ExtUtils/MM_Win32.pm + + Title: "[PATCH] win32 minor fixes" + From: Gurusamy Sarathy + 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 + Files: lib/Term/ReadLine.pm + + Title: "[PATCH] Pod::Text nit for Win32" + From: Gurusamy Sarathy + 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 + Files: lib/ExtUtils/MM_Win32.pm + + Title: "build problem on SGI R10000 PowerChallenge (IRIX 6.2) lseek proto" + From: Jarkko Hietaniemi + Files: doio.c + + Title: "Perl 5.004 + Linux 2.0.30 & semctl()" + From: Andy Dougherty , Jordan + Mendelson + Files: doio.c + + Title: "lib/io_udp.t fails on VMS" + From: Jonathan.Hudson@jrhudson.demon.co.uk + Msg-ID: + Files: pp_sys.c + + Title: "Compilation of mg.c from perl5.004m1t2 fails on OpenVMS/AXP" + From: Henrik Tougaard + Files: mg.c t/op/taint.t + + Title: "[PATCH] (NEXT|OPEN)STEP hints" + From: Gerd Knops + Files: hints/next_3.sh hints/next_4.sh + + Title: "win32: user defined shell" + From: Gurusamy Sarathy + 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 + Files: vms/gen_shrfls.pl + + Title: "[PATCH] win32: Configure cf_email" + From: Gurusamy Sarathy + 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 + Files: README.win32 + + Title: "Document cause and remedy for op/taint.t failure" + From: Gurusamy Sarathy + Files: README.win32 + + Title: "SVR4 hints for DDE SMES Supermax Enterprise Server" + From: Jarkko Hietaniemi + 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 + 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 + 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 + 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 + 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 + Files: win32/win32.c + + Title: "No need to use `pwd` in t/op/magic.t test for amigaos" + From: Norbert Pueschel + Files: t/op/magic.t + + TESTS + + Title: "Tests depend on locale" + From: "Jan D." , Jarkko Hietaniemi + + 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." + Msg-ID: <199705191120.NAA08130@ostrich.gaia.swipnet.se> + Files: t/op/groups.t + + Title: "More simple regexp tests and test docs" + From: Hans Mulder + 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 + Files: t/op/split.t + + UTILITIES + + Title: "bad test of -A flag in h2xs" + From: "Jeffrey S. Haemer" + 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." , Jarkko Hietaniemi + + 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 + + +------------- +Version 5.004 +------------- + +"Hey, Rocky! Watch me pull a release out of my hat!" +"Aww, that trick never works..." + + CORE LANGUAGE CHANGES + + Title: "Make C reset pos on failure; make C not reset" + From: Chip Salzenberg + Files: dump.c op.c op.h pod/perldelta.pod pod/perlfaq6.pod + pod/perlop.pod pod/perlre.pod pp_ctl.c pp_hot.c regcomp.c + t/op/pat.t toke.c + + Title: "SECURITY: Forbid exec() if $ENV{BASH_ENV} is tainted" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlrun.pod pod/perlsec.pod t/op/taint.t + taint.c + + Title: "Allow exec() if $ENV{TERM} is tainted but innocuous" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlrun.pod pod/perlsec.pod t/op/taint.t + taint.c + + Title: "Allow globbing when tainted under VMS (no external program)" + From: Chip Salzenberg + Files: pp_sys.c t/op/taint.t + + CORE PORTABILITY + + Title: "Make Irix hints adapt when n32 libm.so is missing" + From: Chip Salzenberg + Files: hints/irix_6.sh + + Title: "Fix default HP-UX installation path" + From: Jeff Okamoto + Msg-ID: <199705132228.AA227042483@hpcc123.corp.hp.com> + Date: Tue, 13 May 1997 15:28:04 -0700 + Files: hints/hpux.sh + + Title: "VMS update, including socket support (four patches)" + From: Jonathan Hudson , + Peter Prymmer , + Dan Sugalski + Files: vms/config.vms vms/descrip.mms vms/sockadapt.h vms/vms.c + vms/vmsish.h + + Title: "Win32 update (three patches)" + From: Gurusamy Sarathy + Files: README.win32 perl.c win32/Makefile win32/config.H + win32/config_h.PL win32/config_sh.PL win32/makedef.pl + win32/win32.c win32/win32.h win32/win32io.c win32/win32io.h + win32/win32iop.h + + Title: "Don't require executable bit on perl -S if DOSISH" + From: Danny Sadinoff + Msg-ID: <337351CE.79B28DE3@olf.com> + Date: Fri, 09 May 1997 12:33:18 -0400 + Files: perl.c + + OTHER CORE CHANGES + + Title: "In C, always call &func in scalar context" + From: Chip Salzenberg + Files: op.c + + Title: "Fix recursive substitution" + From: Chip Salzenberg; test from Tim Bunce + Files: cop.h global.sym pp_ctl.c proto.h scope.c t/op/subst.t + + Title: "Make read with <> from a TTY notice EOF" + From: Jonathan I. Kamens + Msg-ID: <199705121147.HAA03845@jik.saturn.net> + Date: Mon, 12 May 1997 07:47:13 -0400 + Files: sv.c + + Title: "Fix core dump from get*() functions returning no alias array" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "Fix typo" + From: Mark K Trettin + Msg-ID: <199705102228.RAA11163@gv18c.ih.lucent.com> + Date: Sat, 10 May 1997 17:28:35 -0500 + Files: pp_sys.c + + BUILD PROCESS + + Title: "Don't use 'unset' in Configure" + From: Chip Salzenberg + Files: Configure + + Title: "Protect against having no such command as 'cc'" + From: Hans Mulder + Msg-ID: <1997May12.163534.2006434@hmivax.humgen.upenn.edu> + Date: Mon, 12 May 1997 16:35:34 -0400 (EDT) + Files: Configure + + Title: "minor wording enhancement for Configure" + From: Jarkko Hietaniemi + Msg-ID: <199705101038.NAA00471@alpha.hut.fi> + Date: Sat, 10 May 1997 13:38:31 +0300 (EET DST) + Files: Configure + + LIBRARY AND EXTENSIONS + + Title: "Refresh CGI.pm to 2.36" + From: Lincoln Stein + Files: eg/cgi/frameset.cgi eg/cgi/javascript.cgi lib/CGI.pm + + Title: "In IO::File::open, prepend './' less often (for Win32 et al)" + From: Chip Salzenberg + Files: ext/IO/lib/IO/File.pm + + Title: "Fix core dump on IO::Seekable::setpos($fh, undef)" + From: Chip Salzenberg + Files: ext/IO/IO.xs t/lib/io_xs.t + + TESTS + + Title: "Make rand.t vanishingly unlikely to give false failure" + From: Tom Phoenix + Msg-ID: + Date: Sat, 10 May 1997 19:57:30 -0700 (PDT) + Files: t/op/rand.t + + Title: "Fix sleep test: sleep(N) is defined to allow sleeping N-1" + From: Chuck D. Phillips + Msg-ID: <199705151735.KAA01143@palrel1.hp.com> + Date: Thu, 15 May 1997 11:35:41 -0600 + Files: t/op/sleep.t + + UTILITIES + + Title: "h2xs and @EXPORT_OK" + From: Jeff Okamoto + Msg-ID: <199705092348.AA057881699@hpcc123.corp.hp.com> + Date: Fri, 9 May 1997 16:48:20 -0700 + Files: utils/h2xs.PL + + DOCUMENTATION + + Title: "Tweaks for perldelta" + From: hansm@euronet.nl + Msg-ID: <199705102346.BAA17300@mail.euronet.nl> + Date: Sun, 11 May 97 01:46:00 +0200 + Files: pod/perldelta.pod + + Title: "Mention perlfaq.pod and perlmodlib.pod in perldelta.pod" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Fix example of use of lexicals with formats" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Explain that destruction order is not defined" + From: Gurusamy Sarathy + Msg-ID: <199705150600.CAA13550@aatma.engin.umich.edu> + Date: Thu, 15 May 1997 02:00:23 -0400 + Files: pod/perltoot.pod + + Title: "Note that DATA filehandle is unavailable during BEGIN {}" + From: neilb@cre.canon.co.uk (Neil Bowers) + Msg-ID: <199705121227.NAA29718@tardis.cre.canon.co.uk> + Date: Mon, 12 May 1997 13:27:43 +0100 + Files: pod/perldata.pod + + Title: "More detailed IO::Socket documentation" + From: Tom Christiansen + Msg-ID: <199705141456.IAA19061@jhereg.perl.com> + Date: Wed, 14 May 1997 08:56:30 -0600 + Files: pod/perlipc.pod + + +----------------- +Version 5.003_99a +----------------- + +Herein we find the fruits of the gamma. + + CORE LANGUAGE CHANGES + + Title: "SECURITY: Forbid glob() when tainting (-T or setuid)" + From: Chip Salzenberg + Files: pod/perlrun.pod pod/perlsec.pod pp_sys.c + + Title: "SECURITY: Forbid exec() if $ENV{TERM} or $ENV{ENV} is tainted" + From: Chip Salzenberg + Files: pod/perlrun.pod pod/perlsec.pod t/op/taint.t taint.c + + CORE PORTABILITY + + Title: "(NeXT|Open)Step update" + From: Gerd Knops + Msg-ID: <9705072247.AA18882@BITart.com> + Date: Wed, 7 May 97 17:47:02 -0500 + Files: Configure MANIFEST config_h.SH hints/next_3.sh hints/next_4.sh + + Title: "NetBSD hint update" + From: Giles Lean + Msg-ID: <199705051346.XAA13584@topaz.nemeton.com.au> + Date: Mon, 5 May 1997 23:46:37 +1000 (EST) + Files: hints/netbsd.sh + + Title: "Irix hint update" + From: Scott Henry + Msg-ID: + Date: 06 May 1997 11:09:56 -0700 + Files: hints/irix_6.sh + + Title: "HPUX: patch for ext/DynaLoader/dl_hpux.xs" + From: Chuck D. Phillips + Msg-ID: <199705050548.WAA21260@palrel1.hp.com> + Date: Sun, 4 May 1997 23:48:39 -0600 + Files: ext/DynaLoader/dl_hpux.xs + + Title: "Win32 update (consolidated patch plus three followups)" + From: Gurusamy Sarathy + Files: EXTERN.h README.win32 lib/Sys/Hostname.pm pod/perldelta.pod + win32/config.H win32/config.w32 win32/config_sh.PL win32/perllib.c + win32/win32.c win32/win32.h win32/include/sys/socket.h + + Title: "Win32 boot_DynaLoader problem in 99" + From: Gary Clark + Msg-ID: <1997May05.105000.1708.84476@mail.jeld-wen.com> + Date: Mon, 05 May 1997 10:49:03 -0700 + Files: win32/makedef.pl + + OTHER CORE CHANGES + + Title: "Fix wantarray() in sort subs [fixes metaconfig]" + From: Chip Salzenberg + Files: pp_ctl.c + + Title: "Fix for redefined sort subs nastiness" + From: Gurusamy Sarathy + Msg-ID: <199705090004.UAA15032@aatma.engin.umich.edu> + Date: Thu, 08 May 1997 20:04:18 -0400 + Files: op.c pod/perldelta.pod pod/perldiag.pod sv.c t/op/sort.t + + BUILD PROCESS + + Title: "AFS patches" + From: Chip Salzenberg, Larry Schwimmer + Files: Configure installperl + + LIBRARY AND EXTENSIONS + + Title: "Another blank line patch to Pod::Text" + From: Russ Allbery + Msg-ID: + Date: 08 May 1997 11:36:12 -0700 + Files: lib/Pod/Text.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Three bugs in pod2html" + From: hansm@euronet.nl + Msg-ID: <199705052228.AAA25351@mail.euronet.nl> + Date: Tue, 6 May 97 00:28:06 +0200 + Files: lib/Pod/Html.pm + + Title: "Trivial bugfix for pod of xsubpp" + From: Ralf S. Engelschall + Msg-ID: <199705051447.QAA09995@en1.engelschall.com> + Date: Mon, 5 May 1997 16:47:03 +0200 + Files: lib/ExtUtils/xsubpp + + Title: "Newer CPerl mode" + From: Ilya Zakharevich + Msg-ID: <199705080032.UAA22532@monk.mps.ohio-state.edu> + Date: Wed, 7 May 1997 20:32:46 -0400 (EDT) + Files: emacs/cperl-mode.el + + DOCUMENTATION + + Title: "Updates to perldelta" + From: Chip Salzenberg and Dominic Dunlop + Files: pod/perldelta.pod + + Title: "More explicit Solaris instructions" + From: Andy Dougherty + Msg-ID: + Date: 06 May 1997 23:27:55 +0200 + Files: pod/perlop.pod + + Title: "perlfaq9, hostname" + From: John D Groenveld + Msg-ID: <199705061741.NAA22777@cse.psu.edu> + Date: Tue, 06 May 1997 13:41:12 EDT + Files: pod/perlfaq9.pod + + Title: "Debugger docs patch" + From: Ilya Zakharevich + Msg-ID: <199705080107.VAA24317@monk.mps.ohio-state.edu> + Date: Wed, 7 May 1997 21:07:14 -0400 (EDT) + Files: pod/perldebug.pod + + Title: "Document that C is just like C" + From: Chip Salzenberg + Files: pod/perlop.pod + + Title: "Refresh description of sprintf()" + From: Chip Salzenberg + Files: pod/perl.pod pod/perlfunc.pod + + Title: "Mention the Regular Expressions book" + From: Stephen Potter + Msg-ID: <199705071737.MAA18799@psa.pencom.com> + Date: Wed, 07 May 1997 12:37:37 -0500 + Files: pod/perlbook.pod pod/perlre.pod + + Title: "OS/2 doc patch for _99" + From: Ilya Zakharevich + Msg-ID: <199705080046.UAA23466@monk.mps.ohio-state.edu> + Date: Wed, 7 May 1997 20:46:45 -0400 (EDT) + Files: README.os2 + + +---------------- +Version 5.003_99 +---------------- + +"Oops." Now this _has_ to be the gamma; we're out of numbers. + + CORE LANGUAGE CHANGES + + (no changes) + + CORE PORTABILITY + + Title: "NeXT hints update" + From: hansm@euronet.nl + Msg-ID: <199704302229.AAA02690@mail.euronet.nl> + Date: Thu, 1 May 97 00:28:41 +0200 + Files: Configure Makefile.SH hints/next_4.sh + + Title: "Support shared libperl on AIX" + From: Eric Bartley + Msg-ID: <199704270131.UAA51426@icd.cc.purdue.edu> + Date: Sat, 26 Apr 1997 20:31:37 -0500 + Files: Configure Makefile.SH hints/aix.sh + + OTHER CORE CHANGES + + Title: "Fix NUL-termination bug in delimcpy()" + From: Chip Salzenberg + Files: util.c + + Title: "Forget prototype of subroutine after C" + From: Chip Salzenberg + Files: op.c + + Title: "Handle tainted values in lists returned from subs, evals" + From: Chip Salzenberg + Files: pp_ctl.c pp_hot.c t/op/taint.t + + Title: "Fix sysread() on tied handle" + From: Spider Boardman + Msg-ID: <199705010601.CAA04926@Orb.Nashua.NH.US> + Date: Thu, 1 May 1997 02:01:20 -0400 + Files: pp_sys.c + + Title: "Fix OS/2-specific buffer overflow" + From: Ilya Zakharevich + Msg-ID: <199704301920.PAA09681@monk.mps.ohio-state.edu> + Date: Wed, 30 Apr 1997 15:20:01 -0400 (EDT) + Files: os2/os2.c + + BUILD PROCESS + + Title: "Add new globals to perl.exp" + From: Chip Salzenberg + Files: perl_exp.SH + + LIBRARY AND EXTENSIONS + + Title: "Refresh DB_File to 1.14" + From: Paul Marquess + Msg-ID: <9704302045.AA05484@claudius.bfsec.bt.co.uk> + Date: Wed, 30 Apr 1997 21:45:09 +0100 (BST) + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t + t/lib/db-hash.t t/lib/db-recno.t + + TESTS + + Title: "Disable op/pipe.t test under Machten" + From: Dominic Dunlop + Msg-ID: + Date: Thu, 1 May 1997 12:48:26 +0200 + Files: t/io/pipe.t + + UTILITIES + + Title: "typo fixes to installhtml" + From: lvirden@cas.org (Larry W. Virden) + Msg-ID: <199705011114.HAA26968@cas.org> + Date: Thu, 1 May 1997 07:14:31 -0400 + Files: installhtml + + DOCUMENTATION + + Title: "Fix description of av_undef() in perlguts" + From: Gisle Aas + Msg-ID: <199705011042.MAA09897@bergen.sn.no> + Date: Thu, 1 May 1997 12:42:46 +0200 + Files: pod/perlguts.pod + + Title: "Fix typo in perldelta" + From: Chip Salzenberg + Files: pod/perldelta.pod + + +---------------- +Version 5.003_98 +---------------- + +Here it is, the second public beta (a.k.a gamma). + + CORE LANGUAGE CHANGES + + Title: "Support C< $coderef->($x,$y) >" + From: Chip Salzenberg + Files: perly.c perly.c.diff perly.y pod/perldelta.pod pod/perldsc.pod + pod/perlref.pod t/op/ref.t vms/perly_c.vms + + CORE PORTABILITY + + (no changes) + + OTHER CORE CHANGES + + Title: "Fix C< hex('80') * 0x1000000 >" + From: Chip Salzenberg + Files: opcode.pl + + Title: "Reset errno after failed piped close" + From: Roderick Schertler + Msg-ID: <28152.862264940@eeyore.ibcinc.com> + Date: Mon, 28 Apr 1997 18:02:20 -0400 + Files: lib/Time/gmtime.pm lib/Time/localtime.pm pod/perlfunc.pod + t/io/pipe.t util.c + + Title: "Fix warning wrt return value of PerlIO_getname()" + From: Spider Boardman + Msg-ID: <199704300448.AAA24174@Orb.Nashua.NH.US> + Date: Wed, 30 Apr 1997 00:48:13 -0400 + Files: perlio.c + + BUILD PROCESS + + (no changes) + + LIBRARY AND EXTENSIONS + + (no changes) + + TESTS + + (no other changes) + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Describe Math::Trig in perlmodlib" + From: Chip Salzenberg + Files: pod/perlmodlib.pod + + Title: "Add new diagnostics to perldelta" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod + + +----------------- +Version 5.003_97j +----------------- + +This patch should be _98, unless it's egregiously broken somehow. + + CORE LANGUAGE CHANGES + + (no changes) + + CORE PORTABILITY + + Title: "Return to favoring memset(,0,) over bzero()" + From: Chip Salzenberg + Files: perl.h + + Title: "NetBSD hint update" + From: matthew green + Msg-ID: <199704251021.EAA22570@jhereg.perl.com> + Date: Fri, 25 Apr 1997 20:18:02 +1000 + Files: hints/netbsd.sh + + Title: "HP-UX hint update" + From: Chuck D. Phillips + Msg-ID: <199704280535.WAA22441@palrel1.hp.com> + Date: Sun, 27 Apr 1997 23:35:07 -0600 + Files: hints/hpux.sh + + Title: "Win32 update (three patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: win32/makedef.pl win32/perllib.c win32/win32.c + + OTHER CORE CHANGES + + Title: "Update sprintf: '%hn'; '%s',NULL; panic on frexp() failure" + From: Chip Salzenberg + Files: perl.h pod/perldiag.pod sv.c + + Title: "Fix lingering '%S' in XS_VERSION_BOOTCHECK" + From: Chip Salzenberg + Files: XSUB.h + + Title: "Eliminate Alpha warnings" + From: Hallvard B Furuseth and Chip Salzenberg + Files: perlsdio.h pp_sys.c + + Title: "Fix typo in NeXT dynaloader" + From: Chip Salzenberg + Files: ext/DynaLoader/dl_next.xs + + Title: "Fix possible buffer overflow under VMS" + From: Chip Salzenberg + Files: taint.c + + BUILD PROCESS + + (no changes) + + LIBRARY AND EXTENSIONS + + Title: "Refresh CGI.pm to 2.35" + From: Lincoln Stein + Files: lib/CGI.pm + + Title: "Refresh DB_File to 1.13" + From: Paul Marquess + Msg-ID: <9704271413.AA08876@claudius.bfsec.bt.co.uk> + Date: Sun, 27 Apr 1997 15:12:59 +0100 (BST) + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + Title: "SelfLoader: fix prototype pattern, rename intrusive lexical" + From: Jesse Glick and Chip Salzenberg + Files: lib/SelfLoader.pm + + TESTS + + (no changes) + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Split perlmod" + From: Tom Christiansen + Msg-ID: <199704260050.RAA02468@toy.perl.com> + Date: Fri, 25 Apr 1997 20:50:09 -0400 + Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod + pod/perldsc.pod pod/perlfaq3.pod pod/perlipc.pod + pod/perlmod.pod pod/perlmodlib.pod pod/perlobj.pod + pod/perltie.pod pod/roffitall + + Title: "Describe __PACKAGE__ in perldelta" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Doc fix for close of pipe handle" + From: Chip Salzenberg + Files: pod/perlfunc.pod + + +----------------- +Version 5.003_97i +----------------- + +This patch eliminates all known sources of buffer overflow! (And the +crowd goes wild. (Yeah.)) Showstoppers only between here and _98. + + CORE LANGUAGE CHANGES + + (no changes) + + CORE PORTABILITY + + Title: "Provide memset() if it's missing" + From: Chip Salzenberg + Files: global.sym perl.h proto.h util.c + + Title: "Don't tell GCC that warn(), croak(), and die() are printf-lik + From: Chip Salzenberg + Files: proto.h + + OTHER CORE CHANGES + + Title: "Misc. sv_vcatpvfn() fixes" + From: Hugo, Dale, Nick, Hallvard, Chip + Files: gv.c mg.c op.c perl.c pp.c pp_ctl.c sv.c toke.c util.c + + Title: "Enforce order of sprintf() elements" + From: Chip Salzenberg + Files: sv.c + + Title: "Guard against long numbers, <" + From: Chip Salzenberg + Files: global.sym mg.c perl.c pod/perldiag.pod proto.h toke.c util.c + + Title: "Guard against C to deeply nested label" + From: Chip Salzenberg + Files: pod/perldiag.pod pp_ctl.c + + Title: "Guard against overflow in dup2() emulation" + From: Chip Salzenberg + Files: util.c + + Title: "Win32: Guard against long function names" + From: Chip Salzenberg + Files: win32/win32sck.c + + Title: "Make mess() always work, by using a non-arena SV" + From: Chip Salzenberg, from idea by Gurusamy Sarathy + Files: perl.c util.c + + Title: "Fix scalar leak in pp_prtf()" + From: Doug MacEachern + Msg-ID: <199704241706.NAA19140@postman.osf.org> + Date: Thu, 24 Apr 1997 13:06:21 -0400 + Files: pp_sys.c + + Title: "When copying a format line, take only its string value" + From: Chip Salzenberg + Files: sv.c + + Title: "Undo private patch" + From: Chip Salzenberg + Files: installperl lib/ExtUtils/Install.pm + + Title: "Fix LEAKTEST numbers" + From: Chip Salzenberg + Files: ext/DynaLoader/dl_vms.xs handy.h os2/os2.c util.c vms/vms.c + win32/win32.c win32/win32sck.c + + BUILD PROCESS + + Title: "Cope with a that isn't related to DB" + From: Jarkko Hietaniemi + Msg-ID: <199704241728.UAA09951@alpha.hut.fi> + Date: Thu, 24 Apr 1997 20:28:39 +0300 (EET DST) + Files: Configure + + LIBRARY AND EXTENSIONS + + Title: "Always NUL-terminate opsets" + From: Chip Salzenberg + Files: ext/Opcode/Opcode.xs + + Title: "Don't core dump if my_inet_aton() get a NULL" + From: Chip Salzenberg + Files: ext/Socket/Socket.xs + + Title: "Handle symlinks, high permission bits in File::Path" + From: Chip Salzenberg + Files: lib/File/Path.pm + + Title: "Math::{Complex,Trig} update" + From: Jarkko Hietaniemi + Msg-ID: <199704242221.BAA30363@alpha.hut.fi> + Date: Fri, 25 Apr 1997 01:21:44 +0300 (EET DST) + Files: lib/Math/Complex.pm lib/Math/Trig.pm pod/roffitall + t/lib/complex.t t/lib/trig.t + + TESTS + + (no other changes) + + UTILITIES + + Title: "Fix buffer overflow in a2p" + From: Chip Salzenberg + Files: x2p/a2py.c + + DOCUMENTATION + + Title: "FAQ udpate (24-apr-97)" + From: Nathan Torkington + Msg-ID: <199704242247.QAA07010@prometheus.frii.com> + Date: Thu, 24 Apr 1997 16:47:23 -0600 (MDT) + Files: pod/perlfaq*.pod + + Title: "Document new {,s}printf() behavior" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlfunc.pod + + +----------------- +Version 5.003_97h +----------------- + +This patch eliminates almost all possible sources of buffer overflow; +in particular, there are no more sprintf() bugs. (!!) This patch +also has a few other fixes. With these changes in place, I can sleep +at night. (Because I've stopped hacking. :-)) + + CORE LANGUAGE CHANGES + + Title: "Support PRINTF for tied handles" + From: Doug MacEachern + Msg-ID: <199704202226.SAA08032@postman.osf.org> + Date: Sun, 20 Apr 1997 18:26:13 -0400 + Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t + + CORE PORTABILITY + + Title: "Fix bitwise shifts and pack('w') on Crays" + From: Chip Salzenberg + Files: pp.c + + Title: "Win32 update (two patches)" + From: Gurusamy Sarathy + Files: lib/AutoSplit.pm lib/ExtUtils/MM_Unix.pm win32/config.w32 + win32/makedef.pl + + OTHER CORE CHANGES + + Title: "Mondo Cool patch for buffer safety and convenience" + From: Chip Salzenberg + Files: XSUB.h doop.c dump.c ext/DynaLoader/dl_dlopen.xs + ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs + ext/DynaLoader/dlutils.c ext/ODBM_File/ODBM_File.xs + global.sym gv.c interp.sym mg.c op.c perl.c perl.h + pod/perlguts.pod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h + regcomp.c regexec.c sv.c toke.c util.c + + Title: "Problems with glob" + From: Ilya Zakharevich + Msg-ID: <1997Apr20.024432.1941365@hmivax.humgen.upenn.edu> + Date: Sun, 20 Apr 1997 02:44:32 -0400 (EDT) + Files: op.c + + Title: "Fix scalar leak in closures" + From: Chip Salzenberg + Files: op.c scope.c + + Title: "Refine error messages re: anon subs' prototypes" + From: Chip Salzenberg + Files: op.c + + Title: "Outermost scope is void, not scalar" + From: Chip Salzenberg + Files: pp_ctl.c + + BUILD PROCESS + + Title: "Fix up Linux hints for tcsh, and Configure patch" + From: Andy Dougherty + Msg-ID: without module name" + From: Chip Salzenberg + Files: lib/autouse.pm + + Title: "Silence warnings on simple C" + From: Roderick Schertler + Msg-ID: + Date: 19 Apr 1997 10:22:43 -0400 + Files: ext/Opcode/ops.pm + + TESTS + + Title: "Don't put leading newline on numeric strings" + From: Andreas Koenig + Msg-ID: <199704230847.KAA22752@anna.in-berlin.de> + Date: Wed, 23 Apr 1997 10:47:00 +0200 + Files: t/pragma/constant.t + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "FAQ udpate (23-apr-97)" + From: Nathan Torkington + Msg-ID: <199704231822.MAA05074@prometheus.frii.com> + Date: Wed, 23 Apr 1997 12:22:55 -0600 (MDT) + Files: pod/perlfaq*.pod + + Title: "Two doublewords less" + From: Jarkko Hietaniemi + Msg-ID: <199704201938.WAA07722@alpha.hut.fi> + Date: Sun, 20 Apr 1997 22:38:13 +0300 (EET DST) + Files: pod/perlrun.pod vms/perlvms.pod + + +----------------- +Version 5.003_97g +----------------- + +This one has two security bug fixes for buffer overflows. Perl has +not yet been searched to see if more fixes are needed. + + CORE LANGUAGE CHANGES + + Title: "Improve sysseek(), remove systell(), fix Opcode" + From: Chip Salzenberg + Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm + ext/Opcode/Opcode.xs global.sym keywords.pl opcode.pl + pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c + proto.h t/op/sysio.t toke.c + + Title: "Fix (and test) spaces in {,un}pack()" + From: Chip Salzenberg + Files: pp.c t/op/pack.t + + CORE PORTABILITY + + Title: "Irix update" + From: Scott Henry + Msg-ID: + Date: 18 Apr 1997 12:37:24 -0700 + Files: MANIFEST hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh + + Title: "ExtUtils/Miniperl.pm not built on Win32" + From: Nick Ing-Simmons + Msg-ID: <199704181742.SAA08407@ni-s.u-net.com> + Date: Fri, 18 Apr 1997 18:42:32 +0100 + Files: win32/Makefile + + OTHER CORE CHANGES + + Title: "SECURITY FIX: 'Identifier too long'" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod toke.c + + Title: "SECURITY FIX: Buffer overflow in gv_fetchfile()" + From: Chip Salzenberg + Files: gv.c + + Title: "Remove pp_method() inefficiency from last patch" + From: Chip Salzenberg + Files: pp_hot.c + + BUILD PROCESS + + Title: "Fix unnecessary re-linking" + From: Chip Salzenberg + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Fix tcsh hack in Configure" + From: Chip Salzenberg + Files: Configure + + Title: "Minor, optional patch to Makefile.SH" + From: "Randy J. Ray" + Msg-ID: + Date: Thu, 17 Apr 1997 19:32:17 -0600 + Files: Makefile.SH + + LIBRARY AND EXTENSIONS + + Title: "Patch to Getopt::Long" + From: Johan Vromans + Msg-ID: + Date: Fri, 18 Apr 97 22:24 MET DST + Files: lib/Getopt/Long.pm + + Title: "Fix NAME in SDBM_File build" + From: Chip Salzenberg + Files: ext/SDBM_File/sdbm/Makefile.PL + + TESTS + + (no other changes) + + UTILITIES + + Title: "Make h2ph generate constant subs" + From: Roderick Schertler + Msg-ID: + Date: 18 Apr 1997 14:23:46 -0400 + Files: utils/h2ph.PL + + DOCUMENTATION + + Title: "Document {,un}pack changes" + From: Paul Marquess + Msg-ID: <9704181249.AA11733@claudius.bfsec.bt.co.uk> + Date: Fri, 18 Apr 97 13:49:39 BST + Files: pod/perldelta.pod pod/perldiag.pod + + +----------------- +Version 5.003_97f +----------------- + +This is it before _98. No more last-minute features. Really, I mean +it this time. No kidding. + + CORE LANGUAGE CHANGES + + Title: "New operator systell()" + From: Chip Salzenberg + Files: doio.c ext/Opcode/Opcode.pm keywords.pl opcode.pl + pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod pp_sys.c + t/op/sysio.t toke.c + + Title: "Allow constant sub to be optimized when called with parens" + From: Chip Salzenberg + Files: toke.c + + Title: "Make {,un}pack fail on invalid pack types" + From: Chip Salzenberg + Files: pod/perldiag.pod pp.c + + CORE PORTABILITY + + Title: "Fix bitwise ops and {,un}pack() on Cray CPUs" + From: Chip Salzenberg + Files: pp.c + + Title: "VMS update" + From: Charles Bailey + Files: lib/Cwd.pm lib/File/Path.pm lib/FindBin.pm vms/perly_c.vms + vms/vms.c vms/writemain.pl + + Title: "Win32 update (three patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: lib/Cwd.pm lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_Win32.pm + lib/File/Basename.pm win32/Makefile win32/makedef.pl + win32/perllib.c win32/win32.c win32/win32iop.h + + OTHER CORE CHANGES + + Title: "Fix error messages on method lookup failure" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix use of var before init in util.c" + From: Gurusamy Sarathy + Msg-ID: <199704162342.TAA20773@aatma.engin.umich.edu> + Date: Wed, 16 Apr 1997 19:42:41 -0400 + Files: util.c + + BUILD PROCESS + + Title: "Linux hints: Allow build w/o suidperl, prefer tcsh to csh" + From: Michael De La Rue + Files: Configure hints/linux.sh + + LIBRARY AND EXTENSIONS + + Title: "Fix bug in Opcode when (maxo & 15) > 8" + From: Chip Salzenberg + Files: ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm + ext/Opcode/Opcode.xs + + Title: "CGI.pm broke again" + From: Andreas Koenig + Msg-ID: <199704171136.NAA24859@anna.in-berlin.de> + Date: Thu, 17 Apr 1997 13:36:28 +0200 + Files: lib/CGI.pm + + Title: "Revise quotewords()" + From: Shishir Gundavaram + Files: lib/Text/ParseWords.pm + + TESTS + + (no other changes) + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Doc updates: INSTALL-1.13, pumpkin.pod-1.9" + From: Andy Dougherty + Files: INSTALL Porting/pumpkin.pod + + Title: "Document size restrictions for packed integers" + From: Jarkko Hietaniemi + Files: pod/perlfunc.pod + + +----------------- +Version 5.003_97e +----------------- + +Y'know, I've heard of this "beta" thing, but it's been so long since +I've seen one, I'm not sure it really exists... + + CORE LANGUAGE CHANGES + + Title: "New operator: sysseek()" + From: Chip Salzenberg + Files: doio.c ext/Opcode/Makefile.PL ext/Opcode/Opcode.pm global.sym + keywords.pl opcode.pl pod/perldelta.pod pod/perlfunc.pod + pp_sys.c t/op/sysio.t toke.c + + Title: "Allow recursive substitution again" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c + + CORE PORTABILITY + + Title: "Use size_t for socket size parameters of GNU libc" + From: Chip Salzenberg + Files: doio.c pp_sys.c + + Title: "Fix STMT_{START,END} under g++" + From: Steven Parkes + Msg-ID: <199704141935.MAA11240@monterey.sierravista.com> + Date: Mon, 14 Apr 1997 12:35:34 -0700 + Files: perl.h + + Title: "Win32 update (four patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: MANIFEST README.win32 dosish.h ext/SDBM_File/Makefile.PL + ext/SDBM_File/sdbm/Makefile.PL ext/SDBM_File/sdbm/sdbm.c + ext/SDBM_File/sdbm/sdbm.h lib/ExtUtils/MM_Unix.pm perl.c + utils/perlbug.PL utils/perldoc.PL win32/Makefile win32/TEST + win32/config.H win32/config.w32 win32/config_h.PL + win32/config_sh.PL win32/perllib.c win32/runperl.c + win32/win32.c win32/win32io.c win32/win32sck.c + + OTHER CORE CHANGES + + Title: "New API function: perl_eval_pv()" + From: Doug MacEachern + Msg-ID: <199704142113.RAA06823@postman.osf.org> + Date: Mon, 14 Apr 1997 17:13:41 -0400 + Files: perl.c pod/perlcall.pod pod/perldelta.pod pod/perlembed.pod + pod/perlguts.pod proto.h + + Title: "Fix C< s//whatever/ >, which reuses old pattern" + From: Chip Salzenberg + Files: pp_hot.c regexec.c + + Title: "Return a value from PerlIO_{,un}getc" + From: Hallvard B Furuseth + Msg-ID: <199704131228.OAA05695@bombur2.uio.no> + Date: Sun, 13 Apr 1997 14:28:14 +0200 (MET DST) + Files: perlio.c + + Title: "Fix for environment leak" + From: skimo@breughel.ufsia.ac.be (Sven Verdoolaege) + Msg-ID: <19970415103246.NN46698@breughel.ufsia.ac.be> + Date: Tue, 15 Apr 1997 10:32:46 +0200 + Files: util.c + + Title: "Fix comments in seed()" + From: Hallvard B Furuseth + Msg-ID: <199704141758.TAA06895@bombur2.uio.no> + Date: Mon, 14 Apr 1997 19:58:38 +0200 (MET DST) + Files: pp.c + + BUILD PROCESS + + Title: "Put extensions' autoload files in $archlib" + From: Chip Salzenberg + Files: installperl + + Title: "Use '-fPIC' for debugging compiles under Solaris with gcc" + From: Hallvard B Furuseth + Files: Configure + + LIBRARY AND EXTENSIONS + + Title: "Refresh CGI to 2.34" + From: Chip Salzenberg + Files: eg/cgi/customize.cgi eg/cgi/tryit.cgi lib/CGI.pm + lib/CGI/Apache.pm + + Title: "Debugger update" + From: Ilya Zakharevich + Msg-ID: <199704142115.RAA09923@monk.mps.ohio-state.edu> + Date: Mon, 14 Apr 1997 17:15:27 -0400 (EDT) + Files: lib/perl5db.pl + + Title: "diagnostics: $/ gotcha" + From: Andreas Koenig + Msg-ID: <199704151814.UAA03404@anna.in-berlin.de> + Date: Tue, 15 Apr 1997 20:14:01 +0200 + Files: lib/diagnostics.pm + + Title: "Update File::Path" + From: Andreas Koenig + Msg-ID: <199704151401.QAA02556@anna.in-berlin.de> + Date: Tue, 15 Apr 1997 16:01:07 +0200 + Files: lib/File/Path.pm t/lib/filepath.t + + Title: "User::pwent.pm: g{,e}cos" + From: Tom Christiansen + Msg-ID: <199704130135.TAA23274@jhereg.perl.com> + Date: Sat, 12 Apr 1997 19:35:54 -0600 + Files: lib/User/pwent.pm + + Title: "Sys::Syslog: hyphens in hostnames" + From: Jarkko Hietaniemi + Msg-ID: <199704151421.RAA19693@alpha.hut.fi> + Date: Tue, 15 Apr 1997 17:21:53 +0300 (EET DST) + Files: lib/Sys/Syslog.pm + + Title: "Clean up format of dlopen() debug info" + From: Hallvard B Furuseth + Files: ext/DynaLoader/dl_dlopen.xs + + TESTS + + (no changes) + + UTILITIES + + Title: "xsubpp incorrectly handles 'class::newthing()'" + From: "John Q. Linux" + Msg-ID: <199704122201.PAA01780@jql.accessone.com> + Date: Sat, 12 Apr 1997 15:01:33 -0700 + Files: lib/ExtUtils/xsubpp + + DOCUMENTATION + + Title: "Add CGI to perldelta.pod and improve its description in MANIFEST" + From: Chip Salzenberg + Files: MANIFEST pod/perldelta.pod + + Title: "Describe probs with majordomo 1.94.1" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Fix description of /\G/g" + From: Chip Salzenberg + Files: pod/perlop.pod + + Title: "Mention '...' operator in precedence table" + From: Tom Christiansen + Msg-ID: <199704131724.LAA23120@jhereg.perl.com> + Date: Sun, 13 Apr 1997 11:24:16 -0600 + Files: pod/perlop.pod + + +----------------- +Version 5.003_97d +----------------- + +Any minute now... second public beta... no, really... + + CORE LANGUAGE CHANGES + + Title: "Fix for incorrect overloaded assignment" + From: Ilya Zakharevich + Msg-ID: <199704112225.SAA03482@monk.mps.ohio-state.edu> + Date: Fri, 11 Apr 1997 18:25:33 -0400 (EDT) + Files: gv.c + + Title: "Fix C< $x=''; pos($x)=0; $x=~/\G$/ >" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix label on C statement" + From: Chip Salzenberg + Files: perly.c perly.y + + CORE PORTABILITY + + Title: "update to 5.003_97b/hint/irix_6_2.sh" + From: Scott Henry + Msg-ID: + Date: 11 Apr 1997 18:05:03 -0700 + Files: hints/irix_6_2.sh + + OTHER CORE CHANGES + + Title: "Before 'BEGIN not safe', explain why" + From: Chip Salzenberg + Files: op.c + + Title: "New error msg for low-key failure of C" + From: Chip Salzenberg + Files: pod/perldiag.pod pp_ctl.c t/pragma/strict-subs + t/pragma/strict-vars + + Title: "Put "dXSUB_SYS" last in declarations" + From: Chip Salzenberg + Files: win32/perllib.c + + Title: "Minor type cleanup" + From: Chip Salzenberg + Files: proto.h toke.c + + BUILD PROCESS + + (no changes) + + LIBRARY AND EXTENSIONS + + Title: "win32: perl5db patch" + From: Gurusamy Sarathy + Msg-ID: <199704102142.RAA27396@aatma.engin.umich.edu> + Date: Thu, 10 Apr 1997 17:42:13 -0400 + Files: lib/perl5db.pl + + Title: "Enhancements to debugger, Term::ReadLine, Term::Cap" + From: Ilya Zakharevich + Msg-ID: <199704101948.PAA01841@monk.mps.ohio-state.edu> + Date: Thu, 10 Apr 1997 15:48:07 -0400 (EDT) + Files: lib/Term/Cap.pm lib/Term/ReadLine.pm lib/perl5db.pl + + Title: "MM_Unix patch for use under CVS" + From: Ulrich Pfeifer + Msg-ID: + Date: 11 Apr 1997 14:59:00 +0200 + Files: lib/ExtUtils/MM_Unix.pm + + Title: "Complex update (five patches)" + From: Jarkko Hietaniemi + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Fix undef warning in Math::BigInt" + From: Chip Salzenberg + Files: lib/Math/BigInt.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Add B<-o> option to a2p, for old awk; make new the default" + From: Chip Salzenberg + Files: x2p/a2p.h x2p/a2p.pod x2p/a2py.c x2p/walk.c + + DOCUMENTATION + + Title: "typo in lib/diagnostics.pm" + From: barnett@grymoire.crd.ge.com (Bruce Barnett) + Msg-ID: <199704111800.OAA27297@grymoire.crd.ge.com> + Date: Fri, 11 Apr 1997 14:00:54 -0400 + Files: lib/diagnostics.pm + + Title: "Use B<> for options in Class::Struct pod" + From: Hugo van der Sanden + Msg-ID: <334D2E7B.67F0@iii.co.uk> + Date: Thu, 10 Apr 1997 19:16:27 +0100 + Files: lib/Class/Struct.pm + + Title: "Explain //g and \G issues" + From: Gurusamy Sarathy + Msg-ID: <199704122048.QAA25060@aatma.engin.umich.edu> + Date: Sat, 12 Apr 1997 16:48:41 -0400 + Files: pod/perldelta.pod pod/perlop.pod pod/perlre.pod + + Title: "more (err, less) doubled words" + From: Jarkko Hietaniemi + Msg-ID: <199704111931.WAA24460@alpha.hut.fi> + Date: Fri, 11 Apr 1997 22:31:25 +0300 (EET DST) + Files: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm + ext/IO/lib/IO/Pipe.pm lib/CGI.pm lib/Exporter.pm + lib/ExtUtils/MakeMaker.pm lib/IPC/Open2.pm lib/IPC/Open3.pm + lib/vars.pm pod/perlcall.pod pod/perldiag.pod + pod/perlfaq1.pod pod/perlfaq3.pod pod/perlfaq5.pod + pod/perlfaq7.pod pod/perlfaq8.pod pod/perlipc.pod + + Title: "Freudian slip error in perlsub.pod" + From: barnett@grymoire.crd.ge.com (Bruce Barnett) + Msg-ID: <199704111755.NAA27200@grymoire.crd.ge.com> + Date: Fri, 11 Apr 1997 13:55:07 -0400 + Files: pod/perlsub.pod + + Title: "Little patch for perl5.003_97c/pod/perlpod.pod" + From: rse@engelschall.com (Ralf S. Engelschall) + Msg-ID: <199704112048.WAA08733@en1.engelschall.com> + Date: Fri, 11 Apr 1997 22:48:37 +0200 + Files: pod/perlpod.pod + + +----------------- +Version 5.003_97c +----------------- + +That second public beta will be Real Soon Now... + + CORE LANGUAGE CHANGES + + Title: "Refine setgroups() behavior of C<$)>" + From: Chip Salzenberg + Files: mg.c pod/perldelta.pod pod/perlvar.pod + + Title: "Forbid -[Mm] on #! line" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod toke.c + + CORE PORTABILITY + + Title: "Fix dynamic loading (and argv[0]) under AmigaOS" + From: Norbert Pueschel + Msg-ID: <77724842@Armageddon.meb.uni-bonn.de> + Date: Tue, 08 Apr 1997 22:01:45 +0200 + Files: hints/amigaos.sh + + Title: "Special mkdir() for VMS" + From: Charles Bailey + Msg-ID: <01IHGOXN6MZM0004K3@hmivax.humgen.upenn.edu> + Date: Tue, 08 Apr 1997 12:33:56 -0400 (EDT) + Files: dosish.h lib/ExtUtils/MM_Unix.pm lib/File/Path.pm os2/os2ish.h + plan9/plan9ish.h pp_sys.c unixish.h vms/vms.c vms/vmsish.h + + OTHER CORE CHANGES + + Title: "Fix assignment from magic SV that becomes a glob" + From: Chip Salzenberg + Files: sv.c + + BUILD PROCESS + + Title: "Fix syntax error in Configure comment(!)" + From: Chip Salzenberg + Files: Configure + + Title: "For Solaris, if -DDEBUGGING, default to '-KPIC', not '-Kpic'" + From: Chip Salzenberg + Files: Configure + + Title: "Fix usage of dXSUB_SYS, esp. in ExtUtils::Miniperl" + From: Chip Salzenberg + Files: dosish.h minimod.pl os2/os2ish.h plan9/plan9ish.h vms/vmsish.h + + LIBRARY AND EXTENSIONS + + Title: "Replace Class::Template with improved Class::Struct" + From: Jim Miner + Files: MANIFEST lib/Class/Struct.pm lib/Class/Template.pm + lib/File/stat.pm lib/Net/hostent.pm lib/Net/netent.pm + lib/Net/protoent.pm lib/Net/servent.pm lib/Time/gmtime.pm + lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm + lib/User/pwent.pm pod/perldelta.pod pod/perlfaq7.pod + pod/perlmod.pod pod/perltoot.pod + + Title: "MakeMaker pathname patch" + From: Nick Ing-Simmons + Msg-ID: <199704091908.UAA00877@ni-s.u-net.com> + Date: Wed, 9 Apr 1997 20:08:23 +0100 + Files: lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm + + Title: "Fix configuration of new socket" + From: Chip Salzenberg + Files: ext/IO/lib/IO/Socket.pm + + Title: "Improve IO::Handle docs; don't export _open_mode_string" + From: Chip Salzenberg + Files: ext/IO/lib/IO/File.pm ext/IO/lib/IO/Handle.pm + + Title: "Complex.pm: 0**0 sanity" + From: Jarkko Hietaniemi + Msg-ID: <199704091804.VAA13930@alpha.hut.fi> + Date: Wed, 9 Apr 1997 21:04:23 +0300 (EET DST) + Files: lib/Math/Complex.pm + + Title: "Fix typos in Math::Trig" + From: Jarkko Hietaniemi + Files: lib/Math/Trig.pm + + TESTS + + Title: "Accommodate CodeBuilder variant of Machten 4.0.3" + From: Dominic Dunlop + Msg-ID: + Date: Tue, 8 Apr 1997 22:15:15 +0200 + Files: t/io/fs.t t/op/stat.t + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "IO::Socket doc fix" + From: Roderick Schertler + Msg-ID: <28383.860527843@eeyore.ibcinc.com> + Date: Tue, 08 Apr 1997 15:30:43 -0400 + Files: ext/IO/lib/IO/Socket.pm + + +----------------- +Version 5.003_97b +----------------- + +Working on the second public beta... + + CORE LANGUAGE CHANGES + + Title: "Make assignment to C<$)> call setgroups()" + From: Chip Salzenberg + Files: Configure config_H config_h.SH mg.c plan9/config.plan9 + pod/perldelta.pod vms/config.vms win32/config.H + win32/config.w32 + + Title: "Grandfather "$$" in strings" + From: Chip Salzenberg + Files: pod/perldiag.pod toke.c + + Title: "Disconnect warn and die hooks _after_ object destruction" + From: Chip Salzenberg + Files: perl.c + + Title: "Forbid recursive substitutions" + From: Chip Salzenberg + Files: cop.h pod/perldelta.pod pod/perldiag.pod pp_ctl.c pp_hot.c + + CORE PORTABILITY + + Title: "Use SSize_t for values of PerlIO_{read,write}" + From: Chip Salzenberg + Files: perlio.c perlio.h perlsdio.h pp_sys.c + + Title: "perlwin-97a_4: win32 environ fix" + From: Gurusamy Sarathy + Msg-ID: <199704060431.XAA23400@aatma.engin.umich.edu> + Date: Sat, 05 Apr 1997 23:31:11 -0500 + Files: win32/win32.c win32/win32io.c win32/win32io.h win32/win32iop.h + + OTHER CORE CHANGES + + Title: "length($') isn't" + From: Gurusamy Sarathy + Msg-ID: <199704070730.DAA07310@aatma.engin.umich.edu> + Date: Mon, 07 Apr 1997 03:30:44 -0400 + Files: mg.c + + Title: "Fix obscure regex bug related to leading C<.*>" + From: Chip Salzenberg + Files: toke.c + + Title: "Add warning for glob failure" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perldiag.pod pp_hot.c + + Title: "Fix C in presence of local patches" + From: Chip Salzenberg + Files: perl.c + + BUILD PROCESS + + Title: "Don't suggest 'Configure -der' in config.sh comments" + From: Chip Salzenberg + Files: Configure + + LIBRARY AND EXTENSIONS + + Title: "CGI->redirect patch" + From: Doug MacEachern + Msg-ID: <199704051527.KAA11280@postman.osf.org> + Date: Sat, 05 Apr 1997 10:27:52 -0500 + Files: lib/CGI.pm + + Title: "Updates to Math::Complex and Math::Trig" + From: Jarkko Hietaniemi + Files: lib/Math/Complex.pm lib/Math/Trig.pm pod/perldelta.pod + t/lib/complex.t + + Title: "Fix FindBin under Win32, and document success" + From: Nick Ing-Simmons and Gurusamy Sarathy + Msg-ID: <199704051504.QAA09507@ni-s.u-net.com> + Date: Sat, 5 Apr 1997 16:04:52 +0100 + Files: README.win32 lib/Cwd.pm lib/FindBin.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Patch for 'perldoc -f'" + From: Gisle Aas + Msg-ID: <199704061732.TAA00353@bergen.sn.no> + Date: Sun, 6 Apr 1997 19:32:04 +0200 + Files: utils/perldoc.PL + + DOCUMENTATION + + Title: "Document required module versions" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Document sample function perl_eval()" + From: Doug MacEachern + Msg-ID: <199704051524.KAA06090@postman.osf.org> + Date: Sat, 05 Apr 1997 10:24:43 -0500 + Files: pod/perlcall.pod pod/perlembed.pod + + Title: "Make L refer to L" + From: Chip Salzenberg + Files: pod/perltrap.pod + + +----------------- +Version 5.003_97a +----------------- + +This release gets a letter instead of a full subversion because I'm +planning on making 5.003_98 the second public beta. + + CORE LANGUAGE CHANGES + + Title: "Fix AUTOLOAD, or kill me" + From: Chip Salzenberg + Files: gv.c pp.c t/op/method.t + + CORE PORTABILITY + + Title: "Add support for Cygwin32 (GNU-Win32) -- very low impact" + From: John Cerney + Msg-ID: <199704030821.JAA08762@pluto.tiuk.ti.com> + Date: Thu, 3 Apr 1997 09:21:17 +0100 + Files: MANIFEST README.cygwin32 cygwin32/cw32imp.h cygwin32/gcc2 + cygwin32/ld2 cygwin32/perlgcc cygwin32/perlld + ext/DynaLoader/dl_cygwin32.xs hints/cygwin32.sh perl.h + pp_sys.c + + Title: "Win32 update (six patches)" + From: Gurusamy Sarathy + Files: MANIFEST README.win32 dosish.h t/io/fs.t t/io/tell.t + t/lib/io_tell.t t/op/magic.t t/op/mkdir.t t/op/runlevel.t + t/op/stat.t t/op/taint.t win32/Makefile win32/VC-2.0/pod.mak + win32/makedef.pl win32/pod.mak win32/win32.c win32/win32.h + win32/win32io.c win32/win32io.h win32/win32iop.h + + Title: "AmigaOS update" + From: Norbert Pueschel + Msg-ID: <77724828@Armageddon.meb.uni-bonn.de> + Date: Thu, 03 Apr 1997 16:16:51 +0200 + Files: README.amiga hints/amigaos.sh + + OTHER CORE CHANGES + + Title: "Fix const-sub-related panic on C" + From: Chip Salzenberg + Files: op.c + + Title: "Fix warning for useless C<1..2>" + From: Chip Salzenberg + Files: op.c + + Title: "Minor cleanups" + From: Gurusamy Sarathy + Msg-ID: <199704040056.TAA22253@aatma.engin.umich.edu> + Date: Thu, 03 Apr 1997 19:56:57 -0500 + Files: mg.c mg.h perl.c + + Title: "Eliminate unreliable warning with %SIG and strict refs" + From: Chip Salzenberg + Files: mg.c + + Title: "Fix impossible test in vivification" + From: Chip Salzenberg + Files: mg.c + + Title: "runlevel is I32, not int" + From: Roderick Schertler + Msg-ID: <2848.860109823@eeyore.ibcinc.com> + Date: Thu, 03 Apr 1997 18:23:43 -0500 + Files: pp_ctl.c util.c + + BUILD PROCESS + + Title: "Re: shared lib compilation problem with miniperl5.003_97" + From: Andy Dougherty + Msg-ID: " + From: Chip Salzenberg and Tim Bunce + Files: lib/AutoLoader.pm + + Title: "CPAN & TRL-Gnu" + From: Achim Bohnet + Msg-ID: <9704040809.AA26143@o09.rosat.mpe-garching.mpg.de> + Date: Fri, 04 Apr 1997 10:09:03 +0200 + Files: lib/CPAN.pm + + Title: "Limit @ISA to actual DBM in AnyDBM" + From: Chip Salzenberg + Files: lib/AnyDBM_File.pm + + Title: "Don't use $4 when it might be undef" + From: Chip Salzenberg + Files: lib/bigfloat.pl + + TESTS + + Title: "Make *dbm tests work with Win32" + From: Chip Salzenberg + Files: t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t + t/lib/sdbm.t + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "Update INSTALL" + From: Andy Dougherty + Files: INSTALL + + Title: "Pod style" + From: Nathan Torkington + Files: pod/perlcall.pod pod/perldata.pod pod/perldebug.pod + pod/perldiag.pod pod/perlform.pod pod/perlfunc.pod + pod/perlipc.pod pod/perllocale.pod pod/perlmod.pod + pod/perlop.pod pod/perlre.pod pod/perlrun.pod + pod/perlstyle.pod pod/perltoc.pod pod/perlvar.pod + + +---------------- +Version 5.003_97 +---------------- + + CORE LANGUAGE CHANGES + + Title: "Reenable but deprecate inherited AUTOLOAD for plain funcs" + From: Chip Salzenberg + Files: ext/DynaLoader/DynaLoader.pm gv.c lib/Text/ParseWords.pm + pod/perldelta.pod pod/perldiag.pod t/op/method.t + + CORE PORTABILITY + + Title: "Don't use setjmp() and longjmp() in complex exprs" + From: Chip Salzenberg + Files: perl.c pp_ctl.c scope.h + + Title: "Improve definition of Sock_size_t" + From: Chip Salzenberg + Files: doio.c pp_sys.c + + Title: "Don't use a completely empty macro parameter" + From: Chip Salzenberg + Files: sv.h + + Title: "Win32 update" + From: Gurusamy Sarathy + Msg-ID: <199704020608.BAA29538@aatma.engin.umich.edu> + Date: Wed, 02 Apr 1997 01:08:09 -0500 + Files: win32/VC-2.0/modules.mak win32/VC-2.0/perl.mak win32/VC- + 2.0/perldll.mak win32/perl.mak + + OTHER CORE CHANGES + + Title: "Introduce and use gv_fetchmethod_autoload()" + From: Chip Salzenberg + Files: global.sym gv.c pod/perlguts.pod proto.h universal.c + + Title: "Reduce memory footprint of literal strings" + From: ilya@math.ohio-state.edu (Ilya Zakharevich) + Msg-ID: <1997Apr1.113438.1913905@hmivax.humgen.upenn.edu> + Date: Tue, 01 Apr 1997 11:34:37 -0500 (EST) + Files: toke.c + + BUILD PROCESS + + Title: "Remove target before link() of perldiag.pod" + From: Chip Salzenberg + Files: installperl + + LIBRARY AND EXTENSIONS + + Title: "Refresh CPAN to 1.24" + From: Andreas Koenig + Files: lib/CPAN.pm lib/CPAN/FirstTime.pm + + Title: "Refresh ExtUtils::Manifest to 1.33" + From: Andreas Koenig + Files: lib/ExtUtils/Manifest.pm + + Title: "Update $VERSION of ExtUtils::Embed to reflect reality" + From: Chip Salzenberg + Files: lib/ExtUtils/Embed.pm + + Title: "Fix POSIX::raise()" + From: "Jens T. Berger Thielemann" + Msg-ID: + Msg-ID: <11173.9704011111@tempest.cise.npl.co.uk> + Date: Tue, 1 Apr 97 12:11:43 BST + Files: lib/File/Basename.pm t/lib/basename.t + + Title: "Eliminate warning in CGI.pm" + From: Chip Salzenberg + Files: lib/CGI.pm + + Title: "Tweaks to constant.pm" + From: Tom Phoenix + Msg-ID: + Date: Mon, 31 Mar 1997 21:10:14 -0800 (PST) + Files: lib/constant.pm + + Title: "Document eval vs. sub in Benchmark" + From: Hugo van der Sanden + Msg-ID: <199704012231.XAA00225@crypt.compulink.co.uk> + Date: Tue, 01 Apr 1997 23:31:55 +0100 + Files: lib/Benchmark.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Improve heuristics for pod2man titles" + From: Roderick Schertler + Msg-ID: + Date: 01 Apr 1997 23:41:55 -0500 + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "Clean up some poddities, and make C work again" + From: Chip Salzenberg + Files: pod/Makefile pod/perldelta.pod pod/perldiag.pod + pod/perlfaq8.pod pod/perlfunc.pod pod/perlop.pod + pod/perltrap.pod + + Title: "Fix MM doc's use of "SUPER::"" + From: avera@hal.com (Jim Avera) + Msg-ID: <9704012235.AA07841@membrane.hal.com> + Date: Tue, 1 Apr 1997 14:35:26 -0800 (PST) + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Eliminate pod warnings in libs" + From: Chip Salzenberg + Files: lib/CGI.pm lib/ExtUtils/Command.pm + + +---------------- +Version 5.003_96 +---------------- + + CORE LANGUAGE CHANGES + + Title: "Support $ENV{PERL5OPT}" + From: Chip Salzenberg + Files: perl.c pod/perldiag.pod pod/perldelta.pod pod/perlrun.pod + + Title: "Implement void context, in which C is undef" + From: Chip Salzenberg + Files: cop.h doop.c dump.c global.sym gv.c op.c op.h perl.c + pod/perlcall.pod pod/perldelta.pod pod/perlfunc.pod + pod/perlguts.pod pod/perlsub.pod pp.c pp_ctl.c pp_hot.c + pp_sys.c proto.h + + Title: "Don't look up &AUTOLOAD in @ISA when calling plain function" + From: Chip Salzenberg + Files: global.sym gv.c lib/Text/ParseWords.pm pod/perldelta.pod + pp_hot.c proto.h t/op/method.t + + Title: "Allow closures to be constant subroutines" + From: Chip Salzenberg + Files: op.c + + Title: "Make C mean C" + From: Chip Salzenberg + Files: pp.c + + Title: "Fix lexical suicide from C in sub" + From: Chip Salzenberg + Files: op.c + + Title: "Make "Unrecog. char." fatal, and update its doc" + From: Chip Salzenberg + Files: pod/perldiag.pod toke.c + + Title: "Die on patterns that will match empty string forever" + From: Stephen Potter + Msg-ID: <199703282138.PAA28311@psa.pencom.com> + Date: Fri, 28 Mar 1997 15:38:30 -0600 + Files: regcomp.c + + CORE PORTABILITY + + Title: "safefree() mismatch" + From: Roderick Schertler + Msg-ID: <21338.859653381@eeyore.ibcinc.com> + Date: Sat, 29 Mar 1997 11:36:21 -0500 + Files: util.c + + Title: "FreeBSD update" + From: Slaven Rezic + Msg-ID: <199703311417.QAA04162@cabulja.herceg.de> + Date: Mon, 31 Mar 1997 16:17:42 +0200 (MET DST) + Files: hints/freebsd.sh + + Title: "Win32 update (seven patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: EXTERN.h MANIFEST win32/Makefile win32/perl.mak + win32/perl.rc win32/perldll.mak win32/makedef.pl + win32/modules.mak win32/win32io.c win32/bin/pl2bat.bat + + OTHER CORE CHANGES + + Title: "Report PERL* environment variables in -V and perlbug" + From: Chip Salzenberg + Files: perl.c utils/perlbug.PL + + Title: "Typo in perl.c: Printing NO_EMBED for perl -V" + From: Gisle Aas + Msg-ID: <199703301922.VAA13509@furubotn.sn.no> + Date: Sun, 30 Mar 1997 21:22:11 +0200 + Files: perl.c + + Title: "Don't let C<$var = $var> untaint $var" + From: Chip Salzenberg + Files: pp_hot.c pp_sys.c sv.h t/op/taint.t + + Title: "Fix autoviv bug in C{KEY}>" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Re: 5.004's new srand() default seed" + From: Hallvard B Furuseth + Msg-ID: <199703302219.AAA20998@bombur2.uio.no> + Date: Mon, 31 Mar 1997 00:19:13 +0200 (MET DST) + Files: pp.c + + Title: "Re: embedded perl and top_env problem " + From: Gurusamy Sarathy + Msg-ID: <199703280031.TAA05711@aatma.engin.umich.edu> + Date: Thu, 27 Mar 1997 19:31:42 -0500 + Files: gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c scope.h util.c + + Title: "Define and use new macro: boolSV()" + From: Tim Bunce + Files: gv.c lib/ExtUtils/typemap os2/os2.c pp.c pp_hot.c pp_sys.c + sv.c sv.h universal.c vms/vms.c + + Title: "Re: strict @F" + From: Hallvard B Furuseth + Msg-ID: <199703252110.WAA16038@bombur2.uio.no> + Date: Tue, 25 Mar 1997 22:10:33 +0100 (MET) + Files: toke.c + + Title: "Try harder to identify errors at EOF" + From: Chip Salzenberg + Files: toke.c + + Title: "Minor string change in toke.c: 'bareword'" + From: lvirden@cas.org + Msg-ID: <1997Mar27.130247.1911552@hmivax.humgen.upenn.edu> + Date: Thu, 27 Mar 1997 13:02:46 -0500 (EST) + Files: toke.c + + Title: "Improve diagnostic on \r in program text" + From: Chip Salzenberg + Files: pod/perldiag.pod toke.c + + Title: "Make Sock_size_t typedef work right" + From: Chip Salzenberg + Files: perl.h pp_sys.c + + Title: "Eliminate unused dummy variable" + From: Doug MacEachern + Msg-ID: <199703270123.UAA25454@postman.osf.org> + Date: Wed, 26 Mar 1997 20:23:14 -0500 + Files: lib/ExtUtils/Embed.pm unixish.h writemain.SH + + BUILD PROCESS + + Title: "Allow for coexistence of various versions of perldiag.pod" + From: Chip Salzenberg + Files: installperl lib/diagnostics.pm + + LIBRARY AND EXTENSIONS + + Title: "New module constant.pm" + From: Tom Phoenix + Files: MANIFEST lib/constant.pm op.c pp.c t/pragma/constant.t + + Title: "Remove chat2" + From: Chip Salzenberg + Files: MANIFEST lib/chat2.inter lib/chat2.pl + + Title: "Include CGI.pm 2.32" + From: Chip Salzenberg + Files: MANIFEST eg/cgi/* lib/CGI.pm lib/CGI/Apache.pm + lib/CGI/Carp.pm lib/CGI/Fast.pm lib/CGI/Push.pm + lib/CGI/Switch.pm + + Title: "Fix C in debugger" + From: Ilya Zakharevich + Msg-ID: <199703312355.SAA01068@monk.mps.ohio-state.edu> + Date: Mon, 31 Mar 1997 18:55:55 -0500 (EST) + Files: lib/perl5db.pl + + Title: "Re: Pod problems & fixes" + From: Hallvard B Furuseth + Msg-ID: <199703261829.TAA17015@bombur2.uio.no> + Date: Wed, 26 Mar 1997 19:29:14 +0100 (MET) + Files: lib/Pod/Text.pm + + Title: "Re: $whoami calculation in Sys::Syslog.pm should not be greedy" + From: Roderick Schertler + Msg-ID: + Date: 29 Mar 1997 11:33:24 -0500 + Files: lib/Sys/Syslog.pm + + Title: "C doesn't always restore" + From: Spider Boardman + Msg-ID: <199703291906.OAA07232@Orb.Nashua.NH.US> + Date: Sat, 29 Mar 1997 14:06:37 -0500 + Files: lib/SelectSaver.pm + + Title: "Patch for Benchmark.pm" + From: Hugo van der Sanden w/Tim Bunce + Msg-ID: <199703291504.PAA01596@crypt.compulink.co.uk> + Date: Sat, 29 Mar 1997 15:04:32 +0000 + Files: lib/Benchmark.pm + + Title: "Tiny doc fix for AutoSplit.pm" + From: "Randy J. Ray" + Msg-ID: + Date: Thu, 27 Mar 1997 14:17:38 -0700 + Files: lib/AutoSplit.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Tom C's Pod::Html and html tools, as of 30 March 97" + From: Chip Salzenberg + Files: MANIFEST installhtml lib/Pod/Html.pm pod/pod2html.PL + + Title: "Fix path bugs in installhtml" + From: Robin Barker + Msg-ID: <3180.9703270906@tempest.cise.npl.co.uk> + Date: Thu, 27 Mar 97 09:06:14 GMT + Files: installhtml + + Title: "Make perlbug say that it's only for core Perl bugs" + From: Chip Salzenberg + Files: utils/perlbug.PL + + DOCUMENTATION + + Title: "INSTALL-1.11" + From: Andy Dougherty + Msg-ID: + Date: Wed, 26 Mar 1997 15:05:39 -0800 (PST) + Files: pod/perl.pod + + Title: "Document autouse and constant; update diagnostics" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "Suggest to upgraders that they try '-w' again" + From: Hallvard B Furuseth + Msg-ID: <199703251901.UAA15982@bombur2.uio.no> + Date: Tue, 25 Mar 1997 20:01:26 +0100 (MET) + Files: pod/perldelta.pod + + Title: "Improve and update documentation of constant subs" + From: Tom Phoenix + Msg-ID: + Date: Mon, 31 Mar 1997 13:05:54 -0800 (PST) + Files: pod/perlsub.pod + + Title: "Improve documentation of C" + From: Chip Salzenberg + Files: pod/perlfunc.pod pod/perlsub.pod + + Title: "perlfunc.pod patch" + From: Gisle Aas + Msg-ID: <199703262159.WAA17531@furubotn.sn.no> + Date: Wed, 26 Mar 1997 22:59:23 +0100 + Files: pod/perlfunc.pod + + Title: "Use 'while (defined($x = <>)) {}', per " + From: Chip Salzenberg + Files: configpm lib/Term/Cap.pm perlsh pod/perlipc.pod pod/perlop.pod + pod/perlsub.pod pod/perlsyn.pod pod/perltrap.pod + pod/perlvar.pod win32/bin/search.bat + + Title: "Document and test C<%> behavior with negative operands" + From: Chip Salzenberg + Files: pod/perlop.pod t/op/arith.t + + Title: "Update docs on $]" + From: Chip Salzenberg + Files: pod/perlvar.pod + + Title: "perlvar.pod patch" + From: Gisle Aas + Msg-ID: <199703261254.NAA10237@bergen.sn.no> + Date: Wed, 26 Mar 1997 13:54:00 +0100 + Files: pod/perlvar.pod + + Title: "Fix example of C vs. C<||>" + From: Chip Salzenberg + Files: pod/perlsyn.pod + + Title: "Pod usage and spelling patch" + From: Larry W. Virden + Files: pod/*.pod + + Title: "Pod updates" + From: "Cary D. Renzema" + Msg-ID: <199703262353.PAA01819@macs.mxim.com> + Date: Wed, 26 Mar 1997 15:53:22 -0800 (PST) + Files: pod/*.pod + + +---------------- +Version 5.003_95 +---------------- + + CORE LANGUAGE CHANGES + + Title: "Don't compile scalar mods of aggregates, like C<@a =~ s/a/b/>" + From: Chip Salzenberg + Files: op.c t/op/misc.t + + Title: "Automatically flush on C< $| = 1 >" + From: Chip Salzenberg + Files: mg.c + + Title: "Refine modulus ("%") per suggestion of Tim Goodwin" + From: Chip Salzenberg + Files: pp.c + + Title: "If C, do equivalent of C" + From: Chip Salzenberg + Files: toke.c + + Title: "Warn about undef magic values just like non-magic" + From: Chip Salzenberg + Files: ext/Opcode/Safe.pm sv.c t/lib/db-btree.t t/lib/db-hash.t + t/lib/db-recno.t t/pragma/locale.t + + CORE PORTABILITY + + Title: "Remove redundant patch to hints/bsdos.sh" + From: Shigeya Suzuki + Msg-ID: <19970322222244K.shigeya@foretune.co.jp> + Date: Sat, 22 Mar 1997 22:22:44 +0900 + Files: hints/bsdos.sh + + Title: "Another MachTen Patch" + From: Tom Phoenix + Msg-ID: + Date: Mon, 24 Mar 1997 15:26:48 -0800 (PST) + Files: hints/machten_2.sh + + Title: "Win32 update (five patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: MANIFEST README.win32 doio.c dosish.h pp_sys.c + lib/ExtUtils/Command.pm t/comp/multiline.t t/op/magic.t + t/op/mkdir.t t/op/runlevel.t t/op/stat.t t/op/write.t + win32/Makefile win32/config.H win32/config.w32 win32/win32.c + win32/win32.h win32/win32aux.c win32/*.mak win32/VC-2.0/*.mak + + OTHER CORE CHANGES + + Title: "Fix botch with G_NOARGS; PUSHMARK *is* required" + From: Chip Salzenberg + Files: perl.c + + Title: "Improve 'prototype mismatch' warning" + From: Chip Salzenberg + Files: global.sym op.c pod/perldiag.pod proto.h sv.c t/comp/redef.t + + Title: "In perlio, fix vprintf() definition and define vfprintf()" + From: Chip Salzenberg + Files: perlio.c + + BUILD PROCESS + + (no other changes) + + LIBRARY AND EXTENSIONS + + Title: "Fix C in Getopt::Long to work with 5.003" + From: Chip Salzenberg + Files: lib/Getopt/Long.pm + + Title: "Extraneous blank lines from Pod::Text" + From: Russ Allbery + Msg-ID: + Date: 25 Mar 1997 01:28:55 -0800 + Files: lib/Pod/Text.pm + + Title: "Exporting UNIVERSAL::can" + From: "M.J.T. Guy" + Msg-ID: + Date: Mon, 24 Mar 1997 17:54:01 +0000 + Files: lib/UNIVERSAL.pm + + Title: "Term::Readline patch for AmigaOS" + From: Norbert Pueschel + Msg-ID: <77724797@Armageddon.meb.uni-bonn.de> + Date: Sun, 23 Mar 1997 18:57:22 +0100 + Files: lib/Term/ReadLine.pm + + TESTS + + Title: "Reduce memory footprint of complex.t" + From: Dominic Dunlop + Msg-ID: + Date: Tue, 25 Mar 1997 15:39:26 +0100 + Files: t/lib/complex.t + + UTILITIES + + Title: "Improve pod2man diagnostic when NAME is invalid" + From: Chip Salzenberg + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "INSTALL-1.8 to INSTALL-1.9 updates" + From: Andy Dougherty + Msg-ID: fix" + From: Chip Salzenberg + Files: pod/perldelta.pod + + Title: "pods for subroutine argument autovivication" + From: "M.J.T. Guy" + Msg-ID: + Date: Mon, 24 Mar 1997 07:25:21 +0000 + Files: pod/perldelta.pod pod/perlsub.pod + + Title: "Missing item in perldiag" + From: "M.J.T. Guy" + Msg-ID: + Date: Sun, 23 Mar 1997 09:24:09 +0000 + Files: pod/perldiag.pod + + Title: "Mention and discourage use of term 'soft reference'" + From: Chip Salzenberg + Files: pod/perlref.pod + + Title: "Pod problems & fixes" + From: Hallvard B Furuseth + Msg-ID: <199703242031.VAA14997@bombur2.uio.no> + Date: Mon, 24 Mar 1997 21:31:51 +0100 (MET) + Files: INSTALL lib/Term/Complete.pm lib/subs.pm pod/perlcall.pod + pod/perldata.pod pod/perldiag.pod pod/perlembed.pod + pod/perlguts.pod pod/perlmod.pod pod/perlop.pod + pod/perlpod.pod pod/pod2html.PL + + Title: "DB_File documentation fix" + From: Paul Marquess + Msg-ID: <9703240854.AA08401@claudius.bfsec.bt.co.uk> + Date: Mon, 24 Mar 97 08:54:16 GMT + Files: ext/DB_File/DB_File.pm + + Title: "FAQ update" + From: Nathan Torkington + Files: pod/perlfaq*.pod + + +---------------- +Version 5.003_94 +---------------- + + CORE LANGUAGE CHANGES + + Title: "Defer creation of array and hash elements as parameters" + From: Chip Salzenberg + Files: dump.c global.sym mg.c op.c op.h perl.h pp.c pp_hot.c proto.h + sv.c + + Title: "New special literal: __PACKAGE__" + From: Chip Salzenberg + Files: keywords.pl pod/perldata.pod toke.c + + Title: "Ignore whitespace before +*? in //x" + From: Chip Salzenberg + Files: regcomp.c + + Title: "Abort compilation at C or C after errors" + From: Chip Salzenberg + Files: op.c pod/perldiag.pod t/pragma/subs.t + + Title: "allow C" + From: David Dyck + Msg-ID: <97Mar10.155517pst.35716-2@gateway.fluke.com> + Date: Mon, 10 Mar 1997 15:55:44 -0800 + Files: pp.c + + Title: "Regularize C, esp. when y is negative" + From: Chip Salzenberg + Files: pp.c + + Title: "Flush before C" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlfunc.pod pp_sys.c + + Title: "Close loopholes in prototype mismatch warning" + From: Chip Salzenberg + Files: op.c sv.c toke.c + + Title: "Warn on C" + From: Chip Salzenberg + Files: op.c pod/perldiag.pod + + Title: "Don't warn on C" + From: Chip Salzenberg + Files: toke.c + + CORE PORTABILITY + + Title: "Don't say 'static var = 1'" + From: Jarkko Hietaniemi + Msg-ID: <199703091319.PAA24714@alpha.hut.fi> + Date: Sun, 9 Mar 1997 15:19:57 +0200 (EET) + Files: malloc.c + + Title: "BSD/OS 3.0 hints" + From: Christopher Davis + Msg-ID: + Date: 14 Mar 1997 16:20:46 -0500 + Files: hints/bsdos.sh + + Title: "More MachTen hints" + From: Tom Phoenix + Msg-ID: + Date: Tue, 11 Mar 1997 22:00:55 -0500 (EST) + Files: lib/ExtUtils/MM_VMS.pm lib/Test/Harness.pm t/op/taint.t + utils/perlbug.PL vms/descrip.mms + + Title: "vmsish.t and related patches" + From: Charles Bailey + Msg-ID: <01IGQW3IP1KK005VFB@hmivax.humgen.upenn.edu> + Date: Fri, 21 Mar 1997 01:32:47 -0500 (EST) + Files: MANIFEST perl.h vms/descrip.mms vms/ext/vmsish.t vms/vms.c + + Title: "Win32 update (four patches)" + From: Gurusamy Sarathy and Nick Ing-Simmons + Files: MANIFEST README.win32 lib/AutoSplit.pm lib/Cwd.pm + lib/ExtUtils/Command.pm lib/ExtUtils/Install.pm + lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm + lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm + lib/ExtUtils/Mksymlists.pm lib/File/Basename.pm + lib/File/Path.pm mg.c t/comp/cpp.t t/comp/script.t t/harness + t/io/argv.t t/io/dup.t t/io/fs.t t/io/inplace.t + t/lib/filehand.t t/lib/io_dup.t t/lib/io_sel.t + t/lib/io_taint.t t/op/closure.t t/op/exec.t t/op/glob.t + t/op/goto.t t/op/magic.t t/op/misc.t t/op/rand.t + t/op/split.t t/op/stat.t t/op/sysio.t t/op/taint.t + t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t util.c + win32/* + + OTHER CORE CHANGES + + Title: "Guard against buffer overflow in yyerror() and related funcs" + From: Chip Salzenberg + Files: toke.c + + Title: "For bin compat, rename calllist() and he_{,delay}free" + From: Chip Salzenberg + Files: global.sym hv.c op.c perl.c pod/perlguts.pod proto.h + + Title: "Fix C on tied default handle" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix C" + From: Chip Salzenberg + Files: op.c + + Title: "Improve diagnostic on C<@a++>, C<--%a>, @a =~ s/a/b/" + From: Chip Salzenberg + Files: pp.c pp_hot.c + + Title: "Don't warn on C<$x{y} .= "z"> when %x is tied" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Eliminate 'unreachable code' warnings" + From: Chip Salzenberg + Files: ext/POSIX/POSIX.xs mg.c pp_ctl.c toke.c + + Title: "printf format corrections for -DDEBUGGING" + From: Roderick Schertler + Msg-ID: <26592.858793370@eeyore.ibcinc.com> + Date: Wed, 19 Mar 1997 12:42:50 -0500 + Files: doop.c malloc.c op.c pp_ctl.c regexec.c sv.c x2p/str.c + x2p/util.c + + Title: "Warn about missing -DMULTIPLICITY if likely a problem" + From: Doug MacEachern + Msg-ID: <199703192345.SAA15070@postman.osf.org> + Date: Wed, 19 Mar 1997 18:45:53 -0500 + Files: perl.c + + BUILD PROCESS + + Title: "Don't use $(LIBS) when creating shared libperl" + From: Chip Salzenberg + Files: Makefile.SH + + Title: "Don't use db 2.x, we're not yet ready for it" + From: Paul Marquess and Andy Dougherty + Files: Configure + + Title: "Warn if #! command is longer than 32 chars" + From: Chip Salzenberg + Files: Configure + + Title: "patches re perl -wc install{perl,man}" + From: Robin Barker + Msg-ID: <21544.9703111313@tempest.cise.npl.co.uk> + Date: Tue, 11 Mar 97 13:13:16 GMT + Files: installman installperl + + Title: "3_93 doesn't install pods" + From: Spider Boardman + Msg-ID: <199703160721.CAA08339@Orb.Nashua.NH.US> + Date: Sun, 16 Mar 1997 02:21:35 -0500 + Files: installperl + + Title: "When installing, use File::Copy instead of `cp`" + From: Chip Salzenberg + Files: installperl + + Title: "Make hint files' warnings more visible" + From: Hallvard B Furuseth + Msg-ID: <199703202218.XAA09041@bombur2.uio.no> + Date: Thu, 20 Mar 1997 23:18:03 +0100 (MET) + Files: hints/3b1.sh hints/apollo.sh hints/cxux.sh hints/dcosx.sh + hints/dgux.sh hints/esix4.sh hints/freebsd.sh hints/hpux.sh + hints/irix_4.sh hints/mips.sh hints/next_3_0.sh hints/os2.sh + hints/qnx.sh hints/sco_2_3_3.sh hints/sco_2_3_4.sh + hints/solaris_2.sh hints/ultrix_4.sh hints/utekv.sh + + LIBRARY AND EXTENSIONS + + Title: "New module: autouse.pm" + From: Ilya Zakharevich + Msg-ID: <199703210034.TAA13469@monk.mps.ohio-state.edu> + Date: Thu, 20 Mar 1997 19:34:30 -0500 (EST) + Files: MANIFEST lib/autouse.pm + + Title: "Math::Complex update" + From: Jarkko Hietaniemi + Files: lib/Math/Complex.pm t/lib/complex.t + + Title: "Refresh DB_File to 1.12" + From: Paul Marquess + Msg-ID: <9703121551.AA07435@claudius.bfsec.bt.co.uk> + Date: Wed, 12 Mar 97 15:51:14 GMT + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + Title: "New subroutine Symbol::qualify_to_ref()" + From: Roderick Schertler + Msg-ID: + Date: 11 Mar 1997 19:39:36 -0500 + Files: lib/Symbol.pm + + Title: "In debugger, don't reference %{$f{$g}} if $f{$g} doesn't exist" + From: Chip Salzenberg + Files: lib/perl5db.pl + + Title: "In File::Path, some systems can't remove read-only files" + From: Chip Salzenberg + Files: lib/File/Path.pm + + Title: "Fix typo in -l*perl* pattern" + From: Doug MacEachern + Msg-ID: <199703110414.XAA12884@berlin.atlantic.net> + Date: Mon, 10 Mar 1997 22:58:38 -0500 + Files: lib/ExtUtils/Embed.pm + + Title: "Fix bugs revealed by prototype warnings" + From: Chip Salzenberg + Files: ext/Opcode/Opcode.pm lib/ExtUtils/MakeMaker.pm + lib/Getopt/Long.pm + + Title: "Problems with SKIP in makemaker" + From: Ilya Zakharevich + Msg-ID: <199703210413.XAA21601@monk.mps.ohio-state.edu> + Date: Thu, 20 Mar 1997 23:13:31 -0500 (EST) + Files: lib/ExtUtils/MM_Unix.pm + + Title: "In Exporter, don't C at file scope" + From: Chip Salzenberg + Files: lib/Exporter.pm + + Title: "fix for Exporter's $SIG{__WARN__} handler" + From: Roderick Schertler + Msg-ID: <2282.858296451@eeyore.ibcinc.com> + Date: Thu, 13 Mar 1997 18:40:51 -0500 + Files: lib/Exporter.pm + + Title: "Don't try to substr() refs in Carp" + From: Chip Salzenberg + Files: lib/Carp.pm + + Title: "Re: NUL in die and other messages" + From: "M.J.T. Guy" + Msg-ID: + Date: Fri, 21 Mar 1997 09:58:17 +0000 + Files: lib/Carp.pm + + Title: "Add entry for prototype() in Pod::Functions" + From: Chip Salzenberg + Files: lib/Pod/Functions.pm + + Title: "Fix typos in IO::Socket documentation" + From: "M.J.T. Guy" + Msg-ID: + Date: Tue, 18 Mar 1997 20:50:16 +0000 + Files: ext/IO/lib/IO/Socket.pm + + TESTS + + (no other changes) + + UTILITIES + + Title: "Re: bug in pod2man (5.00326): section=3 for .pm modules" + From: Roderick Schertler + Msg-ID: + Date: 11 Mar 1997 19:09:31 -0500 + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "perlfaq.pod" + From: Tom Christiansen + Msg-ID: <199703172301.QAA12566@jhereg.perl.com> + Date: Mon, 17 Mar 1997 16:01:40 -0700 + Files: MANIFEST pod/Makefile pod/buildtoc pod/perl.pod + pod/perlfaq*.pod pod/roffitall + + Title: "*.pod changes based on the FAQ" + From: gnat@frii.com + Msg-ID: <199703171650.JAA02655@elara.frii.com> + Date: Mon, 17 Mar 1997 09:50:14 -0700 (MST) + Files: pod/perldata.pod pod/perlfunc.pod pod/perlipc.pod + pod/perlop.pod pod/perlre.pod pod/perlrun.pod + pod/perlsec.pod pod/perlvar.pod + + Title: "INSTALL: How to enable debugging" + From: Andy Dougherty + Msg-ID: + Date: Tue, 11 Mar 1997 17:55:05 -0500 + Files: pod/perldelta.pod + + Title: "Update site list" + From: lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <9703111053.AA20051@cas.org> + Date: Tue, 11 Mar 1997 10:53:49 -0500 + Files: pod/perlmod.pod + + Title: "Patch to document illegal characters" + From: Tom Phoenix + Msg-ID: + Date: Fri, 14 Mar 1997 09:08:10 -0800 (PST) + Files: pod/perldiag.pod pod/perltrap.pod + + Title: "Document trap with //o and closures" + From: Charles Bailey + Msg-ID: <01IGCHWRNSEU00661G@hmivax.humgen.upenn.edu> + Date: Mon, 10 Mar 1997 18:08:08 -0500 (EST) + Files: pod/perltrap.pod + + Title: "Re: Inline PI function" + From: Tom Phoenix + Msg-ID: + Date: Wed, 19 Mar 1997 07:28:57 -0800 (PST) + Files: pod/perlop.pod + + Title: "XSUB's doc fix" + From: Roderick Schertler + Msg-ID: <28804.858012126@eeyore.ibcinc.com> + Date: Mon, 10 Mar 1997 11:42:06 -0500 + Files: pod/perlcall.pod pod/perlguts.pod pod/perlxstut.pod + + Title: "Document return from do FILE" + From: "M.J.T. Guy" + Msg-ID: + Date: Tue, 18 Mar 1997 14:50:10 +0000 + Files: pod/perlfunc.pod + + Title: "Document $^M in perlvar" + From: Robin Barker + Msg-ID: <6153.9703202108@tempest.cise.npl.co.uk> + Date: Thu, 20 Mar 97 21:08:33 GMT + Files: pod/perlvar.pod + + Title: "typos in pods of 5.003_93" + From: Jim Meyering + Msg-ID: + Date: 19 Mar 1997 10:39:38 -0600 + Files: pod/perlfunc.pod pod/perlguts.pod pod/perlre.pod + pod/perltoot.pod pod/perlxs.pod + + Title: "Re: Updates to pod punctuations" + From: lvirden@cas.org (Larry W. Virden, x2487) + Msg-ID: <9703141700.AA22911@cas.org> + Date: Fri, 14 Mar 1997 17:00:12 -0500 + Files: pod/*.pod + + Title: "clarify example in perlfunc" + From: Jarkko Hietaniemi + Msg-ID: <199703201746.TAA25195@alpha.hut.fi> + Date: Thu, 20 Mar 1997 19:46:01 +0200 (EET) + Files: pod/perlfunc.pod + + Title: "Regularize headings in DB_File documentation" + From: Chip Salzenberg + Files: ext/DB_File/DB_File.pm + + +---------------- +Version 5.003_93 +---------------- + +Me, last time: + "This release will be the public beta of 5.004, + or my name isn't Larson T. Pettifogger." +Me, now: + "Gone like *that*, a fortune in letterhead." + + CORE LANGUAGE CHANGES + + Title: "Don't autovivify array and hash elements in sub parameters" + From: Gurusamy Sarathy + Msg-ID: <199703061912.OAA20606@aatma.engin.umich.edu> + Date: Thu, 06 Mar 1997 14:12:09 -0500 + Files: op.c pod/perldelta.pod pod/perlsub.pod pod/perltrap.pod + + Title: "Support READ and GETC for tied handles" + From: Doug MacEachern + Msg-ID: <199703090019.TAA32591@postman.osf.org> + Date: Sat, 08 Mar 1997 19:19:38 -0500 + Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t + + Title: "Warn on C<@x =~ /a/> and C<%x =~ s/a/b/>" + From: Chip Salzenberg + Files: op.c pod/perldiag.pod + + Title: "Warn on %{+undef} and @{+undef}" + From: Chip Salzenberg + Files: pp.c pp_hot.c + + CORE PORTABILITY + + Title: "VMS update" + From: Charles Bailey + Msg-ID: <01IG8KN5R28M00661G@hmivax.humgen.upenn.edu> + Date: Fri, 07 Mar 1997 22:49:46 -0500 (EST) + Files: lib/ExtUtils/MM_VMS.pm vms/descrip.mms vms/gen_shrfls.pl + vms/sockadapt.h + + Title: "AmigaOS hint patch" + From: Norbert Pueschel + Msg-ID: <77724767@Armageddon.meb.uni-bonn.de> + Date: Sat, 08 Mar 1997 12:50:15 +0100 + Files: hints/amigaos.sh + + OTHER CORE CHANGES + + Title: "Make conversion of @_ to real array work right after C" + From: Chip Salzenberg + Files: av.c + + Title: "Fix imbalanced ENTER/LEAVE from C" + From: Chip Salzenberg + Files: op.c perl.c proto.h + + Title: "perl -P path patch" + From: Andy Dougherty + Msg-ID: + Date: Thu, 6 Mar 97 16:28 GMT0 + Files: Configure + + Title: "Allow './Configure -Uoptimize'" + From: Andy Dougherty + Msg-ID: + Date: Fri, 7 Mar 1997 19:53:00 -0500 + Files: Configure + + Title: "Don't count on 'trap 0' inside () in shell script" + From: aburlison@cix.compulink.co.uk (Alan Burlison) + Msg-ID: + Date: Thu, 6 Mar 97 16:28 GMT0 + Files: perl_exp.SH + + LIBRARY AND EXTENSIONS + + Title: "Carp with multiple arguments" + From: "M.J.T. Guy" + Msg-ID: + Date: Sat, 8 Mar 1997 20:12:17 +0000 + Files: lib/Carp.pm + + Title: "@EXPORT_FAIL fix for Exporter.pm" + From: Roderick Schertler + Msg-ID: <24884.857841724@eeyore.ibcinc.com> + Date: Sat, 08 Mar 1997 12:22:04 -0500 + Files: lib/Exporter.pm + + Title: "Open[23] autoflush docs" + From: Roderick Schertler + Msg-ID: <7939.857693947@eeyore.ibcinc.com> + Date: Thu, 06 Mar 1997 19:19:07 -0500 + Files: lib/IPC/Open2.pm lib/IPC/Open3.pm + + TESTS + + Title: "Fix counts in output of TEST" + From: Hugo van der Sanden + Msg-ID: <331F1507.4BE8@iii.co.uk> + Date: Thu, 06 Mar 1997 19:03:35 +0000 + Files: t/TEST + + Title: "Ignore backup files in strict.t and warning.t" + From: Chip Salzenberg + Files: t/pragma/strict.t t/pragma/warning.t + + UTILITIES + + Title: "Quote pathname before using as pattern" + From: Chip Salzenberg + Files: pod/pod2html.PL + + DOCUMENTATION + + Title: "Consolidated INSTALL updates since _92" + From: Andy Dougherty + Msg-ID: + Date: Sat, 8 Mar 1997 00:37:30 -0500 (EST) + Files: README.os2 + + Title: "PODs corrections" + From: Ilya Zakharevich + Msg-ID: <199703080253.VAA24975@monk.mps.ohio-state.edu> + Date: Fri, 7 Mar 1997 21:53:04 -0500 (EST) + Files: ext/DB_File/DB_File.pm ext/Socket/Socket.pm + lib/Class/Template.pm lib/ExtUtils/Embed.pm + lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Mksymlists.pm + lib/File/Basename.pm lib/File/stat.pm lib/Time/gmtime.pm + lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm + lib/User/pwent.pm pod/perlcall.pod pod/perldebug.pod + pod/perlfunc.pod pod/perlguts.pod pod/perllocale.pod + pod/perlop.pod pod/perlsub.pod + + +---------------- +Version 5.003_92 +---------------- + +This release will be the public beta of 5.004, or my name isn't +Larson T. Pettifogger. + + CORE LANGUAGE CHANGES + + Title: "Strictly follow lexical context of C and nested subs" + From: Chip Salzenberg + Files: op.c + + Title: "Make ::SUPER and UNIVERSAL work together" + From: Chip Salzenberg + Files: gv.c pod/perlguts.pod + + CORE PORTABILITY + + Title: "HP-UX hint update" + From: Raphael Manfredi + Msg-ID: <1479.857653838@lyon.grenoble.hp.com> + Date: Thu, 06 Mar 97 14:10:38 +0100 + Files: hints/hpux.sh + + Title: "Re: The continuing MachTen saga" + From: Tom Phoenix + Msg-ID: + Date: Wed, 5 Mar 1997 09:47:22 -0800 (PST) + Files: hints/machten_2.sh + + Title: "OS/2 patches" + From: Ilya Zakharevich + Msg-ID: <199703060308.WAA22211@monk.mps.ohio-state.edu> + Date: Wed, 5 Mar 1997 22:08:43 -0500 (EST) + Files: hints/os2.sh lib/ExtUtils/MakeMaker.pm t/op/taint.t + + Title: "VMS patches" + From: Charles Bailey + Msg-ID: <01IG5SQE4A6U00661G@hmivax.humgen.upenn.edu> + Date: Wed, 05 Mar 1997 23:10:24 -0500 (EST) + Files: lib/ExtUtils/MM_VMS.pm lib/ExtUtils/Manifest.pm perlsdio.h + t/op/runlevel.t t/op/taint.t vms/descrip.mms vms/perly_c.vms + vms/sockadapt.c vms/sockadapt.h vms/vms_yfix.pl + + OTHER CORE CHANGES + + Title: "Make sure $^X is tainted when ARG_ZERO_IS_SCRIPT" + From: Chip Salzenberg + Files: toke.c + + Title: "Clarify '-T too late' error" + From: Chip Salzenberg + Files: perl.c pod/perldiag.pod + + Title: "Warn when redefining or undefining a constant sub" + From: Chip Salzenberg + Files: pod/perldiag.pod pp.c sv.c + + Title: "Don't generate spurious 'not imported' warning" + From: Chip Salzenberg + Files: gv.c t/pragma/strict-vars pod/perldiag.pod + + Title: "Clarify message re: @host in string" + From: Chip Salzenberg + Files: pod/perldiag.pod pod/perltrap.pod toke.c + + Title: "Disconnect refs that are targets of pp_readline" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix typo in test of HvFILL()" + From: Chip Salzenberg + Files: op.c + + Title: "Allow for pad name array to be shorter than pad array" + From: Chip Salzenberg + Files: op.c + + Title: "Eliminate format-string type warnings" + From: Hallvard B Furuseth + Msg-ID: <199703030915.KAA11634@bombur2.uio.no> + Date: Mon, 3 Mar 1997 10:15:11 +0100 (MET) + Files: doio.c ext/POSIX/POSIX.xs gv.c hints/dec_osf.sh pp.c pp_ctl.c + pp_hot.c run.c sv.c x2p/a2py.c + + Title: "Update copyright dates" + From: Chip Salzenberg + Files: *.[hc] x2p/*.[hc] win32/EXTERN.h vms/vmsish.h vms/vms.c + + BUILD PROCESS + + Title: "near-harmless bug in _91's Configure" + From: Roderick Schertler + Msg-ID: + Date: 01 Mar 1997 21:26:49 -0500 + Files: Configure + + Title: "Change 'continuing anyway' to 'probably harmless'" + From: Chip Salzenberg + Files: INSTALL lib/ExtUtils/Liblist.pm + + LIBRARY AND EXTENSIONS + + Title: "Newer ReadLine" + From: Ilya Zakharevich + Msg-ID: <199703040634.BAA19919@monk.mps.ohio-state.edu> + Date: Tue, 4 Mar 1997 01:34:28 -0500 (EST) + Files: lib/Term/ReadLine.pm lib/perl5db.pl + + Title: "Refresh Getopt::Long to 2.9" + From: Johan Vromans + Files: lib/Getopt/Long.pm + + Title: "Benchmark: using code refs" + From: Hugo van der Sanden + Msg-ID: <199703041132.LAA07613@tyree.iii.co.uk> + Date: Tue, 04 Mar 1997 11:32:11 +0000 + Files: lib/Benchmark.pm + + Title: "Fix quotewords" + From: Hugo van der Sanden + Msg-ID: <199703060755.HAA15060@crypt.compulink.co.uk> + Date: Thu, 06 Mar 1997 07:55:25 +0000 + Files: lib/Text/ParseWords.pm + + Title: "Use IV instead of double for tms structure members" + From: Chip Salzenberg + Files: ext/POSIX/POSIX.xs + + Title: "Document IO::File::new_tmpfile" + From: Chip Salzenberg + Files: ext/IO/lib/IO/File.pm + + TESTS + + Title: "Make op/TEST silent under -w" + From: d-lewart@uiuc.edu (Daniel S. Lewart) + Msg-ID: <199703011821.NAA13037@sinistar.idle.com> + Date: Sat, 1 Mar 97 12:04:09 CST + Files: t/TEST + + Title: "Smarter t/op/taint.t" + From: Tom Phoenix + Msg-ID: + Date: Sun, 2 Mar 1997 16:25:03 -0800 (PST) + Files: pod/pod2html.PL + + Title: "Support 'long long' in h2ph" + From: (name lost) + Files: utils/h2ph.PL + + DOCUMENTATION + + Title: "Add taint checks and srand to perldelta" + From: Tom Phoenix + Msg-ID: + Date: Sat, 01 Mar 1997 10:32:31 -0700 + Files: pod/perlmod.pod + + Title: "Clarify C documentation" + From: Tom Phoenix + Msg-ID: + Date: Sun, 2 Mar 1997 16:54:22 +0200 (EET) + Files: pod/perlmod.pod + + Title: "Enhance description of 'server error'" + From: Jarkko Hietaniemi + Msg-ID: <199702041903.VAA16070@alpha.hut.fi> + Date: Tue, 4 Feb 1997 21:03:23 +0200 (EET) + Files: pod/perldiag.pod + + Title: "Regularize format of E-Mail addresses in *.pod" + From: Chip Salzenberg + Files: pod/*.pod + + +---------------- +Version 5.003_91 +---------------- + +This is (should be? must be!) the public beta of 5.004. + + CORE LANGUAGE CHANGES + + Title: "Fix perl_call_*() when !G_EVAL" + From: Gurusamy Sarathy + Msg-ID: <199702250725.CAA09192@aatma.engin.umich.edu>, + <199702251925.OAA15498@aatma.engin.umich.edu>, + <199702252200.RAA16853@aatma.engin.umich.edu> + Date: Tue, 25 Feb 1997 02:25:56 -0500 + Files: MANIFEST gv.c interp.sym perl.c perl.h pp_ctl.c pp_sys.c + t/op/runlevel.t + + Title: "Fix taint tests for writeable dirs in $ENV{PATH}" + From: Chip Salzenberg + Files: mg.c mg.h pod/perlsec.pod taint.c + + Title: "Forbid tainted parameters for truncate()" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "Don't taint magic hash keys unnecessarily" + From: Charles Bailey + Msg-ID: <01IFXL9TY74Y00661G@hmivax.humgen.upenn.edu> + Date: Fri, 28 Feb 1997 02:11:26 -0500 (EST) + Files: hv.c + + CORE PORTABILITY + + Title: "VMS patches post _90" + From: Charles Bailey + Msg-ID: <01IFYDE5ZT7O005A53@hmivax.humgen.upenn.edu> + Date: Fri, 28 Feb 1997 15:26:33 -0500 (EST) + Files: doio.c mg.c perl.h pp_hot.c t/op/rand.t t/op/taint.t taint.c + vms/descrip.mms vms/vms.c + + Title: "Fix taint check in system() and exec() under VMS and OS/2" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "If _XOPEN_VERSION >= 4, socket length parameters are size_t" + From: Michael H. Moran + Files: perl.h pp_sys.c + + Title: "Make dooneliner() compile again" + From: Chip Salzenberg + Files: pp_sys.c + + OTHER CORE CHANGES + + Title: "Short-circuit duplicate study() calls" + From: Chip Salzenberg + Files: pp.c + + Title: "Call sv_set[iu]v() with [IU]V parameter, not [IU]32" + From: Chip Salzenberg + Files: perl.c pp.c pp_sys.c toke.c util.c + + Title: "Clean up and document API for hashes" + From: Gurusamy Sarathy + Msg-ID: <199702251824.NAA14859@aatma.engin.umich.edu> + Date: Tue, 25 Feb 1997 13:24:02 -0500 + Files: hv.c hv.h pod/perldelta.pod pod/perlguts.pod + + Title: "pp_undef was not always freeing memory" + From: Ilya Zakharevich + Msg-ID: <199702270653.BAA13949@monk.mps.ohio-state.edu> + Date: Thu, 27 Feb 1997 01:53:51 -0500 (EST) + Files: pp.c + + Title: "Fix SEGV when debugging with foreach() lvalue patch" + From: Ilya Zakharevich + Msg-ID: <199702271924.OAA14557@monk.mps.ohio-state.edu> + Date: Thu, 27 Feb 1997 14:24:36 -0500 (EST) + Files: sv.c + + Title: "Don't examine rx->exec_tainted if pregexec() fails" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Silence bogus typo warning on $DB::postponed" + From: Gurusamy Sarathy + Msg-ID: <199702271802.NAA12505@aatma.engin.umich.edu> + Date: Thu, 27 Feb 1997 13:02:30 -0500 + Files: op.c + + BUILD PROCESS + + Title: "Sanity check linking with $libs" + From: Andy Dougherty + Msg-ID: + Date: Tue, 25 Feb 1997 14:13:45 -0500 (EST) + Files: Configure + + Title: "Flush stdout when printing $randbits guess" + From: Chip Salzenberg + Files: Configure + + Title: "Configure changes for Irix nm" + From: Helmut Jarausch and Fabien Tassin + Files: Configure + + Title: "Update OS/2 Configure diff" + From: Ilya Zakharevich + Msg-ID: <199702251906.OAA10608@monk.mps.ohio-state.edu> + Date: Tue, 25 Feb 1997 14:06:23 -0500 (EST) + Files: os2/diff.configure + + LIBRARY AND EXTENSIONS + + Title: "Don't require() in a signal handler" + From: Chip Salzenberg + Files: lib/perl5db.pl + + Title: "Make IPC::Open3 work without fork()" + From: Ilya Zakharevich + Msg-ID: <199702251937.OAA10718@monk.mps.ohio-state.edu> + Date: Tue, 25 Feb 1997 14:37:07 -0500 (EST) + Files: lib/IPC/Open3.pm + + Title: "Follow up on elimination of $` $& $' in libraries" + From: "M.J.T. Guy" + Msg-ID: + Date: Fri, 28 Feb 1997 13:59:42 +0000 + Files: lib/Getopt/Long.pm lib/diagnostics.pm + + Title: "Don't warn on use of CCFLAGS" + From: Andreas Koenig + Msg-ID: <199702251038.LAA13123@anna.in-berlin.de> + Date: Tue, 25 Feb 1997 11:38:43 +0100 + Files: lib/ExtUtils/MakeMaker.pm + + Title: "Allow explicit '-lperl' in link arguments" + From: Doug MacEachern + Msg-ID: <199702271625.LAA25402@postman.osf.org> + Date: Thu, 27 Feb 1997 11:25:04 -0500 + Files: lib/ExtUtils/Embed.pm + + TESTS + + Title: "New test op/taint.t" + From: Tom Phoenix + Msg-ID: , Chip Salzenberg + Files: pod/pod2man.PL utils/perldoc.PL + + Title: "Eliminate dead code in pod2man" + From: Chip Salzenberg + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "Warn about intrusive sfio behavior" + From: Andy Dougherty + Msg-ID: + Files: pod/perlrun.pod + + Title: "Fix references to perlbug" + From: Chip Salzenberg + Files: pod/perl.pod pod/perldelta.pod pod/perllocale.pod + pod/perltoc.pod + + +---------------- +Version 5.003_90 +---------------- + +At last, a mil[le]stone: The first beta of Perl 5.004. + + CORE LANGUAGE CHANGES + + Title: "Automatically call srand() before rand() if user didn't" + From: Chip Salzenberg + Files: pod/perlfunc.pod pp.c + + CORE PORTABILITY + + Title: "Ultrix hints" + From: Spider Boardman + Msg-ID: <199702220951.EAA08156@Orb.Nashua.NH.US> + Date: Sat, 22 Feb 1997 04:51:48 -0500 + Files: hints/ultrix_4.sh + + Title: "Digital UNIX and 3_28" + From: Jarkko Hietaniemi + Msg-ID: <199702231427.QAA13807@alpha.hut.fi> + Date: Sun, 23 Feb 1997 16:27:19 +0200 (EET) + Files: Configure MANIFEST ext/NDBM_File/hints/dec_osf.pl + ext/ODBM_File/hints/dec_osf.pl hints/dec_osf.sh + + Title: "AmigaOS patches to 5.003_28" + From: Norbert Pueschel + Msg-ID: <77724759@Armageddon.meb.uni-bonn.de> + Date: Sat, 22 Feb 1997 18:08:02 +0100 + Files: README.amiga hints/amigaos.sh t/io/fs.t t/lib/anydbm.t + t/lib/db-btree.t t/lib/db-hash.t t/lib/db-recno.t + t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t + t/op/magic.t t/op/stat.t + + Title: "Hints for DC/OSx" + From: Stephen Zander + Msg-ID: <199702242124.NAA03796@wsuse5.mckesson.com> + Date: Mon, 24 Feb 1997 13:24:54 -0800 + Files: hints/dcosx.sh + + Title: "Update VMS version" + From: Chip Salzenberg + Files: vms/config.vms vms/descrip.mms + + OTHER CORE CHANGES + + Title: "Don't assume that sizeof(int) >= sizeof(void*)" + From: Chip Salzenberg + Files: doio.c malloc.c regexec.c + + BUILD PROCESS + + Title: "Re: ccdlflags don't quite work" + From: Andy Dougherty + Msg-ID: + Date: Mon, 24 Feb 1997 08:42:59 -0500 + Files: installperl + + Title: "installperl breaks running system (for a while)" + From: Spider Boardman + Msg-ID: <199702241412.JAA11829@Orb.Nashua.NH.US> + Date: Mon, 24 Feb 1997 09:12:11 -0500 + Files: installperl + + LIBRARY AND EXTENSIONS + + Title: "Don't clobber $1 et al in debugger's DB::sub()" + From: Ilya Zakharevich + Files: lib/perl5db.pl + + Title: "Fix fd leak in IO::Pipe" + From: Roderick Schertler + Msg-ID: + Date: 23 Feb 1997 14:29:57 -0500 + Files: ext/IO/lib/IO/Pipe.pm + + Title: "Pod::Text fixes" + From: Roderick Schertler + Msg-ID: <350.856634588@eeyore.ibcinc.com> + Date: Sat, 22 Feb 1997 13:03:08 -0500 + Files: lib/Pod/Text.pm + + Title: "Trivial patch to make ExtUtils::Install more -w clean" + From: Tim Bunce + Msg-ID: <9702241605.AA17436@toad.ig.co.uk> + Date: Mon, 24 Feb 1997 16:05:17 +0000 + Files: lib/ExtUtils/Install.pm + + Title: "C didn't work until 5.002" + From: Chip Salzenberg + Files: lib/vars.pm + + TESTS + + Title: "More thoroughly test rand() and srand()" + From: Tom Phoenix + Files: t/op/rand.t + + Title: "Don't use <*> where readdir() will do" + From: Chip Salzenberg + Files: t/op/stat.t + + Title: "Allow for $^X to be 'miniperl'" + From: Dominic Dunlop + Msg-ID: + Date: Sun, 23 Feb 1997 16:22:45 +0100 + Files: t/op/magic.t + + UTILITIES + + Title: "Post-28 INSTALL updates" + From: Andy Dougherty + Msg-ID: + Date: Mon, 24 Feb 1997 17:29:30 -0500 + Files: pod/perlsub.pod pod/perltrap.pod + + Title: "Add documentation and '-h' option to perlbug" + From: Gurusamy Sarathy + Msg-ID: <199702240854.DAA27128@aatma.engin.umich.edu> + and <199702242009.PAA02849@aatma.engin.umich.edu> + Date: Mon, 24 Feb 1997 + Files: pod/perl.pod pod/perldelta.pod installman + utils/perlbug.PL + + Title: "pumpkin-1.9.pod" + From: Andy Dougherty + Msg-ID: undefine &foo" + From: Chip Salzenberg + Files: op.c + + Title: "Make code, doc agree on $ENV{PATH} and `cmd`" + From: Chip Salzenberg + Files: pod/perlsec.pod pp_sys.c + + Title: "Don't taint $x in C<$x = ($tainted =~ /(\w+)/)>" + From: Chip Salzenberg + Files: pp_ctl.c pp_hot.c + + Title: "Turn off 'expression tainted' flag at end of runops()" + From: Chip Salzenberg + Files: run.c + + Title: "When overloading, don't throw away nomethod's value" + From: Ilya Zakharevich + Files: gv.c + + Title: "Optimize keys() and values() in void context" + From: Chip Salzenberg + Files: doop.c op.c + + CORE PORTABILITY + + Title: "New hints for Digital UNIX" + From: Jarkko Hietaniemi + Files: hints/dec_osf.sh + + Title: "No version of AIX has working setre[ug]id()" + From: neufeld@fast.pvi.org (Keith Neufeld) + Files: hints/aix.sh + + Title: "VMS patches post _27" + From: Charles Bailey + Msg-ID: <01IFMEMPN1IU0057E2@hmivax.humgen.upenn.edu> + Date: Thu, 20 Feb 1997 01:58:46 -0500 (EST) + Files: MANIFEST dosish.h hv.c lib/ExtUtils/MM_VMS.pm + lib/ExtUtils/xsubpp perl.c perlsdio.h pod/perldelta.pod + pod/perlvar.pod t/op/closure.t unixish.h vms/Makefile + vms/descrip.mms vms/ext/filespec.t vms/genconfig.pl + vms/vms.c vms/vmsish.h + + Title: "Re: OS/2 patch for _27" + From: Ilya Zakharevich + Msg-ID: <199702210024.TAA03174@monk.mps.ohio-state.edu> + Date: Thu, 20 Feb 1997 19:24:16 -0500 (EST) + Files: INSTALL README.os2 lib/Test/Harness.pm os2/Changes + os2/OS2/PrfDB/t/os2_prfdb.t os2/os2.c os2/os2ish.h + os2/perl2cmd.pl perl.c pod/perldelta.pod t/TEST t/harness + t/op/magic.t + + OTHER CORE CHANGES + + Title: "Fix a typo" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "Undo signal patch -- it broke die() in signal" + From: Chip Salzenberg + Files: mg.c + + Title: "Fix perl_call_sv(..., G_NOARGS)" + From: Chip Salzenberg + Files: perl.c + + Title: "Fix SIGSEGV when cloning sub with complex expression" + From: Chip Salzenberg + Files: op.c + + Title: "Minor update to malloc.c" + From: Ilya Zakharevich + Msg-ID: <199702210244.VAA03676@monk.mps.ohio-state.edu> + Date: Thu, 20 Feb 1997 21:44:13 -0500 (EST) + Files: malloc.c + + Title: "Fix the Tolkien quotation" + From: Chip Salzenberg + Files: perly.y + + BUILD PROCESS + + (no changes) + + LIBRARY AND EXTENSIONS + + Title: "Debugger patch" + From: Ilya Zakharevich + Msg-ID: <199702210737.CAA03951@monk.mps.ohio-state.edu> + Date: Fri, 21 Feb 1997 02:37:59 -0500 (EST) + Files: lib/perl5db.pl + + Title: "Avoid $` $& $' in libraries" + From: Ilya Zakharevich + Msg-ID: <199702210207.VAA03560@monk.mps.ohio-state.edu> + Date: Thu, 20 Feb 1997 21:07:30 -0500 (EST) + Files: lib/Getopt/Long.pm lib/Pod/Text.pm lib/diagnostics.pm + os2/OS2/REXX/REXX.pm + + Title: "Remove redundant clearerr() from IO::Seekable" + From: Chip Salzenberg + Files: ext/IO/lib/IO/Handle.pm ext/IO/lib/IO/Seekable.pm + + Title: "prototype error in File::stat" + From: Graham.Barr@tiuk.ti.com + Msg-ID: <199702180748.HAA14151@ultra-boy> + Date: Tue, 18 Feb 1997 07:48:40 GMT + Files: lib/File/stat.pm + + TESTS + + Title: "Include 'study' in regexp.t" + From: Chip Salzenberg + Files: t/op/regexp.t + + Title: "Don't run locale test if -DNO_LOCALE" + From: Chip Salzenberg + Files: t/pragma/locale.t + + Title: "Tweak tests to notice $dont_use_nlink" + From: Chip Salzenberg + Files: t/io/fs.t t/op/stat.t + + Title: "Add test for grep() and wantarray" + From: Hugo van der Sanden + Msg-ID: <199702181105.LAA17895@tyree.iii.co.uk> + Date: Tue, 18 Feb 1997 11:05:59 +0000 + Files: t/op/misc.t + + UTILITIES + + (no changes) + + DOCUMENTATION + + Title: "INSTALL updates since _26" + From: Andy Dougherty + Msg-ID: " + From: Chip Salzenberg + Files: pod/perlop.pod + + Title: "Correct doc that claimed that was never false" + From: Chip Salzenberg + Files: pod/perldelta.pod pod/perlop.pod + + Title: "Document C<$?> vs. $SIG{CHLD}" + From: Ulrich Pfeifer + Files: pod/perlvar.pod + + Title: "Add pumpkin.pod" + From: Chip Salzenberg + Files: MANIFEST Porting/pumpkin.pod + + Title: "Don't say "associat*ve arr*y"" + From: Chip Salzenberg + Files: MANIFEST gv.h hv.c lib/Env.pm lib/overload.pm opcode.pl + pod/perl.pod pod/perldelta.pod pod/perldiag.pod + pod/perlfunc.pod pod/perlguts.pod pod/perlmod.pod + pod/perltie.pod pod/perltoc.pod pod/perltrap.pod x2p/a2p.pod + + +---------------- +Version 5.003_27 +---------------- + +This release is beta candidate #5: Our last, best hope for a beta. + + CORE LANGUAGE CHANGES + + Title: "Better looks_like_number() function [sv.c]" + From: Gisle Aas + Msg-ID: <199702141708.SAA17546@bergen.sn.no> + Date: Fri, 14 Feb 1997 18:08:52 +0100 + Files: sv.c + + Title: "Remove redundant functions UNIVERSAL::{class,is_instance}" + From: Gisle Aas + Msg-ID: + Date: 14 Feb 1997 15:52:21 +0000 + Files: pod/perldelta.pod pod/perlobj.pod t/op/universal.t universal.c + + Title: "Allow C" + From: Roderick Schertler + Msg-ID: + Date: 16 Feb 1997 23:19:12 -0500 + Files: pp_sys.c + + Title: "Fix syntax error on C<&$1>" + From: Chip Salzenberg + Files: toke.c + + Title: "Fix sub call through magic var (e.g. C<&$1>)" + From: Chip Salzenberg + Files: pp_hot.c + + Title: "Fix grep() with refs in array context" + From: Chip Salzenberg + Files: pp.c + + CORE PORTABILITY + + Title: "Eliminate $^S; add C" + From: Charles Bailey + Msg-ID: <01IFI9CFKL0S004R2V@hmivax.humgen.upenn.edu> + Date: Mon, 17 Feb 1997 02:45:26 -0500 (EST) + Files: MANIFEST gv.c lib/English.pm lib/ExtUtils/MM_VMS.pm + lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp mg.c op.c + perl.c perl.h pod/perldelta.pod pod/perlmod.pod + pod/perlvar.pod pp_ctl.c pp_sys.c utils/perldoc.PL + vms/Makefile vms/config.vms vms/descrip.mms + vms/ext/Stdio/Stdio.pm vms/ext/Stdio/Stdio.xs + vms/ext/XSSymSet.pm vms/ext/vmsish.pm vms/vms.c vms/vmsish.h + win32/makedef.pl + + Title: "Eliminate FP exceptions under SCO 5" + From: Chip Salzenberg + Files: hints/sco.sh unixish.h + + Title: "Digital UNIX hints" + From: Jarkko Hietaniemi + Msg-ID: <199702151906.VAA22999@alpha.hut.fi> + Date: Sat, 15 Feb 1997 21:06:33 +0200 (EET) + Files: hints/dec_osf.sh + + Title: "Irix6.4 (with 7.1 compilers)" + From: John Stoffel + Msg-ID: <199702130238.VAA24468@jfs.Fluent.COM> + Date: Wed, 12 Feb 1997 21:38:51 -0500 (EST) + Files: hints/irix_6_2.sh hints/irix_6_4.sh + + Title: "Update Plan 9, Win32, VMS configs with $shortsize and $longsize" + From: Chip Salzenberg + Files: plan9/config.plan9 plan9/genconfig.pl + vms/genconfig.pl win32/config.w32 + + OTHER CORE CHANGES + + Title: "Fix core dump when embedding" + From: Chip Salzenberg + Files: perl.c + + Title: "Re: Fragile signals" + From: Ilya Zakharevich + Msg-ID: <199702130644.BAA07572@monk.mps.ohio-state.edu> + Date: Thu, 13 Feb 1997 01:44:39 -0500 (EST) + Files: mg.c + + Title: "Make format strings correspond exactly to parameters" + From: Roderick Schertler + Msg-ID: + Date: 13 Feb 1997 17:24:31 -0500 + Files: doio.c ext/DB_File/DB_File.xs ext/Opcode/Opcode.xs gv.c op.c + perl.c pp_ctl.c pp_sys.c regcomp.c toke.c + + Title: "Don't try to attach 'o' magic to read-only values" + From: Chip Salzenberg + Files: sv.c + + Title: "Fix carriage-return message" + From: Chip Salzenberg + Files: toke.c + + Title: "In <=>, test for equality first" + From: Chip Salzenberg + Files: pp.c + + Title: "Don't mark sv_{true,false} PADTMP" + From: Chip Salzenberg + Files: op.c + + BUILD PROCESS + + Title: "Fix eval "" in Configure" + From: allen@gateway.grumman.com (John L. Allen) + Msg-ID: <9702141809.AA17001@gateway.grumman.com> + Date: Fri, 14 Feb 1997 13:09:53 -0500 + Files: Configure + + Title: "Don't link with -lsfio if sfio is not requested" + From: Chip Salzenberg + Files: Configure + + Title: "perl5.003_26 Configure change "win" for AIX 4" + From: Tim Mooney + Msg-ID: + Date: 10 Feb 1997 18:38:45 +0100 + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "Update To-Do list" + From: Tim Bunce + Msg-ID: <9702101900.AA25293@toad.ig.co.uk> + Date: Mon, 10 Feb 1997 19:00:59 +0000 + Files: Todo + + Title: "Fix formatting in perldiag" + From: Chip Salzenberg + Files: pod/perldiag.pod + + +---------------- +Version 5.003_26 +---------------- + +This release is beta candidate #4. "Once more, dear friends...." + + CORE LANGUAGE CHANGES + + Title: "Make \r in script an error (per Larry)" + From: Chip Salzenberg + Files: pod/perldiag.pod toke.c + + Title: "Support '%i' format and 'h' modifier in s?printf" + From: Chip Salzenberg + Files: doop.c pod/perldelta.pod + + CORE PORTABILITY + + Title: "Fix value of system() and $? for DEC UNIX, VMS, others" + From: Chip Salzenberg + Files: mg.c perl.h pp_sys.c + + Title: "VMS patches post _25" + From: Charles Bailey + Msg-ID: <01IF48W3P39W0050BD@hmivax.humgen.upenn.edu> + Date: Fri, 07 Feb 1997 01:56:12 -0500 (EST) + Files: Porting/Glossary lib/ExtUtils/Liblist.pm + lib/ExtUtils/MM_VMS.pm lib/ExtUtils/xsubpp perl.c + vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl + vms/perlvms.pod vms/vms.c vms/vmsish.h x2p/a2p.c + + Title: "Hints for BSDOS" + From: Christopher Davis + Msg-ID: <199702042011.PAA09206@loiosh.kei.com> + Date: Tue, 4 Feb 1997 15:11:13 -0500 (EST) + Files: hints/bsdos.sh + + Title: "On C, call C" + From: Chip Salzenberg + Files: doio.c + + OTHER CORE CHANGES + + Title: "Fix (yet another) Tk closure problem" + From: Chip Salzenberg + Files: op.c perl.c pp_ctl.c + + Title: "Fix value of C" + From: Chip Salzenberg + Files: cop.h pp_ctl.c + + Title: "Regexp optimizations" + From: Ilya Zakharevich + Msg-ID: <199702041102.GAA24805@monk.mps.ohio-state.edu> + Date: Tue, 4 Feb 1997 06:02:10 -0500 (EST) + Files: regcomp.c regexec.c + + Title: "Re: static buffer in not_a_number() [sv.c] might overflow" + From: Gisle Aas + Msg-ID: + Date: 09 Feb 1997 11:55:41 +0100 + Files: sv.c + + Title: "Refine 'runaway string' heuristic" + From: Chip Salzenberg + Files: toke.c + + Title: "Fix core dump on C in eval" + From: Chip Salzenberg + Files: pp_ctl.c + + Title: "Catch C" + From: Chip Salzenberg + Files: pp.c + + BUILD PROCESS + + Title: "Fix usage message in configure.gnu" + From: Jarkko Hietaniemi + Files: configure.gnu + + LIBRARY AND EXTENSIONS + + Title: "DB_File 1.11 patch" + From: Paul Marquess + Msg-ID: <9702061553.AA18147@claudius.bfsec.bt.co.uk> + Date: Thu, 6 Feb 97 15:53:34 GMT + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + Title: "Faster File::Compare" + From: Gisle Aas + Msg-ID: <199702051342.OAA02753@bergen.sn.no> + Date: Wed, 5 Feb 1997 14:42:49 +0100 + Files: lib/File/Compare.pm + + Title: "Make diagnostics module strip formatting directives" + From: Chip Salzenberg + Files: lib/diagnostics.pm pod/perldiag.pod + + Title: "Fix warning from missing POSIX::setvbuf()" + From: Chip Salzenberg + Files: ext/IO/IO.xs + + TESTS + + Title: "Fix closure.t for AmigaOS (again)" + From: Norbert Pueschel + Msg-ID: <77724742@Armageddon.meb.uni-bonn.de> + Date: Wed, 05 Feb 1997 18:56:45 +0100 + Files: t/op/closure.t + + UTILITIES + + Title: "perldoc -f " + From: Gisle Aas + Msg-ID: <199702051127.MAA02090@bergen.sn.no> + Date: Wed, 5 Feb 1997 12:27:36 +0100 + Files: utils/perldoc.PL + + Title: "Fix pod2man's handling of quotes in =items" + From: Jarkko Hietaniemi + Msg-ID: <199702042023.WAA13143@alpha.hut.fi> + Date: Tue, 4 Feb 1997 22:23:34 +0200 (EET) + Files: pod/pod2man.PL + + DOCUMENTATION + + Title: "return *FH pod patch" + From: allen@gateway.grumman.com (John L. Allen) + Msg-ID: <9702061507.AA04474@gateway.grumman.com> + Date: Thu, 6 Feb 1997 10:07:28 -0500 + Files: pod/perldata.pod pod/perlsub.pod + + Title: "Describe interation of untie and DESTROY" + From: Paul Marquess and Chip Salzenberg + Files: pod/perltie.pod + + +---------------- +Version 5.003_25 +---------------- + +This release is beta candidate #3. Here's hoping... + + CORE LANGUAGE CHANGES + + Title: "Make $] read-only" + From: Chip Salzenberg + Files: gv.c + + Title: "New variable C<$^S> is a native version of C<$?>" + From: Chip Salzenberg + Files: doio.c global.sym gv.c interp.sym lib/English.pm mg.c perl.c + perl.h pod/perldelta.pod pod/perlfunc.pod pod/perlvar.pod + pp_ctl.c pp_sys.c proto.h util.c + + Title: "Make $^T work with undump, and don't taint it" + From: Chip Salzenberg + Files: perl.c + + CORE PORTABILITY + + Title: "VMS patches for _24" + From: Charles Bailey + Msg-ID: <01IEUIFP5038004GQP@hmivax.humgen.upenn.edu> + Date: Fri, 31 Jan 1997 02:34:37 -0500 (EST) + Files: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_vms.xs + lib/AutoSplit.pm lib/ExtUtils/MM_VMS.pm + lib/ExtUtils/MakeMaker.pm perl.h pp_hot.c t/lib/filehand.t + t/op/closure.t vms/Makefile vms/config.vms vms/descrip.mms + vms/ext/filespec.t vms/vms.c vms/vmsish.h + + Title: "hints/dec_osf.sh: polishing the comments" + From: Jarkko Hietaniemi + Msg-ID: <199701301958.VAA08992@alpha.hut.fi> + Date: Thu, 30 Jan 1997 21:58:10 +0200 (EET) + Files: hints/dec_osf.sh + + Title: "amigaos.sh" + From: Norbert Pueschel + Msg-ID: <77724724@Armageddon.meb.uni-bonn.de> + Date: Wed, 29 Jan 1997 11:39:49 +0100 + Files: hints/amigaos.sh + + OTHER CORE CHANGES + + Title: "Require '-T' in argv[], not just on #! line" + From: Chip Salzenberg + Files: perl.c pod/perldiag.pod + + Title: "Fix C and associated stack bugs" + From: Chip Salzenberg + Files: cop.h pp_ctl.c pp_hot.c t/op/misc.t + + Title: "Fix never-closing handle after C +function call. It allows the user to see what IO handles, see L, +are ready for reading, writing or have an error condition pending. + +=head1 CONSTRUCTOR + +=over 4 + +=item new ( [ HANDLES ] ) + +The constructor creates a new object and optionally initialises it with a set +of handles. + +=back + +=head1 METHODS + +=over 4 + +=item add ( HANDLES ) + +Add the list of handles to the C object. It is these values that +will be returned when an event occurs. C keeps these values in a +cache which is indexed by the C of the handle, so if more than one +handle with the same C is specified then only the last one is cached. + +Each handle can be an C object, an integer or an array +reference where the first element is a C or an integer. + +=item remove ( HANDLES ) + +Remove all the given handles from the object. This method also works +by the C of the handles. So the exact handles that were added +need not be passed, just handles that have an equivalent C + +=item exists ( HANDLE ) + +Returns a true value (actually the handle itself) if it is present. +Returns undef otherwise. + +=item handles + +Return an array of all registered handles. + +=item can_read ( [ TIMEOUT ] ) + +Return an array of handles that are ready for reading. C is +the maximum amount of time to wait before returning an empty list. If +C is not given and any handles are registered then the call +will block. + +=item can_write ( [ TIMEOUT ] ) + +Same as C except check for handles that can be written to. + +=item has_error ( [ TIMEOUT ] ) + +Same as C except check for handles that have an error +condition, for example EOF. + +=item count () + +Returns the number of handles that the object will check for when +one of the C methods is called or the object is passed to +the C is a static method, that is you call it with the package +name like C. C, C and C are either C +or C objects. C is optional and has the same +effect as for the core select call. + +The result will be an array of 3 elements, each a reference to an array +which will hold the handles that are ready for reading, writing and have +error conditions respectively. Upon error an empty array is returned. + +=back + +=head1 EXAMPLE + +Here is a short example which shows how C could be used +to write a server which communicates with several sockets while also +listening for more connections on a listen socket + + use IO::Select; + use IO::Socket; + + $lsn = new IO::Socket::INET(Listen => 1, LocalPort => 8080); + $sel = new IO::Select( $lsn ); + + while(@ready = $sel->can_read) { + foreach $fh (@ready) { + if($fh == $lsn) { + # Create a new socket + $new = $lsn->accept; + $sel->add($new); + } + else { + # Process socket + + # Maybe we have finished with the socket + $sel->remove($fh); + $fh->close; + } + } + } + +=head1 AUTHOR + +Graham Barr EFE + +=head1 COPYRIGHT + +Copyright (c) 1995 Graham Barr. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms +as Perl itself. + +=cut + +use strict; +use vars qw($VERSION @ISA); +require Exporter; + +$VERSION = "1.10"; + +@ISA = qw(Exporter); # This is only so we can do version checking + +sub VEC_BITS () {0} +sub FD_COUNT () {1} +sub FIRST_FD () {2} + +sub new +{ + my $self = shift; + my $type = ref($self) || $self; + + my $vec = bless [undef,0], $type; + + $vec->add(@_) + if @_; + + $vec; +} + +sub add +{ + shift->_update('add', @_); +} + + +sub remove +{ + shift->_update('remove', @_); +} + + +sub exists +{ + my $vec = shift; + $vec->[$vec->_fileno(shift) + FIRST_FD]; +} + + +sub _fileno +{ + my($self, $f) = @_; + $f = $f->[0] if ref($f) eq 'ARRAY'; + ($f =~ /^\d+$/) ? $f : fileno($f); +} + +sub _update +{ + my $vec = shift; + my $add = shift eq 'add'; + + my $bits = $vec->[VEC_BITS]; + $bits = '' unless defined $bits; + + my $count = 0; + my $f; + foreach $f (@_) + { + my $fn = $vec->_fileno($f); + next unless defined $fn; + my $i = $fn + FIRST_FD; + if ($add) { + if (defined $vec->[$i]) { + $vec->[$i] = $f; # if array rest might be different, so we update + next; + } + $vec->[FD_COUNT]++; + vec($bits, $fn, 1) = 1; + $vec->[$i] = $f; + } else { # remove + next unless defined $vec->[$i]; + $vec->[FD_COUNT]--; + vec($bits, $fn, 1) = 0; + $vec->[$i] = undef; + } + $count++; + } + $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef; + $count; +} + +sub can_read +{ + my $vec = shift; + my $timeout = shift; + my $r = $vec->[VEC_BITS]; + + defined($r) && (select($r,undef,undef,$timeout) > 0) + ? handles($vec, $r) + : (); +} + +sub can_write +{ + my $vec = shift; + my $timeout = shift; + my $w = $vec->[VEC_BITS]; + + defined($w) && (select(undef,$w,undef,$timeout) > 0) + ? handles($vec, $w) + : (); +} + +sub has_error +{ + my $vec = shift; + my $timeout = shift; + my $e = $vec->[VEC_BITS]; + + defined($e) && (select(undef,undef,$e,$timeout) > 0) + ? handles($vec, $e) + : (); +} + +sub count +{ + my $vec = shift; + $vec->[FD_COUNT]; +} + +sub bits +{ + my $vec = shift; + $vec->[VEC_BITS]; +} + +sub as_string # for debugging +{ + my $vec = shift; + my $str = ref($vec) . ": "; + my $bits = $vec->bits; + my $count = $vec->count; + $str .= defined($bits) ? unpack("b*", $bits) : "undef"; + $str .= " $count"; + my @handles = @$vec; + splice(@handles, 0, FIRST_FD); + for (@handles) { + $str .= " " . (defined($_) ? "$_" : "-"); + } + $str; +} + +sub _max +{ + my($a,$b,$c) = @_; + $a > $b + ? $a > $c + ? $a + : $c + : $b > $c + ? $b + : $c; +} + +sub select +{ + shift + if defined $_[0] && !ref($_[0]); + + my($r,$w,$e,$t) = @_; + my @result = (); + + my $rb = defined $r ? $r->[VEC_BITS] : undef; + my $wb = defined $w ? $w->[VEC_BITS] : undef; + my $eb = defined $e ? $e->[VEC_BITS] : undef; + + if(select($rb,$wb,$eb,$t) > 0) + { + my @r = (); + my @w = (); + my @e = (); + my $i = _max(defined $r ? scalar(@$r)-1 : 0, + defined $w ? scalar(@$w)-1 : 0, + defined $e ? scalar(@$e)-1 : 0); + + for( ; $i >= FIRST_FD ; $i--) + { + my $j = $i - FIRST_FD; + push(@r, $r->[$i]) + if defined $rb && defined $r->[$i] && vec($rb, $j, 1); + push(@w, $w->[$i]) + if defined $wb && defined $w->[$i] && vec($wb, $j, 1); + push(@e, $e->[$i]) + if defined $eb && defined $e->[$i] && vec($eb, $j, 1); + } + + @result = (\@r, \@w, \@e); + } + @result; +} + + +sub handles +{ + my $vec = shift; + my $bits = shift; + my @h = (); + my $i; + my $max = scalar(@$vec) - 1; + + for ($i = FIRST_FD; $i <= $max; $i++) + { + next unless defined $vec->[$i]; + push(@h, $vec->[$i]) + if !defined($bits) || vec($bits, $i - FIRST_FD, 1); + } + + @h; +} + +1; diff --git a/contrib/perl5/ext/IO/lib/IO/Socket.pm b/contrib/perl5/ext/IO/lib/IO/Socket.pm new file mode 100644 index 00000000000..406f74d2ffe --- /dev/null +++ b/contrib/perl5/ext/IO/lib/IO/Socket.pm @@ -0,0 +1,728 @@ +# IO::Socket.pm +# +# Copyright (c) 1996 Graham Barr . All rights +# reserved. This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package IO::Socket; + +=head1 NAME + +IO::Socket - Object interface to socket communications + +=head1 SYNOPSIS + + use IO::Socket; + +=head1 DESCRIPTION + +C provides an object interface to creating and using sockets. It +is built upon the L interface and inherits all the methods defined +by L. + +C only defines methods for those operations which are common to all +types of socket. Operations which are specified to a socket in a particular +domain have methods defined in sub classes of C + +C will export all functions (and constants) defined by L. + +=head1 CONSTRUCTOR + +=over 4 + +=item new ( [ARGS] ) + +Creates an C, which is a reference to a +newly created symbol (see the C package). C +optionally takes arguments, these arguments are in key-value pairs. +C only looks for one key C which tells new which domain +the socket will be in. All other arguments will be passed to the +configuration method of the package for that domain, See below. + +Cs will be in autoflush mode after creation. Note that +versions of IO::Socket prior to 1.1603 (as shipped with Perl 5.004_04) +did not do this. So if you need backward compatibility, you should +set autoflush explicitly. + +=back + +=head1 METHODS + +See L for complete descriptions of each of the following +supported C methods, which are just front ends for the +corresponding built-in functions: + + socket + socketpair + bind + listen + accept + send + recv + peername (getpeername) + sockname (getsockname) + +Some methods take slightly different arguments to those defined in L +in attempt to make the interface more flexible. These are + +=over 4 + +=item accept([PKG]) + +perform the system call C on the socket and return a new object. The +new object will be created in the same class as the listen socket, unless +C is specified. This object can be used to communicate with the client +that was trying to connect. In a scalar context the new socket is returned, +or undef upon failure. In an array context a two-element array is returned +containing the new socket and the peer address, the list will +be empty upon failure. + +Additional methods that are provided are + +=item timeout([VAL]) + +Set or get the timeout value associated with this socket. If called without +any arguments then the current setting is returned. If called with an argument +the current setting is changed and the previous value returned. + +=item sockopt(OPT [, VAL]) + +Unified method to both set and get options in the SOL_SOCKET level. If called +with one argument then getsockopt is called, otherwise setsockopt is called. + +=item sockdomain + +Returns the numerical number for the socket domain type. For example, for +a AF_INET socket the value of &AF_INET will be returned. + +=item socktype + +Returns the numerical number for the socket type. For example, for +a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. + +=item protocol + +Returns the numerical number for the protocol being used on the socket, if +known. If the protocol is unknown, as with an AF_UNIX socket, zero +is returned. + +=back + +=cut + + +require 5.000; + +use Config; +use IO::Handle; +use Socket 1.3; +use Carp; +use strict; +use vars qw(@ISA $VERSION); +use Exporter; + +@ISA = qw(IO::Handle); + +$VERSION = "1.1603"; + +sub import { + my $pkg = shift; + my $callpkg = caller; + Exporter::export 'Socket', $callpkg, @_; +} + +sub new { + my($class,%arg) = @_; + my $fh = $class->SUPER::new(); + $fh->autoflush; + + ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout}; + + return scalar(%arg) ? $fh->configure(\%arg) + : $fh; +} + +my @domain2pkg = (); + +sub register_domain { + my($p,$d) = @_; + $domain2pkg[$d] = $p; +} + +sub configure { + my($fh,$arg) = @_; + my $domain = delete $arg->{Domain}; + + croak 'IO::Socket: Cannot configure a generic socket' + unless defined $domain; + + croak "IO::Socket: Unsupported socket domain" + unless defined $domain2pkg[$domain]; + + croak "IO::Socket: Cannot configure socket in domain '$domain'" + unless ref($fh) eq "IO::Socket"; + + bless($fh, $domain2pkg[$domain]); + $fh->configure($arg); +} + +sub socket { + @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)'; + my($fh,$domain,$type,$protocol) = @_; + + socket($fh,$domain,$type,$protocol) or + return undef; + + ${*$fh}{'io_socket_domain'} = $domain; + ${*$fh}{'io_socket_type'} = $type; + ${*$fh}{'io_socket_proto'} = $protocol; + + $fh; +} + +sub socketpair { + @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)'; + my($class,$domain,$type,$protocol) = @_; + my $fh1 = $class->new(); + my $fh2 = $class->new(); + + socketpair($fh1,$fh2,$domain,$type,$protocol) or + return (); + + ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; + ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol; + + ($fh1,$fh2); +} + +sub connect { + @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)'; + my $fh = shift; + my $addr = @_ == 1 ? shift : sockaddr_in(@_); + my $timeout = ${*$fh}{'io_socket_timeout'}; + local($SIG{ALRM}) = $timeout ? sub { undef $fh; } + : $SIG{ALRM} || 'DEFAULT'; + + eval { + croak 'connect: Bad address' + if(@_ == 2 && !defined $_[1]); + + if($timeout) { + defined $Config{d_alarm} && defined alarm($timeout) or + $timeout = 0; + } + + my $ok = connect($fh, $addr); + + alarm(0) + if($timeout); + + croak "connect: timeout" + unless defined $fh; + + undef $fh unless $ok; + }; + + $fh; +} + +sub bind { + @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)'; + my $fh = shift; + my $addr = @_ == 1 ? shift : sockaddr_in(@_); + + return bind($fh, $addr) ? $fh + : undef; +} + +sub listen { + @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])'; + my($fh,$queue) = @_; + $queue = 5 + unless $queue && $queue > 0; + + return listen($fh, $queue) ? $fh + : undef; +} + +sub accept { + @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])'; + my $fh = shift; + my $pkg = shift || $fh; + my $timeout = ${*$fh}{'io_socket_timeout'}; + my $new = $pkg->new(Timeout => $timeout); + my $peer = undef; + + eval { + if($timeout) { + my $fdset = ""; + vec($fdset, $fh->fileno,1) = 1; + croak "accept: timeout" + unless select($fdset,undef,undef,$timeout); + } + $peer = accept($new,$fh); + }; + + return wantarray ? defined $peer ? ($new, $peer) + : () + : defined $peer ? $new + : undef; +} + +sub sockname { + @_ == 1 or croak 'usage: $fh->sockname()'; + getsockname($_[0]); +} + +sub peername { + @_ == 1 or croak 'usage: $fh->peername()'; + my($fh) = @_; + getpeername($fh) + || ${*$fh}{'io_socket_peername'} + || undef; +} + +sub send { + @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])'; + my $fh = $_[0]; + my $flags = $_[2] || 0; + my $peer = $_[3] || $fh->peername; + + croak 'send: Cannot determine peer address' + unless($peer); + + my $r = defined(getpeername($fh)) + ? send($fh, $_[1], $flags) + : send($fh, $_[1], $flags, $peer); + + # remember who we send to, if it was sucessful + ${*$fh}{'io_socket_peername'} = $peer + if(@_ == 4 && defined $r); + + $r; +} + +sub recv { + @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])'; + my $sock = $_[0]; + my $len = $_[2]; + my $flags = $_[3] || 0; + + # remember who we recv'd from + ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags); +} + + +sub setsockopt { + @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)'; + setsockopt($_[0],$_[1],$_[2],$_[3]); +} + +my $intsize = length(pack("i",0)); + +sub getsockopt { + @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)'; + my $r = getsockopt($_[0],$_[1],$_[2]); + # Just a guess + $r = unpack("i", $r) + if(defined $r && length($r) == $intsize); + $r; +} + +sub sockopt { + my $fh = shift; + @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_) + : $fh->setsockopt(SOL_SOCKET,@_); +} + +sub timeout { + @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])'; + my($fh,$val) = @_; + my $r = ${*$fh}{'io_socket_timeout'} || undef; + + ${*$fh}{'io_socket_timeout'} = 0 + $val + if(@_ == 2); + + $r; +} + +sub sockdomain { + @_ == 1 or croak 'usage: $fh->sockdomain()'; + my $fh = shift; + ${*$fh}{'io_socket_domain'}; +} + +sub socktype { + @_ == 1 or croak 'usage: $fh->socktype()'; + my $fh = shift; + ${*$fh}{'io_socket_type'} +} + +sub protocol { + @_ == 1 or croak 'usage: $fh->protocol()'; + my($fh) = @_; + ${*$fh}{'io_socket_protocol'}; +} + +=head1 SUB-CLASSES + +=cut + +## +## AF_INET +## + +package IO::Socket::INET; + +use strict; +use vars qw(@ISA); +use Socket; +use Carp; +use Exporter; + +@ISA = qw(IO::Socket); + +IO::Socket::INET->register_domain( AF_INET ); + +my %socket_type = ( tcp => SOCK_STREAM, + udp => SOCK_DGRAM, + icmp => SOCK_RAW, + ); + +=head2 IO::Socket::INET + +C provides a constructor to create an AF_INET domain socket +and some related methods. The constructor can take the following options + + PeerAddr Remote host address [:] + PeerPort Remote port or service [()] | + LocalAddr Local host bind address hostname[:port] + LocalPort Local host bind port [()] | + Proto Protocol name (or number) "tcp" | "udp" | ... + Type Socket type SOCK_STREAM | SOCK_DGRAM | ... + Listen Queue size for listen + Reuse Set SO_REUSEADDR before binding + Timeout Timeout value for various operations + + +If C is defined then a listen socket is created, else if the +socket type, which is derived from the protocol, is SOCK_STREAM then +connect() is called. + +The C can be a hostname or the IP-address on the +"xx.xx.xx.xx" form. The C can be a number or a symbolic +service name. The service name might be followed by a number in +parenthesis which is used if the service is not known by the system. +The C specification can also be embedded in the C +by preceding it with a ":". + +If C is not given and you specify a symbolic C port, +then the constructor will try to derive C from the service +name. As a last resort C "tcp" is assumed. The C +parameter will be deduced from C if not specified. + +If the constructor is only passed a single argument, it is assumed to +be a C specification. + +Examples: + + $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org', + PeerPort => 'http(80)', + Proto => 'tcp'); + + $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)'); + + $sock = IO::Socket::INET->new(Listen => 5, + LocalAddr => 'localhost', + LocalPort => 9000, + Proto => 'tcp'); + + $sock = IO::Socket::INET->new('127.0.0.1:25'); + + +=head2 METHODS + +=over 4 + +=item sockaddr () + +Return the address part of the sockaddr structure for the socket + +=item sockport () + +Return the port number that the socket is using on the local host + +=item sockhost () + +Return the address part of the sockaddr structure for the socket in a +text form xx.xx.xx.xx + +=item peeraddr () + +Return the address part of the sockaddr structure for the socket on +the peer host + +=item peerport () + +Return the port number for the socket on the peer host. + +=item peerhost () + +Return the address part of the sockaddr structure for the socket on the +peer host in a text form xx.xx.xx.xx + +=back + +=cut + +sub new +{ + my $class = shift; + unshift(@_, "PeerAddr") if @_ == 1; + return $class->SUPER::new(@_); +} + +sub _sock_info { + my($addr,$port,$proto) = @_; + my @proto = (); + my @serv = (); + + $port = $1 + if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,); + + if(defined $proto) { + @proto = $proto =~ m,\D, ? getprotobyname($proto) + : getprotobynumber($proto); + + $proto = $proto[2] || undef; + } + + if(defined $port) { + $port =~ s,\((\d+)\)$,,; + + my $defport = $1 || undef; + my $pnum = ($port =~ m,^(\d+)$,)[0]; + + @serv= getservbyname($port, $proto[0] || "") + if($port =~ m,\D,); + + $port = $pnum || $serv[2] || $defport || undef; + + $proto = (getprotobyname($serv[3]))[2] || undef + if @serv && !$proto; + } + + return ($addr || undef, + $port || undef, + $proto || undef + ); +} + +sub _error { + my $fh = shift; + $@ = join("",ref($fh),": ",@_); + carp $@ if $^W; + close($fh) + if(defined fileno($fh)); + return undef; +} + +sub configure { + my($fh,$arg) = @_; + my($lport,$rport,$laddr,$raddr,$proto,$type); + + + ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr}, + $arg->{LocalPort}, + $arg->{Proto}); + + $laddr = defined $laddr ? inet_aton($laddr) + : INADDR_ANY; + + return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'") + unless(defined $laddr); + + unless(exists $arg->{Listen}) { + ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, + $arg->{PeerPort}, + $proto); + } + + if(defined $raddr) { + $raddr = inet_aton($raddr); + return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'") + unless(defined $raddr); + } + + $proto ||= (getprotobyname "tcp")[2]; + return _error($fh,'Cannot determine protocol') + unless($proto); + + my $pname = (getprotobynumber($proto))[0]; + $type = $arg->{Type} || $socket_type{$pname}; + + $fh->socket(AF_INET, $type, $proto) or + return _error($fh,"$!"); + + if ($arg->{Reuse}) { + $fh->sockopt(SO_REUSEADDR,1) or + return _error($fh); + } + + $fh->bind($lport || 0, $laddr) or + return _error($fh,"$!"); + + if(exists $arg->{Listen}) { + $fh->listen($arg->{Listen} || 5) or + return _error($fh,"$!"); + } + else { + return _error($fh,'Cannot determine remote port') + unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW); + + if($type == SOCK_STREAM || defined $raddr) { + return _error($fh,'Bad peer address') + unless(defined $raddr); + + $fh->connect($rport,$raddr) or + return _error($fh,"$!"); + } + } + + $fh; +} + +sub sockaddr { + @_ == 1 or croak 'usage: $fh->sockaddr()'; + my($fh) = @_; + (sockaddr_in($fh->sockname))[1]; +} + +sub sockport { + @_ == 1 or croak 'usage: $fh->sockport()'; + my($fh) = @_; + (sockaddr_in($fh->sockname))[0]; +} + +sub sockhost { + @_ == 1 or croak 'usage: $fh->sockhost()'; + my($fh) = @_; + inet_ntoa($fh->sockaddr); +} + +sub peeraddr { + @_ == 1 or croak 'usage: $fh->peeraddr()'; + my($fh) = @_; + (sockaddr_in($fh->peername))[1]; +} + +sub peerport { + @_ == 1 or croak 'usage: $fh->peerport()'; + my($fh) = @_; + (sockaddr_in($fh->peername))[0]; +} + +sub peerhost { + @_ == 1 or croak 'usage: $fh->peerhost()'; + my($fh) = @_; + inet_ntoa($fh->peeraddr); +} + +## +## AF_UNIX +## + +package IO::Socket::UNIX; + +use strict; +use vars qw(@ISA $VERSION); +use Socket; +use Carp; +use Exporter; + +@ISA = qw(IO::Socket); + +IO::Socket::UNIX->register_domain( AF_UNIX ); + +=head2 IO::Socket::UNIX + +C provides a constructor to create an AF_UNIX domain socket +and some related methods. The constructor can take the following options + + Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM) + Local Path to local fifo + Peer Path to peer fifo + Listen Create a listen socket + +=head2 METHODS + +=over 4 + +=item hostpath() + +Returns the pathname to the fifo at the local end + +=item peerpath() + +Returns the pathanme to the fifo at the peer end + +=back + +=cut + +sub configure { + my($fh,$arg) = @_; + my($bport,$cport); + + my $type = $arg->{Type} || SOCK_STREAM; + + $fh->socket(AF_UNIX, $type, 0) or + return undef; + + if(exists $arg->{Local}) { + my $addr = sockaddr_un($arg->{Local}); + $fh->bind($addr) or + return undef; + } + if(exists $arg->{Listen}) { + $fh->listen($arg->{Listen} || 5) or + return undef; + } + elsif(exists $arg->{Peer}) { + my $addr = sockaddr_un($arg->{Peer}); + $fh->connect($addr) or + return undef; + } + + $fh; +} + +sub hostpath { + @_ == 1 or croak 'usage: $fh->hostpath()'; + my $n = $_[0]->sockname || return undef; + (sockaddr_un($n))[0]; +} + +sub peerpath { + @_ == 1 or croak 'usage: $fh->peerpath()'; + my $n = $_[0]->peername || return undef; + (sockaddr_un($n))[0]; +} + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Graham Barr EFE + +=head1 COPYRIGHT + +Copyright (c) 1996 Graham Barr. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms +as Perl itself. + +=cut + +1; # Keep require happy diff --git a/contrib/perl5/ext/IPC/SysV/ChangeLog b/contrib/perl5/ext/IPC/SysV/ChangeLog new file mode 100644 index 00000000000..fff95bec431 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/ChangeLog @@ -0,0 +1,28 @@ +Fri Jul 3 15:06:40 1998 Jarkko Hietaniemi + + - Integrated IPC::SysV 1.03 to Perl 5.004_69. + +Change 142 on 1998/05/31 by (Graham Barr) + + - Changed SHMLBA from a constSUB to an XS sub as on some systems it is not + a constant + - Added a missing MODULE line to SysV.xs so ftok is defined in IPC::SysV + +Change 138 on 1998/05/23 by (Graham Barr) + + Applied patch from Jarkko Hietaniemi to add constats for UNICOS + + Reduced size of XS object by changing constant sub definition + into a loop + + Updated POD to include ftok() + +Change 135 on 1998/05/18 by (Graham Barr) + + applied changes from Jarkko Hietaniemi to add + new constants and ftok + + fixed to compile with >5.004_50 + + surrounded newCONSTSUB with #ifndef as perl now defines this itself + diff --git a/contrib/perl5/ext/IPC/SysV/MANIFEST b/contrib/perl5/ext/IPC/SysV/MANIFEST new file mode 100644 index 00000000000..4b2aa00daf1 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/MANIFEST @@ -0,0 +1,10 @@ +MANIFEST +Makefile.PL +Msg.pm +README +Semaphore.pm +SysV.pm +SysV.xs +t/msg.t +t/sem.t +ChangeLog diff --git a/contrib/perl5/ext/IPC/SysV/Makefile.PL b/contrib/perl5/ext/IPC/SysV/Makefile.PL new file mode 100644 index 00000000000..c8e320f0301 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/Makefile.PL @@ -0,0 +1,36 @@ +# This -*- perl -*- script makes the Makefile +# $Id: Makefile.PL,v 1.3 1997/03/04 09:21:12 gbarr Exp $ + +require 5.002; +use ExtUtils::MakeMaker; + +#--- MY package + +sub MY::libscan +{ + my($self,$path) = @_; + + return '' + if($path =~ m:/(RCS|CVS|SCCS)/: || + $path =~ m:[~%]$: || + $path =~ m:\.(orig|rej)$: + ); + + $path; +} + +WriteMakefile( + VERSION_FROM => "SysV.pm", + NAME => "IPC::SysV", + + 'dist' => {COMPRESS => 'gzip -9f', + SUFFIX => 'gz', + DIST_DEFAULT => 'all tardist', + }, + + 'clean' => {FILES => join(" ", + map { "$_ */$_ */*/$_" } + qw(*% *.html *.b[ac]k *.old *.orig)) + }, + 'macro' => { INSTALLDIRS => 'perl' }, +); diff --git a/contrib/perl5/ext/IPC/SysV/Msg.pm b/contrib/perl5/ext/IPC/SysV/Msg.pm new file mode 100644 index 00000000000..93d2ae16ee6 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/Msg.pm @@ -0,0 +1,223 @@ +# IPC::Msg.pm +# +# Copyright (c) 1997 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package IPC::Msg; + +use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID); +use strict; +use vars qw($VERSION); +use Carp; + +$VERSION = "1.00"; + +{ + package IPC::Msg::stat; + + use Class::Struct qw(struct); + + struct 'IPC::Msg::stat' => [ + uid => '$', + gid => '$', + cuid => '$', + cgid => '$', + mode => '$', + qnum => '$', + qbytes => '$', + lspid => '$', + lrpid => '$', + stime => '$', + rtime => '$', + ctime => '$', + ]; +} + +sub new { + @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )'; + my $class = shift; + + my $id = msgget($_[0],$_[1]); + + defined($id) + ? bless \$id, $class + : undef; +} + +sub id { + my $self = shift; + $$self; +} + +sub stat { + my $self = shift; + my $data = ""; + msgctl($$self,IPC_STAT,$data) or + return undef; + IPC::Msg::stat->new->unpack($data); +} + +sub set { + my $self = shift; + my $ds; + + if(@_ == 1) { + $ds = shift; + } + else { + croak 'Bad arg count' if @_ % 2; + my %arg = @_; + my $ds = $self->stat + or return undef; + my($key,$val); + $ds->$key($val) + while(($key,$val) = each %arg); + } + + msgctl($$self,IPC_SET,$ds->pack); +} + +sub remove { + my $self = shift; + (msgctl($$self,IPC_RMID,0), undef $$self)[0]; +} + +sub rcv { + @_ == 5 || croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; + my $self = shift; + my $buf = ""; + msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or + return; + my $type; + ($type,$_[0]) = unpack("L a*",$buf); + $type; +} + +sub snd { + @_ == 4 || croak '$msg->snd( TYPE, BUF, FLAGS )'; + my $self = shift; + msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0); +} + + +1; + +__END__ + +=head1 NAME + +IPC::Msg - SysV Msg IPC object class + +=head1 SYNOPSIS + + use IPC::SysV qw(IPC_PRIVATE S_IRWXU S_IRWXG S_IRWXO); + use IPC::Msg; + + $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO); + + $msg->snd(pack("L a*",$msgtype,$msg)); + + $msg->rcv($buf,256); + + $ds = $msg->stat; + + $msg->remove; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item new ( KEY , FLAGS ) + +Creates a new message queue associated with C. A new queue is +created if + +=over 4 + +=item * + +C is equal to C + +=item * + +C does not already have a message queue +associated with it, and C & IPC_CREAT> is true. + +=back + +On creation of a new message queue C is used to set the +permissions. + +=item id + +Returns the system message queue identifier. + +=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) + +Read a message from the queue. Returns the type of the message read. See +L + +=item remove + +Remove and destroy the message queue from the system. + +=item set ( STAT ) + +=item set ( NAME => VALUE [, NAME => VALUE ...] ) + +C will set the following values of the C structure associated +with the message queue. + + uid + gid + mode (oly the permission bits) + qbytes + +C accepts either a stat object, as returned by the C method, +or a list of I-I pairs. + +=item snd ( TYPE, MSG [, FLAGS ] ) + +Place a message on the queue with the data from C and with type C. +See L. + +=item stat + +Returns an object of type C which is a sub-class of +C. It provides the following fields. For a description +of these fields see you system documentation. + + uid + gid + cuid + cgid + mode + qnum + qbytes + lspid + lrpid + stime + rtime + ctime + +=back + +=head1 SEE ALSO + +L L + +=head1 AUTHOR + +Graham Barr + +=head1 COPYRIGHT + +Copyright (c) 1997 Graham Barr. All rights reserved. +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/contrib/perl5/ext/IPC/SysV/README b/contrib/perl5/ext/IPC/SysV/README new file mode 100644 index 00000000000..d412c4c712d --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/README @@ -0,0 +1,20 @@ +Copyright (c) 1997 Graham Barr . All rights reserved. +This package is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +The SysV-IPC contains three packages + + IPC::Semaphore + - Provides an object interface to using SysV IPC semaphores + + IPC::Msg + - Provides an object interface to using SysV IPC messages + + IPC::SysV + - Provides the constants required to use the system SysV IPC calls. + +Currently there is not object support for SysV shared memory, but +SysV::SharedMem is a project for the future. + +Share and enjoy! + diff --git a/contrib/perl5/ext/IPC/SysV/Semaphore.pm b/contrib/perl5/ext/IPC/SysV/Semaphore.pm new file mode 100644 index 00000000000..464eb0bc192 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/Semaphore.pm @@ -0,0 +1,297 @@ +# IPC::Semaphore +# +# Copyright (c) 1997 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package IPC::Semaphore; + +use IPC::SysV qw(GETNCNT GETZCNT GETVAL SETVAL GETPID GETALL SETALL + IPC_STAT IPC_SET IPC_RMID); +use strict; +use vars qw($VERSION); +use Carp; + +$VERSION = "1.00"; + +{ + package IPC::Semaphore::stat; + + use Class::Struct qw(struct); + + struct 'IPC::Semaphore::stat' => [ + uid => '$', + gid => '$', + cuid => '$', + cgid => '$', + mode => '$', + ctime => '$', + otime => '$', + nsems => '$', + ]; +} + +sub new { + @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )'; + my $class = shift; + + my $id = semget($_[0],$_[1],$_[2]); + + defined($id) + ? bless \$id, $class + : undef; +} + +sub id { + my $self = shift; + $$self; +} + +sub remove { + my $self = shift; + (semctl($$self,0,IPC_RMID,0), undef $$self)[0]; +} + +sub getncnt { + @_ == 2 || croak '$sem->getncnt( SEM )'; + my $self = shift; + my $sem = shift; + my $v = semctl($$self,$sem,GETNCNT,0); + $v ? 0 + $v : undef; +} + +sub getzcnt { + @_ == 2 || croak '$sem->getzcnt( SEM )'; + my $self = shift; + my $sem = shift; + my $v = semctl($$self,$sem,GETZCNT,0); + $v ? 0 + $v : undef; +} + +sub getval { + @_ == 2 || croak '$sem->getval( SEM )'; + my $self = shift; + my $sem = shift; + my $v = semctl($$self,$sem,GETVAL,0); + $v ? 0 + $v : undef; +} + +sub getpid { + @_ == 2 || croak '$sem->getpid( SEM )'; + my $self = shift; + my $sem = shift; + my $v = semctl($$self,$sem,GETPID,0); + $v ? 0 + $v : undef; +} + +sub op { + @_ >= 4 || croak '$sem->op( OPLIST )'; + my $self = shift; + croak 'Bad arg count' if @_ % 3; + my $data = pack("s*",@_); + semop($$self,$data); +} + +sub stat { + my $self = shift; + my $data = ""; + semctl($$self,0,IPC_STAT,$data) + or return undef; + IPC::Semaphore::stat->new->unpack($data); +} + +sub set { + my $self = shift; + my $ds; + + if(@_ == 1) { + $ds = shift; + } + else { + croak 'Bad arg count' if @_ % 2; + my %arg = @_; + my $ds = $self->stat + or return undef; + my($key,$val); + $ds->$key($val) + while(($key,$val) = each %arg); + } + + my $v = semctl($$self,0,IPC_SET,$ds->pack); + $v ? 0 + $v : undef; +} + +sub getall { + my $self = shift; + my $data = ""; + semctl($$self,0,GETALL,$data) + or return (); + (unpack("s*",$data)); +} + +sub setall { + my $self = shift; + my $data = pack("s*",@_); + semctl($$self,0,SETALL,$data); +} + +sub setval { + @_ == 3 || croak '$sem->setval( SEM, VAL )'; + my $self = shift; + my $sem = shift; + my $val = shift; + semctl($$self,$sem,SETVAL,$val); +} + +1; + +__END__ + +=head1 NAME + +IPC::Semaphore - SysV Semaphore IPC object class + +=head1 SYNOPSIS + + use IPC::SysV qw(IPC_PRIVATE S_IRWXU IPC_CREAT); + use IPC::Semaphore; + + $sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | IPC_CREAT); + + $sem->setall( (0) x 10); + + @sem = $sem->getall; + + $ncnt = $sem->getncnt; + + $zcnt = $sem->getzcnt; + + $ds = $sem->stat; + + $sem->remove; + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item new ( KEY , NSEMS , FLAGS ) + +Create a new semaphore set associated with C. C is the number +of semaphores in the set. A new set is created if + +=over 4 + +=item * + +C is equal to C + +=item * + +C does not already have a semaphore identifier +associated with it, and C & IPC_CREAT> is true. + +=back + +On creation of a new semaphore set C is used to set the +permissions. + +=item getall + +Returns the values of the semaphore set as an array. + +=item getncnt ( SEM ) + +Returns the number of processed waiting for the semaphore C to +become greater than it's current value + +=item getpid ( SEM ) + +Returns the process id of the last process that performed an operation +on the semaphore C. + +=item getval ( SEM ) + +Returns the current value of the semaphore C. + +=item getzcnt ( SEM ) + +Returns the number of processed waiting for the semaphore C to +become zero. + +=item id + +Returns the system identifier for the semaphore set. + +=item op ( OPLIST ) + +C is a list of operations to pass to C. C is +a concatenation of smaller lists, each which has three values. The +first is the semaphore number, the second is the operation and the last +is a flags value. See L for more details. For example + + $sem->op( + 0, -1, IPC_NOWAIT, + 1, 1, IPC_NOWAIT + ); + +=item remove + +Remove and destroy the semaphore set from the system. + +=item set ( STAT ) + +=item set ( NAME => VALUE [, NAME => VALUE ...] ) + +C will set the following values of the C structure associated +with the semaphore set. + + uid + gid + mode (oly the permission bits) + +C accepts either a stat object, as returned by the C method, +or a list of I-I pairs. + +=item setall ( VALUES ) + +Sets all values in the semaphore set to those given on the C list. +C must contain the correct number of values. + +=item setval ( N , VALUE ) + +Set the Cth value in the semaphore set to C + +=item stat + +Returns an object of type C which is a sub-class of +C. It provides the following fields. For a description +of these fields see you system documentation. + + uid + gid + cuid + cgid + mode + ctime + otime + nsems + +=back + +=head1 SEE ALSO + +L L L L L + +=head1 AUTHOR + +Graham Barr + +=head1 COPYRIGHT + +Copyright (c) 1997 Graham Barr. All rights reserved. +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut diff --git a/contrib/perl5/ext/IPC/SysV/SysV.pm b/contrib/perl5/ext/IPC/SysV/SysV.pm new file mode 100644 index 00000000000..eb245937aa4 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/SysV.pm @@ -0,0 +1,98 @@ +# IPC::SysV.pm +# +# Copyright (c) 1997 Graham Barr . All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + +package IPC::SysV; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); +use Carp; +use Config; + +require Exporter; +@ISA = qw(Exporter); + +$VERSION = "1.03"; + +@EXPORT_OK = qw( + GETALL GETNCNT GETPID GETVAL GETZCNT + + IPC_ALLOC IPC_CREAT IPC_EXCL IPC_GETACL IPC_LOCKED IPC_M + IPC_NOERROR IPC_NOWAIT IPC_PRIVATE IPC_R IPC_RMID IPC_SET + IPC_SETACL IPC_SETLABEL IPC_STAT IPC_W IPC_WANTED + + MSG_FWAIT MSG_LOCKED MSG_MWAIT MSG_NOERROR MSG_QWAIT + MSG_R MSG_RWAIT MSG_STAT MSG_W MSG_WWAIT + + SEM_A SEM_ALLOC SEM_DEST SEM_ERR SEM_ORDER SEM_R SEM_UNDO + + SETALL SETVAL + + SHMLBA + + SHM_A SHM_CLEAR SHM_COPY SHM_DCACHE SHM_DEST SHM_ECACHE + SHM_FMAP SHM_ICACHE SHM_INIT SHM_LOCK SHM_LOCKED SHM_MAP + SHM_NOSWAP SHM_R SHM_RDONLY SHM_REMOVED SHM_RND SHM_SHARE_MMU + SHM_SHATTR SHM_SIZE SHM_UNLOCK SHM_W + + S_IRUSR S_IWUSR S_IRWXU + S_IRGRP S_IWGRP S_IRWXG + S_IROTH S_IWOTH S_IRWXO + + ftok +); + +BOOT_XS: { + # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO + require DynaLoader; + + # DynaLoader calls dl_load_flags as a static method. + *dl_load_flags = DynaLoader->can('dl_load_flags'); + + do { + __PACKAGE__->can('bootstrap') || \&DynaLoader::bootstrap + }->(__PACKAGE__, $VERSION); +} + +1; + +__END__ + +=head1 NAME + +IPC::SysV - SysV IPC constants + +=head1 SYNOPSIS + + use IPC::SysV qw(IPC_STAT IPC_PRIVATE); + +=head1 DESCRIPTION + +C defines and conditionally exports all the constants +defined in your system include files which are needed by the SysV +IPC calls. + +=item ftok( PATH, ID ) + +Return a key based on PATH and ID, which can be used as a key for +C, C and C. See L + +=head1 SEE ALSO + +L, L, L + +=head1 AUTHORS + +Graham Barr +Jarkko Hietaniemi + +=head1 COPYRIGHT + +Copyright (c) 1997 Graham Barr. All rights reserved. +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + diff --git a/contrib/perl5/ext/IPC/SysV/SysV.xs b/contrib/perl5/ext/IPC/SysV/SysV.xs new file mode 100644 index 00000000000..0fbf783347f --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/SysV.xs @@ -0,0 +1,423 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#ifdef __linux__ +#include +#endif +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +#include +#ifdef HAS_MSG +#include +#endif +#ifdef HAS_SEM +#include +#endif +#ifdef HAS_SHM +#if defined(PERL_SCO5) || defined(PERL_ISC) +#include +#endif +#include +# ifndef HAS_SHMAT_PROTOTYPE + extern Shmat_t shmat _((int, char *, int)); +# endif +#endif +#endif + +/* Required in BSDI to get PAGE_SIZE definition for SHMLBA. + * Ugly. More beautiful solutions welcome. + * Shouting at BSDI sounds quite beautiful. */ +#ifdef __bsdi__ +# include +#endif + +MODULE=IPC::SysV PACKAGE=IPC::Msg::stat + +PROTOTYPES: ENABLE + +void +pack(obj) + SV * obj +PPCODE: +{ +#ifdef HAS_MSG + SV *sv; + struct msqid_ds ds; + AV *list = (AV*)SvRV(obj); + sv = *av_fetch(list,0,TRUE); ds.msg_perm.uid = SvIV(sv); + sv = *av_fetch(list,1,TRUE); ds.msg_perm.gid = SvIV(sv); + sv = *av_fetch(list,4,TRUE); ds.msg_perm.mode = SvIV(sv); + sv = *av_fetch(list,6,TRUE); ds.msg_qbytes = SvIV(sv); + ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds))); + XSRETURN(1); +#else + croak("System V msgxxx is not implemented on this machine"); +#endif +} + +void +unpack(obj,buf) + SV * obj + SV * buf +PPCODE: +{ +#ifdef HAS_MSG + STRLEN len; + SV **sv_ptr; + struct msqid_ds *ds = (struct msqid_ds *)SvPV(buf,len); + AV *list = (AV*)SvRV(obj); + if (len != sizeof(*ds)) { + croak("Bad arg length for %s, length is %d, should be %d", + "IPC::Msg::stat", + len, sizeof(*ds)); + } + sv_ptr = av_fetch(list,0,TRUE); + sv_setiv(*sv_ptr, ds->msg_perm.uid); + sv_ptr = av_fetch(list,1,TRUE); + sv_setiv(*sv_ptr, ds->msg_perm.gid); + sv_ptr = av_fetch(list,2,TRUE); + sv_setiv(*sv_ptr, ds->msg_perm.cuid); + sv_ptr = av_fetch(list,3,TRUE); + sv_setiv(*sv_ptr, ds->msg_perm.cgid); + sv_ptr = av_fetch(list,4,TRUE); + sv_setiv(*sv_ptr, ds->msg_perm.mode); + sv_ptr = av_fetch(list,5,TRUE); + sv_setiv(*sv_ptr, ds->msg_qnum); + sv_ptr = av_fetch(list,6,TRUE); + sv_setiv(*sv_ptr, ds->msg_qbytes); + sv_ptr = av_fetch(list,7,TRUE); + sv_setiv(*sv_ptr, ds->msg_lspid); + sv_ptr = av_fetch(list,8,TRUE); + sv_setiv(*sv_ptr, ds->msg_lrpid); + sv_ptr = av_fetch(list,9,TRUE); + sv_setiv(*sv_ptr, ds->msg_stime); + sv_ptr = av_fetch(list,10,TRUE); + sv_setiv(*sv_ptr, ds->msg_rtime); + sv_ptr = av_fetch(list,11,TRUE); + sv_setiv(*sv_ptr, ds->msg_ctime); + XSRETURN(1); +#else + croak("System V msgxxx is not implemented on this machine"); +#endif +} + +MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat + +void +unpack(obj,ds) + SV * obj + SV * ds +PPCODE: +{ +#ifdef HAS_SEM + STRLEN len; + AV *list = (AV*)SvRV(obj); + struct semid_ds *data = (struct semid_ds *)SvPV(ds,len); + if(!sv_isa(obj, "IPC::Semaphore::stat")) + croak("method %s not called a %s object", + "unpack","IPC::Semaphore::stat"); + if (len != sizeof(*data)) { + croak("Bad arg length for %s, length is %d, should be %d", + "IPC::Semaphore::stat", + len, sizeof(*data)); + } + sv_setiv(*av_fetch(list,0,TRUE), data[0].sem_perm.uid); + sv_setiv(*av_fetch(list,1,TRUE), data[0].sem_perm.gid); + sv_setiv(*av_fetch(list,2,TRUE), data[0].sem_perm.cuid); + sv_setiv(*av_fetch(list,3,TRUE), data[0].sem_perm.cgid); + sv_setiv(*av_fetch(list,4,TRUE), data[0].sem_perm.mode); + sv_setiv(*av_fetch(list,5,TRUE), data[0].sem_ctime); + sv_setiv(*av_fetch(list,6,TRUE), data[0].sem_otime); + sv_setiv(*av_fetch(list,7,TRUE), data[0].sem_nsems); + XSRETURN(1); +#else + croak("System V semxxx is not implemented on this machine"); +#endif +} + +void +pack(obj) + SV * obj +PPCODE: +{ +#ifdef HAS_SEM + SV **sv_ptr; + SV *sv; + struct semid_ds ds; + AV *list = (AV*)SvRV(obj); + if(!sv_isa(obj, "IPC::Semaphore::stat")) + croak("method %s not called a %s object", + "pack","IPC::Semaphore::stat"); + if((sv_ptr = av_fetch(list,0,TRUE)) && (sv = *sv_ptr)) + ds.sem_perm.uid = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,1,TRUE)) && (sv = *sv_ptr)) + ds.sem_perm.gid = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,2,TRUE)) && (sv = *sv_ptr)) + ds.sem_perm.cuid = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,3,TRUE)) && (sv = *sv_ptr)) + ds.sem_perm.cgid = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,4,TRUE)) && (sv = *sv_ptr)) + ds.sem_perm.mode = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,5,TRUE)) && (sv = *sv_ptr)) + ds.sem_ctime = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,6,TRUE)) && (sv = *sv_ptr)) + ds.sem_otime = SvIV(*sv_ptr); + if((sv_ptr = av_fetch(list,7,TRUE)) && (sv = *sv_ptr)) + ds.sem_nsems = SvIV(*sv_ptr); + ST(0) = sv_2mortal(newSVpv((char *)&ds,sizeof(ds))); + XSRETURN(1); +#else + croak("System V semxxx is not implemented on this machine"); +#endif +} + +MODULE=IPC::SysV PACKAGE=IPC::SysV + +int +ftok(path, id) + char * path + int id + CODE: +#if defined(HAS_SEM) || defined(HAS_SHM) + key_t k = ftok(path, id); + ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k)); +#else + DIE(no_func, "ftok"); +#endif + +int +SHMLBA() + CODE: +#ifdef SHMLBA + ST(0) = sv_2mortal(newSViv(SHMLBA)); +#else + croak("SHMLBA is not defined on this architecture"); +#endif + +BOOT: +{ + HV *stash = gv_stashpvn("IPC::SysV", 9, TRUE); + /* + * constant subs for IPC::SysV + */ + struct { char *n; I32 v; } IPC__SysV__const[] = { +#ifdef GETVAL + {"GETVAL", GETVAL}, +#endif +#ifdef GETPID + {"GETPID", GETPID}, +#endif +#ifdef GETNCNT + {"GETNCNT", GETNCNT}, +#endif +#ifdef GETZCNT + {"GETZCNT", GETZCNT}, +#endif +#ifdef GETALL + {"GETALL", GETALL}, +#endif +#ifdef IPC_ALLOC + {"IPC_ALLOC", IPC_ALLOC}, +#endif +#ifdef IPC_CREAT + {"IPC_CREAT", IPC_CREAT}, +#endif +#ifdef IPC_EXCL + {"IPC_EXCL", IPC_EXCL}, +#endif +#ifdef IPC_GETACL + {"IPC_GETACL", IPC_EXCL}, +#endif +#ifdef IPC_LOCKED + {"IPC_LOCKED", IPC_LOCKED}, +#endif +#ifdef IPC_M + {"IPC_M", IPC_M}, +#endif +#ifdef IPC_NOERROR + {"IPC_NOERROR", IPC_NOERROR}, +#endif +#ifdef IPC_NOWAIT + {"IPC_NOWAIT", IPC_NOWAIT}, +#endif +#ifdef IPC_PRIVATE + {"IPC_PRIVATE", IPC_PRIVATE}, +#endif +#ifdef IPC_R + {"IPC_R", IPC_R}, +#endif +#ifdef IPC_RMID + {"IPC_RMID", IPC_RMID}, +#endif +#ifdef IPC_SET + {"IPC_SET", IPC_SET}, +#endif +#ifdef IPC_SETACL + {"IPC_SETACL", IPC_SETACL}, +#endif +#ifdef IPC_SETLABEL + {"IPC_SETLABEL", IPC_SETLABEL}, +#endif +#ifdef IPC_STAT + {"IPC_STAT", IPC_STAT}, +#endif +#ifdef IPC_W + {"IPC_W", IPC_W}, +#endif +#ifdef IPC_WANTED + {"IPC_WANTED", IPC_WANTED}, +#endif +#ifdef MSG_NOERROR + {"MSG_NOERROR", MSG_NOERROR}, +#endif +#ifdef MSG_FWAIT + {"MSG_FWAIT", MSG_FWAIT}, +#endif +#ifdef MSG_LOCKED + {"MSG_LOCKED", MSG_LOCKED}, +#endif +#ifdef MSG_MWAIT + {"MSG_MWAIT", MSG_MWAIT}, +#endif +#ifdef MSG_WAIT + {"MSG_WAIT", MSG_WAIT}, +#endif +#ifdef MSG_R + {"MSG_R", MSG_R}, +#endif +#ifdef MSG_RWAIT + {"MSG_RWAIT", MSG_RWAIT}, +#endif +#ifdef MSG_STAT + {"MSG_STAT", MSG_STAT}, +#endif +#ifdef MSG_W + {"MSG_W", MSG_W}, +#endif +#ifdef MSG_WWAIT + {"MSG_WWAIT", MSG_WWAIT}, +#endif +#ifdef SEM_A + {"SEM_A", SEM_A}, +#endif +#ifdef SEM_ALLOC + {"SEM_ALLOC", SEM_ALLOC}, +#endif +#ifdef SEM_DEST + {"SEM_DEST", SEM_DEST}, +#endif +#ifdef SEM_ERR + {"SEM_ERR", SEM_ERR}, +#endif +#ifdef SEM_R + {"SEM_R", SEM_R}, +#endif +#ifdef SEM_ORDER + {"SEM_ORDER", SEM_ORDER}, +#endif +#ifdef SEM_UNDO + {"SEM_UNDO", SEM_UNDO}, +#endif +#ifdef SETVAL + {"SETVAL", SETVAL}, +#endif +#ifdef SETALL + {"SETALL", SETALL}, +#endif +#ifdef SHM_CLEAR + {"SHM_CLEAR", SHM_CLEAR}, +#endif +#ifdef SHM_COPY + {"SHM_COPY", SHM_COPY}, +#endif +#ifdef SHM_DCACHE + {"SHM_DCACHE", SHM_DCACHE}, +#endif +#ifdef SHM_DEST + {"SHM_DEST", SHM_DEST}, +#endif +#ifdef SHM_ECACHE + {"SHM_ECACHE", SHM_ECACHE}, +#endif +#ifdef SHM_FMAP + {"SHM_FMAP", SHM_FMAP}, +#endif +#ifdef SHM_ICACHE + {"SHM_ICACHE", SHM_ICACHE}, +#endif +#ifdef SHM_INIT + {"SHM_INIT", SHM_INIT}, +#endif +#ifdef SHM_LOCK + {"SHM_LOCK", SHM_LOCK}, +#endif +#ifdef SHM_LOCKED + {"SHM_LOCKED", SHM_LOCKED}, +#endif +#ifdef SHM_MAP + {"SHM_MAP", SHM_MAP}, +#endif +#ifdef SHM_NOSWAP + {"SHM_NOSWAP", SHM_NOSWAP}, +#endif +#ifdef SHM_RDONLY + {"SHM_RDONLY", SHM_RDONLY}, +#endif +#ifdef SHM_REMOVED + {"SHM_REMOVED", SHM_REMOVED}, +#endif +#ifdef SHM_RND + {"SHM_RND", SHM_RND}, +#endif +#ifdef SHM_SHARE_MMU + {"SHM_SHARE_MMU", SHM_SHARE_MMU}, +#endif +#ifdef SHM_SHATTR + {"SHM_SHATTR", SHM_SHATTR}, +#endif +#ifdef SHM_SIZE + {"SHM_SIZE", SHM_SIZE}, +#endif +#ifdef SHM_UNLOCK + {"SHM_UNLOCK", SHM_UNLOCK}, +#endif +#ifdef SHM_W + {"SHM_W", SHM_W}, +#endif +#ifdef S_IRUSR + {"S_IRUSR", S_IRUSR}, +#endif +#ifdef S_IWUSR + {"S_IWUSR", S_IWUSR}, +#endif +#ifdef S_IRWXU + {"S_IRWXU", S_IRWXU}, +#endif +#ifdef S_IRGRP + {"S_IRGRP", S_IRGRP}, +#endif +#ifdef S_IWGRP + {"S_IWGRP", S_IWGRP}, +#endif +#ifdef S_IRWXG + {"S_IRWXG", S_IRWXG}, +#endif +#ifdef S_IROTH + {"S_IROTH", S_IROTH}, +#endif +#ifdef S_IWOTH + {"S_IWOTH", S_IWOTH}, +#endif +#ifdef S_IRWXO + {"S_IRWXO", S_IRWXO}, +#endif + {Nullch,0}}; + char *name; + int i; + + for(i = 0 ; name = IPC__SysV__const[i].n ; i++) { + newCONSTSUB(stash,name, newSViv(IPC__SysV__const[i].v)); + } +} + diff --git a/contrib/perl5/ext/IPC/SysV/t/msg.t b/contrib/perl5/ext/IPC/SysV/t/msg.t new file mode 100755 index 00000000000..2a982f054a7 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/t/msg.t @@ -0,0 +1,41 @@ +use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_STAT S_IRWXU S_IRWXG S_IRWXO); + +use IPC::Msg; +#Creating a message queue + +print "1..9\n"; + +$msq = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) + || die "msgget: ",$!+0," $!\n"; + +print "ok 1\n"; + +#Putting a message on the queue +$msgtype = 1; +$msg = "hello"; +$msq->snd($msgtype,$msg,0) || print "not "; +print "ok 2\n"; + +#Check if there are messages on the queue +$ds = $msq->stat() or print "not "; +print "ok 3\n"; + +print "not " unless $ds && $ds->qnum() == 1; +print "ok 4\n"; + +#Retreiving a message from the queue +$rmsgtype = 0; # Give me any type +$rmsgtype = $msq->rcv($rmsg,256,$rmsgtype,IPC_NOWAIT) || print "not "; +print "ok 5\n"; + +print "not " unless $rmsgtype == $msgtype && $rmsg eq $msg; +print "ok 6\n"; + +$ds = $msq->stat() or print "not "; +print "ok 7\n"; + +print "not " unless $ds && $ds->qnum() == 0; +print "ok 8\n"; + +$msq->remove || print "not "; +print "ok 9\n"; diff --git a/contrib/perl5/ext/IPC/SysV/t/sem.t b/contrib/perl5/ext/IPC/SysV/t/sem.t new file mode 100755 index 00000000000..9d6fff64f23 --- /dev/null +++ b/contrib/perl5/ext/IPC/SysV/t/sem.t @@ -0,0 +1,51 @@ + +use IPC::SysV qw( + SETALL + IPC_PRIVATE + IPC_CREAT + IPC_RMID + IPC_NOWAIT + IPC_STAT + S_IRWXU + S_IRWXG + S_IRWXO +); +use IPC::Semaphore; + +print "1..10\n"; + +$sem = new IPC::Semaphore(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) + || die "semget: ",$!+0," $!\n"; + +print "ok 1\n"; + +my $st = $sem->stat || print "not "; +print "ok 2\n"; + +$sem->setall( (0) x 10) || print "not "; +print "ok 3\n"; + +my @sem = $sem->getall; +print "not " unless join("",@sem) eq "0000000000"; +print "ok 4\n"; + +$sem[2] = 1; +$sem->setall( @sem ) || print "not "; +print "ok 5\n"; + +@sem = $sem->getall; +print "not " unless join("",@sem) eq "0010000000"; +print "ok 6\n"; + +my $ncnt = $sem->getncnt(0); +print "not " if $sem->getncnt(0) || !defined($ncnt); +print "ok 7\n"; + +$sem->op(2,-1,IPC_NOWAIT) || print "not "; +print "ok 8\n"; + +print "not " if $sem->getncnt(0); +print "ok 9\n"; + +$sem->remove || print "not "; +print "ok 10\n"; diff --git a/contrib/perl5/ext/NDBM_File/Makefile.PL b/contrib/perl5/ext/NDBM_File/Makefile.PL new file mode 100644 index 00000000000..ca4c107c0d2 --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'NDBM_File', + LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'NDBM_File.pm', +); diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.pm b/contrib/perl5/ext/NDBM_File/NDBM_File.pm new file mode 100644 index 00000000000..ed4fe2b36f9 --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/NDBM_File.pm @@ -0,0 +1,40 @@ +package NDBM_File; + +BEGIN { + if ($] >= 5.002) { + use strict; + } +} +use vars qw($VERSION @ISA); + +require Tie::Hash; +require DynaLoader; + +@ISA = qw(Tie::Hash DynaLoader); + +$VERSION = "1.01"; + +bootstrap NDBM_File $VERSION; + +1; + +__END__ + +=head1 NAME + +NDBM_File - Tied access to ndbm files + +=head1 SYNOPSIS + + use NDBM_File; + use Fcntl; # for O_ constants + + tie(%h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + + untie %h; + +=head1 DESCRIPTION + +See L + +=cut diff --git a/contrib/perl5/ext/NDBM_File/NDBM_File.xs b/contrib/perl5/ext/NDBM_File/NDBM_File.xs new file mode 100644 index 00000000000..d129a9c4905 --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/NDBM_File.xs @@ -0,0 +1,70 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include + +typedef DBM* NDBM_File; +#define dbm_TIEHASH(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) +#define dbm_FETCH(db,key) dbm_fetch(db,key) +#define dbm_STORE(db,key,value,flags) dbm_store(db,key,value,flags) +#define dbm_DELETE(db,key) dbm_delete(db,key) +#define dbm_FIRSTKEY(db) dbm_firstkey(db) +#define dbm_NEXTKEY(db,key) dbm_nextkey(db) + +MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = dbm_ + +NDBM_File +dbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +dbm_DESTROY(db) + NDBM_File db + CODE: + dbm_close(db); + +datum +dbm_FETCH(db, key) + NDBM_File db + datum key + +int +dbm_STORE(db, key, value, flags = DBM_REPLACE) + NDBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to ndbm file"); + croak("ndbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + dbm_clearerr(db); + } + +int +dbm_DELETE(db, key) + NDBM_File db + datum key + +datum +dbm_FIRSTKEY(db) + NDBM_File db + +datum +dbm_NEXTKEY(db, key) + NDBM_File db + datum key + +int +dbm_error(db) + NDBM_File db + +void +dbm_clearerr(db) + NDBM_File db + diff --git a/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl b/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl new file mode 100644 index 00000000000..e96d907e10a --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/hints/dec_osf.pl @@ -0,0 +1,2 @@ +# Spider Boardman +$self->{LIBS} = ['']; diff --git a/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl b/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl new file mode 100644 index 00000000000..d402c179014 --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/hints/dynixptx.pl @@ -0,0 +1,3 @@ +# On DYNIX/ptx 4.0 (v4.1.3), ndbm is actually contained in the +# libc library, and must be explicitly linked against -lc when compiling. +$self->{LIBS} = ['-lc']; diff --git a/contrib/perl5/ext/NDBM_File/hints/solaris.pl b/contrib/perl5/ext/NDBM_File/hints/solaris.pl new file mode 100644 index 00000000000..11310a972f5 --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/hints/solaris.pl @@ -0,0 +1,3 @@ +# -lucb has been reported to be fatal for perl5 on Solaris. +# Thus we deliberately don't include it here. +$self->{LIBS} = ["-lndbm", "-ldbm"]; diff --git a/contrib/perl5/ext/NDBM_File/hints/svr4.pl b/contrib/perl5/ext/NDBM_File/hints/svr4.pl new file mode 100644 index 00000000000..3285d9a685f --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/hints/svr4.pl @@ -0,0 +1,4 @@ +# Some SVR4 systems may need to link against routines in -lucb for +# odbm. Some may also need to link against -lc to pick up things like +# ecvt. +$self->{LIBS} = ['-ldbm -lucb -lc']; diff --git a/contrib/perl5/ext/NDBM_File/typemap b/contrib/perl5/ext/NDBM_File/typemap new file mode 100644 index 00000000000..317a8f3886c --- /dev/null +++ b/contrib/perl5/ext/NDBM_File/typemap @@ -0,0 +1,27 @@ +# +#################################### DBM SECTION +# + +datum T_DATUM +gdatum T_GDATUM +NDBM_File T_PTROBJ +GDBM_File T_PTROBJ +SDBM_File T_PTROBJ +ODBM_File T_PTROBJ +DB_File T_PTROBJ +DBZ_File T_PTROBJ +FATALFUNC T_OPAQUEPTR + +INPUT +T_DATUM + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); +T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); diff --git a/contrib/perl5/ext/ODBM_File/Makefile.PL b/contrib/perl5/ext/ODBM_File/Makefile.PL new file mode 100644 index 00000000000..76a5d199990 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'ODBM_File', + LIBS => ["-ldbm -lucb"], + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'ODBM_File.pm', +); diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.pm b/contrib/perl5/ext/ODBM_File/ODBM_File.pm new file mode 100644 index 00000000000..923640ff348 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.pm @@ -0,0 +1,35 @@ +package ODBM_File; + +use strict; +use vars qw($VERSION @ISA); + +require Tie::Hash; +require DynaLoader; + +@ISA = qw(Tie::Hash DynaLoader); + +$VERSION = "1.00"; + +bootstrap ODBM_File $VERSION; + +1; + +__END__ + +=head1 NAME + +ODBM_File - Tied access to odbm files + +=head1 SYNOPSIS + + use ODBM_File; + + tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + + untie %h; + +=head1 DESCRIPTION + +See L + +=cut diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.xs b/contrib/perl5/ext/ODBM_File/ODBM_File.xs new file mode 100644 index 00000000000..892c038a9ce --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.xs @@ -0,0 +1,122 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL /* XXX Why? */ +#endif +#ifdef I_DBM +# include +#else +# ifdef I_RPCSVC_DBM +# include +# endif +#endif + +#ifdef DBM_BUG_DUPLICATE_FREE +/* + * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(), + * resulting in duplicate free() because dbmclose() does *not* + * check if it has already been called for this DBM. + * If some malloc/free calls have been done between dbmclose() and + * the next dbminit(), the memory might be used for something else when + * it is freed. + * Verified to work on ultrix4.3. Probably will work on HP/UX. + * Set DBM_BUG_DUPLICATE_FREE in the extension hint file. + */ +/* Close the previous dbm, and fail to open a new dbm */ +#define dbmclose() ((void) dbminit("/tmp/x/y/z/z/y")) +#endif + +#include + +typedef void* ODBM_File; + +#define odbm_FETCH(db,key) fetch(key) +#define odbm_STORE(db,key,value,flags) store(key,value) +#define odbm_DELETE(db,key) delete(key) +#define odbm_FIRSTKEY(db) firstkey() +#define odbm_NEXTKEY(db,key) nextkey(key) + +static int dbmrefcnt; + +#ifndef DBM_REPLACE +#define DBM_REPLACE 0 +#endif + +MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ + +#ifndef NULL +# define NULL 0 +#endif + +ODBM_File +odbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + CODE: + { + char *tmpbuf; + if (dbmrefcnt++) + croak("Old dbm can only open one database"); + New(0, tmpbuf, strlen(filename) + 5, char); + SAVEFREEPV(tmpbuf); + sprintf(tmpbuf,"%s.dir",filename); + if (stat(tmpbuf, &PL_statbuf) < 0) { + if (flags & O_CREAT) { + if (mode < 0 || close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + sprintf(tmpbuf,"%s.pag",filename); + if (close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + } + else + croak("ODBM_FILE: Can't open %s", filename); + } + RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + ST(0) = sv_mortalcopy(&PL_sv_undef); + sv_setptrobj(ST(0), RETVAL, dbtype); + } + +void +DESTROY(db) + ODBM_File db + CODE: + dbmrefcnt--; + dbmclose(); + +datum +odbm_FETCH(db, key) + ODBM_File db + datum key + +int +odbm_STORE(db, key, value, flags = DBM_REPLACE) + ODBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to odbm file"); + croak("odbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + } + +int +odbm_DELETE(db, key) + ODBM_File db + datum key + +datum +odbm_FIRSTKEY(db) + ODBM_File db + +datum +odbm_NEXTKEY(db, key) + ODBM_File db + datum key + diff --git a/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl new file mode 100644 index 00000000000..febb7cdb21a --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl @@ -0,0 +1,9 @@ +# The -hidden option causes compilation to fail on Digital Unix. +# Andy Dougherty +# Sat Jan 13 16:29:52 EST 1996 +$self->{LDDLFLAGS} = $Config{lddlflags}; +$self->{LDDLFLAGS} =~ s/-hidden//; +# As long as we're hinting, note the known location of the dbm routines. +# Spider Boardman +# Fri Feb 21 14:50:31 EST 1997 +$self->{LIBS} = ['-ldbm']; diff --git a/contrib/perl5/ext/ODBM_File/hints/hpux.pl b/contrib/perl5/ext/ODBM_File/hints/hpux.pl new file mode 100644 index 00000000000..31f9d24bcae --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/hpux.pl @@ -0,0 +1,4 @@ +# Try to work around "bad free" messages. See note in ODBM_File.xs. +# Andy Dougherty +# Sun Sep 8 12:57:52 EDT 1996 +$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ; diff --git a/contrib/perl5/ext/ODBM_File/hints/sco.pl b/contrib/perl5/ext/ODBM_File/hints/sco.pl new file mode 100644 index 00000000000..4664f2bee0f --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/sco.pl @@ -0,0 +1,4 @@ +# Some versions of SCO contain a broken -ldbm library that is missing +# dbmclose. Some of those might have a fixed library installed as +# -ldbm.nfs. +$self->{LIBS} = ['-ldbm.nfs', '-ldbm']; diff --git a/contrib/perl5/ext/ODBM_File/hints/solaris.pl b/contrib/perl5/ext/ODBM_File/hints/solaris.pl new file mode 100644 index 00000000000..ac573932cce --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/solaris.pl @@ -0,0 +1,3 @@ +# -lucb has been reported to be fatal for perl5 on Solaris. +# Thus we deliberately don't include it here. +$self->{LIBS} = ['-ldbm']; diff --git a/contrib/perl5/ext/ODBM_File/hints/svr4.pl b/contrib/perl5/ext/ODBM_File/hints/svr4.pl new file mode 100644 index 00000000000..3285d9a685f --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/svr4.pl @@ -0,0 +1,4 @@ +# Some SVR4 systems may need to link against routines in -lucb for +# odbm. Some may also need to link against -lc to pick up things like +# ecvt. +$self->{LIBS} = ['-ldbm -lucb -lc']; diff --git a/contrib/perl5/ext/ODBM_File/hints/ultrix.pl b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl new file mode 100644 index 00000000000..31f9d24bcae --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl @@ -0,0 +1,4 @@ +# Try to work around "bad free" messages. See note in ODBM_File.xs. +# Andy Dougherty +# Sun Sep 8 12:57:52 EDT 1996 +$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ; diff --git a/contrib/perl5/ext/ODBM_File/typemap b/contrib/perl5/ext/ODBM_File/typemap new file mode 100644 index 00000000000..5e12e739338 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/typemap @@ -0,0 +1,25 @@ +# +#################################### DBM SECTION +# + +datum T_DATUM +gdatum T_GDATUM +NDBM_File T_PTROBJ +GDBM_File T_PTROBJ +SDBM_File T_PTROBJ +ODBM_File T_PTROBJ +DB_File T_PTROBJ +DBZ_File T_PTROBJ +FATALFUNC T_OPAQUEPTR + +INPUT +T_DATUM + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); diff --git a/contrib/perl5/ext/Opcode/Makefile.PL b/contrib/perl5/ext/Opcode/Makefile.PL new file mode 100644 index 00000000000..48a6ed82b89 --- /dev/null +++ b/contrib/perl5/ext/Opcode/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Opcode', + MAN3PODS => ' ', + VERSION_FROM => 'Opcode.pm', + XS_VERSION => '1.03' +); diff --git a/contrib/perl5/ext/Opcode/Opcode.pm b/contrib/perl5/ext/Opcode/Opcode.pm new file mode 100644 index 00000000000..0ee6be69559 --- /dev/null +++ b/contrib/perl5/ext/Opcode/Opcode.pm @@ -0,0 +1,575 @@ +package Opcode; + +require 5.002; + +use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK); + +$VERSION = "1.04"; +$XS_VERSION = "1.03"; + +use strict; +use Carp; +use Exporter (); +use DynaLoader (); +@ISA = qw(Exporter DynaLoader); + +BEGIN { + @EXPORT_OK = qw( + opset ops_to_opset + opset_to_ops opset_to_hex invert_opset + empty_opset full_opset + opdesc opcodes opmask define_optag + opmask_add verify_opset opdump + ); +} + +sub opset (;@); +sub opset_to_hex ($); +sub opdump (;$); +use subs @EXPORT_OK; + +bootstrap Opcode $XS_VERSION; + +_init_optags(); + +sub ops_to_opset { opset @_ } # alias for old name + +sub opset_to_hex ($) { + return "(invalid opset)" unless verify_opset($_[0]); + unpack("h*",$_[0]); +} + +sub opdump (;$) { + my $pat = shift; + # handy utility: perl -MOpcode=opdump -e 'opdump File' + foreach(opset_to_ops(full_opset)) { + my $op = sprintf " %12s %s\n", $_, opdesc($_); + next if defined $pat and $op !~ m/$pat/i; + print $op; + } +} + + + +sub _init_optags { + my(%all, %seen); + @all{opset_to_ops(full_opset)} = (); # keys only + + local($_); + local($/) = "\n=cut"; # skip to optags definition section + ; + $/ = "\n="; # now read in 'pod section' chunks + while() { + next unless m/^item\s+(:\w+)/; + my $tag = $1; + + # Split into lines, keep only indented lines + my @lines = grep { m/^\s/ } split(/\n/); + foreach (@lines) { s/--.*// } # delete comments + my @ops = map { split ' ' } @lines; # get op words + + foreach(@ops) { + warn "$tag - $_ already tagged in $seen{$_}\n" if $seen{$_}; + $seen{$_} = $tag; + delete $all{$_}; + } + # opset will croak on invalid names + define_optag($tag, opset(@ops)); + } + close(DATA); + warn "Untagged opnames: ".join(' ',keys %all)."\n" if %all; +} + + +1; + +__DATA__ + +=head1 NAME + +Opcode - Disable named opcodes when compiling perl code + +=head1 SYNOPSIS + + use Opcode; + + +=head1 DESCRIPTION + +Perl code is always compiled into an internal format before execution. + +Evaluating perl code (e.g. via "eval" or "do 'file'") causes +the code to be compiled into an internal format and then, +provided there was no error in the compilation, executed. +The internal format is based on many distinct I. + +By default no opmask is in effect and any code can be compiled. + +The Opcode module allow you to define an I to be in +effect when perl I compiles any code. Attempting to compile code +which contains a masked opcode will cause the compilation to fail +with an error. The code will not be executed. + +=head1 NOTE + +The Opcode module is not usually used directly. See the ops pragma and +Safe modules for more typical uses. + +=head1 WARNING + +The authors make B, implied or otherwise, about the +suitability of this software for safety or security purposes. + +The authors shall not in any case be liable for special, incidental, +consequential, indirect or other similar damages arising from the use +of this software. + +Your mileage will vary. If in any doubt B. + + +=head1 Operator Names and Operator Lists + +The canonical list of operator names is the contents of the array +op_name defined and initialised in file F of the Perl +source distribution (and installed into the perl library). + +Each operator has both a terse name (its opname) and a more verbose or +recognisable descriptive name. The opdesc function can be used to +return a list of descriptions for a list of operators. + +Many of the functions and methods listed below take a list of +operators as parameters. Most operator lists can be made up of several +types of element. Each element can be one of + +=over 8 + +=item an operator name (opname) + +Operator names are typically small lowercase words like enterloop, +leaveloop, last, next, redo etc. Sometimes they are rather cryptic +like gv2cv, i_ncmp and ftsvtx. + +=item an operator tag name (optag) + +Operator tags can be used to refer to groups (or sets) of operators. +Tag names always begin with a colon. The Opcode module defines several +optags and the user can define others using the define_optag function. + +=item a negated opname or optag + +An opname or optag can be prefixed with an exclamation mark, e.g., !mkdir. +Negating an opname or optag means remove the corresponding ops from the +accumulated set of ops at that point. + +=item an operator set (opset) + +An I as a binary string of approximately 43 bytes which holds a +set or zero or more operators. + +The opset and opset_to_ops functions can be used to convert from +a list of operators to an opset and I. + +Wherever a list of operators can be given you can use one or more opsets. +See also Manipulating Opsets below. + +=back + + +=head1 Opcode Functions + +The Opcode package contains functions for manipulating operator names +tags and sets. All are available for export by the package. + +=over 8 + +=item opcodes + +In a scalar context opcodes returns the number of opcodes in this +version of perl (around 340 for perl5.002). + +In a list context it returns a list of all the operator names. +(Not yet implemented, use @names = opset_to_ops(full_opset).) + +=item opset (OP, ...) + +Returns an opset containing the listed operators. + +=item opset_to_ops (OPSET) + +Returns a list of operator names corresponding to those operators in +the set. + +=item opset_to_hex (OPSET) + +Returns a string representation of an opset. Can be handy for debugging. + +=item full_opset + +Returns an opset which includes all operators. + +=item empty_opset + +Returns an opset which contains no operators. + +=item invert_opset (OPSET) + +Returns an opset which is the inverse set of the one supplied. + +=item verify_opset (OPSET, ...) + +Returns true if the supplied opset looks like a valid opset (is the +right length etc) otherwise it returns false. If an optional second +parameter is true then verify_opset will croak on an invalid opset +instead of returning false. + +Most of the other Opcode functions call verify_opset automatically +and will croak if given an invalid opset. + +=item define_optag (OPTAG, OPSET) + +Define OPTAG as a symbolic name for OPSET. Optag names always start +with a colon C<:>. + +The optag name used must not be defined already (define_optag will +croak if it is already defined). Optag names are global to the perl +process and optag definitions cannot be altered or deleted once +defined. + +It is strongly recommended that applications using Opcode should use a +leading capital letter on their tag names since lowercase names are +reserved for use by the Opcode module. If using Opcode within a module +you should prefix your tags names with the name of your module to +ensure uniqueness and thus avoid clashes with other modules. + +=item opmask_add (OPSET) + +Adds the supplied opset to the current opmask. Note that there is +currently I mechanism for unmasking ops once they have been masked. +This is intentional. + +=item opmask + +Returns an opset corresponding to the current opmask. + +=item opdesc (OP, ...) + +This takes a list of operator names and returns the corresponding list +of operator descriptions. + +=item opdump (PAT) + +Dumps to STDOUT a two column list of op names and op descriptions. +If an optional pattern is given then only lines which match the +(case insensitive) pattern will be output. + +It's designed to be used as a handy command line utility: + + perl -MOpcode=opdump -e opdump + perl -MOpcode=opdump -e 'opdump Eval' + +=back + +=head1 Manipulating Opsets + +Opsets may be manipulated using the perl bit vector operators & (and), | (or), +^ (xor) and ~ (negate/invert). + +However you should never rely on the numerical position of any opcode +within the opset. In other words both sides of a bit vector operator +should be opsets returned from Opcode functions. + +Also, since the number of opcodes in your current version of perl might +not be an exact multiple of eight, there may be unused bits in the last +byte of an upset. This should not cause any problems (Opcode functions +ignore those extra bits) but it does mean that using the ~ operator +will typically not produce the same 'physical' opset 'string' as the +invert_opset function. + + +=head1 TO DO (maybe) + + $bool = opset_eq($opset1, $opset2) true if opsets are logically eqiv + + $yes = opset_can($opset, @ops) true if $opset has all @ops set + + @diff = opset_diff($opset1, $opset2) => ('foo', '!bar', ...) + +=cut + +# the =cut above is used by _init_optags() to get here quickly + +=head1 Predefined Opcode Tags + +=over 5 + +=item :base_core + + null stub scalar pushmark wantarray const defined undef + + rv2sv sassign + + rv2av aassign aelem aelemfast aslice av2arylen + + rv2hv helem hslice each values keys exists delete + + preinc i_preinc predec i_predec postinc i_postinc postdec i_postdec + int hex oct abs pow multiply i_multiply divide i_divide + modulo i_modulo add i_add subtract i_subtract + + left_shift right_shift bit_and bit_xor bit_or negate i_negate + not complement + + lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp + slt sgt sle sge seq sne scmp + + substr vec stringify study pos length index rindex ord chr + + ucfirst lcfirst uc lc quotemeta trans chop schop chomp schomp + + match split qr + + list lslice splice push pop shift unshift reverse + + cond_expr flip flop andassign orassign and or xor + + warn die lineseq nextstate unstack scope enter leave + + rv2cv anoncode prototype + + entersub leavesub return method -- XXX loops via recursion? + + leaveeval -- needed for Safe to operate, is safe without entereval + +=item :base_mem + +These memory related ops are not included in :base_core because they +can easily be used to implement a resource attack (e.g., consume all +available memory). + + concat repeat join range + + anonlist anonhash + +Note that despite the existance of this optag a memory resource attack +may still be possible using only :base_core ops. + +Disabling these ops is a I heavy handed way to attempt to prevent +a memory resource attack. It's probable that a specific memory limit +mechanism will be added to perl in the near future. + +=item :base_loop + +These loop ops are not included in :base_core because they can easily be +used to implement a resource attack (e.g., consume all available CPU time). + + grepstart grepwhile + mapstart mapwhile + enteriter iter + enterloop leaveloop + last next redo + goto + +=item :base_io + +These ops enable I (rather than filename) based input and +output. These are safe on the assumption that only pre-existing +filehandles are available for use. To create new filehandles other ops +such as open would need to be enabled. + + readline rcatline getc read + + formline enterwrite leavewrite + + print sysread syswrite send recv + + eof tell seek sysseek + + readdir telldir seekdir rewinddir + +=item :base_orig + +These are a hotchpotch of opcodes still waiting to be considered + + gvsv gv gelem + + padsv padav padhv padany + + rv2gv refgen srefgen ref + + bless -- could be used to change ownership of objects (reblessing) + + pushre regcmaybe regcreset regcomp subst substcont + + sprintf prtf -- can core dump + + crypt + + tie untie + + dbmopen dbmclose + sselect select + pipe_op sockpair + + getppid getpgrp setpgrp getpriority setpriority localtime gmtime + + entertry leavetry -- can be used to 'hide' fatal errors + +=item :base_math + +These ops are not included in :base_core because of the risk of them being +used to generate floating point exceptions (which would have to be caught +using a $SIG{FPE} handler). + + atan2 sin cos exp log sqrt + +These ops are not included in :base_core because they have an effect +beyond the scope of the compartment. + + rand srand + +=item :base_thread + +These ops are related to multi-threading. + + lock threadsv + +=item :default + +A handy tag name for a I default set of ops. (The current ops +allowed are unstable while development continues. It will change.) + + :base_core :base_mem :base_loop :base_io :base_orig :base_thread + +If safety matters to you (and why else would you be using the Opcode module?) +then you should not rely on the definition of this, or indeed any other, optag! + + +=item :filesys_read + + stat lstat readlink + + ftatime ftblk ftchr ftctime ftdir fteexec fteowned fteread + ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned + ftrread ftsgid ftsize ftsock ftsuid fttty ftzero ftrwrite ftsvtx + + fttext ftbinary + + fileno + +=item :sys_db + + ghbyname ghbyaddr ghostent shostent ehostent -- hosts + gnbyname gnbyaddr gnetent snetent enetent -- networks + gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols + gsbyname gsbyport gservent sservent eservent -- services + + gpwnam gpwuid gpwent spwent epwent getlogin -- users + ggrnam ggrgid ggrent sgrent egrent -- groups + +=item :browse + +A handy tag name for a I default set of ops beyond the +:default optag. Like :default (and indeed all the other optags) its +current definition is unstable while development continues. It will change. + +The :browse tag represents the next step beyond :default. It it a +superset of the :default ops and adds :filesys_read the :sys_db. +The intent being that scripts can access more (possibly sensitive) +information about your system but not be able to change it. + + :default :filesys_read :sys_db + +=item :filesys_open + + sysopen open close + umask binmode + + open_dir closedir -- other dir ops are in :base_io + +=item :filesys_write + + link unlink rename symlink truncate + + mkdir rmdir + + utime chmod chown + + fcntl -- not strictly filesys related, but possibly as dangerous? + +=item :subprocess + + backtick system + + fork + + wait waitpid + + glob -- access to Cshell via <`rm *`> + +=item :ownprocess + + exec exit kill + + time tms -- could be used for timing attacks (paranoid?) + +=item :others + +This tag holds groups of assorted specialist opcodes that don't warrant +having optags defined for them. + +SystemV Interprocess Communications: + + msgctl msgget msgrcv msgsnd + + semctl semget semop + + shmctl shmget shmread shmwrite + +=item :still_to_be_decided + + chdir + flock ioctl + + socket getpeername ssockopt + bind connect listen accept shutdown gsockopt getsockname + + sleep alarm -- changes global timer state and signal handling + sort -- assorted problems including core dumps + tied -- can be used to access object implementing a tie + pack unpack -- can be used to create/use memory pointers + + entereval -- can be used to hide code from initial compile + require dofile + + caller -- get info about calling environment and args + + reset + + dbstate -- perl -d version of nextstate(ment) opcode + +=item :dangerous + +This tag is simply a bucket for opcodes that are unlikely to be used via +a tag name but need to be tagged for completness and documentation. + + syscall dump chroot + + +=back + +=head1 SEE ALSO + +ops(3) -- perl pragma interface to Opcode module. + +Safe(3) -- Opcode and namespace limited execution compartments + +=head1 AUTHORS + +Originally designed and implemented by Malcolm Beattie, +mbeattie@sable.ox.ac.uk as part of Safe version 1. + +Split out from Safe module version 1, named opcode tags and other +changes added by Tim Bunce. + +=cut + diff --git a/contrib/perl5/ext/Opcode/Opcode.xs b/contrib/perl5/ext/Opcode/Opcode.xs new file mode 100644 index 00000000000..e853cf19a36 --- /dev/null +++ b/contrib/perl5/ext/Opcode/Opcode.xs @@ -0,0 +1,468 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:) */ +#define OP_MASK_BUF_SIZE (MAXO + 100) + +/* XXX op_named_bits and opset_all are never freed */ +static HV *op_named_bits; /* cache shared for whole process */ +static SV *opset_all; /* mask with all bits set */ +static IV opset_len; /* length of opmasks in bytes */ +static int opcode_debug = 0; + +static SV *new_opset _((SV *old_opset)); +static int verify_opset _((SV *opset, int fatal)); +static void set_opset_bits _((char *bitmap, SV *bitspec, int on, char *opname)); +static void put_op_bitspec _((char *optag, STRLEN len, SV *opset)); +static SV *get_op_bitspec _((char *opname, STRLEN len, int fatal)); + + +/* Initialise our private op_named_bits HV. + * It is first loaded with the name and number of each perl operator. + * Then the builtin tags :none and :all are added. + * Opcode.pm loads the standard optags from __DATA__ + * XXX leak-alert: data allocated here is never freed, call this + * at most once + */ + +static void +op_names_init(void) +{ + int i; + STRLEN len; + char **op_names; + char *bitmap; + + op_named_bits = newHV(); + op_names = get_op_names(); + for(i=0; i < PL_maxo; ++i) { + SV *sv; + sv = newSViv(i); + SvREADONLY_on(sv); + hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); + } + + put_op_bitspec(":none",0, sv_2mortal(new_opset(Nullsv))); + + opset_all = new_opset(Nullsv); + bitmap = SvPV(opset_all, len); + i = len-1; /* deal with last byte specially, see below */ + while(i-- > 0) + bitmap[i] = 0xFF; + /* Take care to set the right number of bits in the last byte */ + bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; + put_op_bitspec(":all",0, opset_all); /* don't mortalise */ +} + + +/* Store a new tag definition. Always a mask. + * The tag must not already be defined. + * SV *mask is copied not referenced. + */ + +static void +put_op_bitspec(char *optag, STRLEN len, SV *mask) +{ + SV **svp; + verify_opset(mask,1); + if (!len) + len = strlen(optag); + svp = hv_fetch(op_named_bits, optag, len, 1); + if (SvOK(*svp)) + croak("Opcode tag \"%s\" already defined", optag); + sv_setsv(*svp, mask); + SvREADONLY_on(*svp); +} + + + +/* Fetch a 'bits' entry for an opname or optag (IV/PV). + * Note that we return the actual entry for speed. + * Always sv_mortalcopy() if returing it to user code. + */ + +static SV * +get_op_bitspec(char *opname, STRLEN len, int fatal) +{ + SV **svp; + if (!len) + len = strlen(opname); + svp = hv_fetch(op_named_bits, opname, len, 0); + if (!svp || !SvOK(*svp)) { + if (!fatal) + return Nullsv; + if (*opname == ':') + croak("Unknown operator tag \"%s\"", opname); + if (*opname == '!') /* XXX here later, or elsewhere? */ + croak("Can't negate operators here (\"%s\")", opname); + if (isALPHA(*opname)) + croak("Unknown operator name \"%s\"", opname); + croak("Unknown operator prefix \"%s\"", opname); + } + return *svp; +} + + + +static SV * +new_opset(SV *old_opset) +{ + SV *opset; + if (old_opset) { + verify_opset(old_opset,1); + opset = newSVsv(old_opset); + } + else { + opset = NEWSV(1156, opset_len); + Zero(SvPVX(opset), opset_len + 1, char); + SvCUR_set(opset, opset_len); + (void)SvPOK_only(opset); + } + /* not mortalised here */ + return opset; +} + + +static int +verify_opset(SV *opset, int fatal) +{ + char *err = Nullch; + if (!SvOK(opset)) err = "undefined"; + else if (!SvPOK(opset)) err = "wrong type"; + else if (SvCUR(opset) != opset_len) err = "wrong size"; + if (err && fatal) { + croak("Invalid opset: %s", err); + } + return !err; +} + + +static void +set_opset_bits(char *bitmap, SV *bitspec, int on, char *opname) +{ + if (SvIOK(bitspec)) { + int myopcode = SvIV(bitspec); + int offset = myopcode >> 3; + int bit = myopcode & 0x07; + if (myopcode >= PL_maxo || myopcode < 0) + croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode); + if (opcode_debug >= 2) + warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n", + myopcode, offset, bit, opname, (on)?"on":"off"); + if (on) + bitmap[offset] |= 1 << bit; + else + bitmap[offset] &= ~(1 << bit); + } + else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { + + STRLEN len; + char *specbits = SvPV(bitspec, len); + if (opcode_debug >= 2) + warn("set_opset_bits opset %s %s\n", opname, (on)?"on":"off"); + if (on) + while(len-- > 0) bitmap[len] |= specbits[len]; + else + while(len-- > 0) bitmap[len] &= ~specbits[len]; + } + else + croak("panic: invalid bitspec for \"%s\" (type %u)", + opname, (unsigned)SvTYPE(bitspec)); +} + + +static void +opmask_add(SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */ +{ + int i,j; + char *bitmask; + STRLEN len; + int myopcode = 0; + + verify_opset(opset,1); /* croaks on bad opset */ + + if (!PL_op_mask) /* caller must ensure PL_op_mask exists */ + croak("Can't add to uninitialised PL_op_mask"); + + /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal() */ + + bitmask = SvPV(opset, len); + for (i=0; i < opset_len; i++) { + U16 bits = bitmask[i]; + if (!bits) { /* optimise for sparse masks */ + myopcode += 8; + continue; + } + for (j=0; j < 8 && myopcode < PL_maxo; ) + PL_op_mask[myopcode++] |= bits & (1 << j++); + } +} + +static void +opmask_addlocal(SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ +{ + char *orig_op_mask = PL_op_mask; + SAVEPPTR(PL_op_mask); +#if !defined(PERL_OBJECT) + /* XXX casting to an ordinary function ptr from a member function ptr + * is disallowed by Borland + */ + if (opcode_debug >= 2) + SAVEDESTRUCTOR((void(CPERLscope(*))_((void*)))warn,"PL_op_mask restored"); +#endif + PL_op_mask = &op_mask_buf[0]; + if (orig_op_mask) + Copy(orig_op_mask, PL_op_mask, PL_maxo, char); + else + Zero(PL_op_mask, PL_maxo, char); + opmask_add(opset); +} + + + +MODULE = Opcode PACKAGE = Opcode + +PROTOTYPES: ENABLE + +BOOT: + assert(PL_maxo < OP_MASK_BUF_SIZE); + opset_len = (PL_maxo + 7) / 8; + if (opcode_debug >= 1) + warn("opset_len %ld\n", (long)opset_len); + op_names_init(); + + +void +_safe_call_sv(Package, mask, codesv) + char * Package + SV * mask + SV * codesv +PPCODE: + char op_mask_buf[OP_MASK_BUF_SIZE]; + GV *gv; + + ENTER; + + opmask_addlocal(mask, op_mask_buf); + + save_aptr(&PL_endav); + PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ + + save_hptr(&PL_defstash); /* save current default stack */ + /* the assignment to global defstash changes our sense of 'main' */ + PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ + + /* defstash must itself contain a main:: so we'll add that now */ + /* take care with the ref counts (was cause of long standing bug) */ + /* XXX I'm still not sure if this is right, GV_ADDWARN should warn! */ + gv = gv_fetchpv("main::", GV_ADDWARN, SVt_PVHV); + sv_free((SV*)GvHV(gv)); + GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); + + PUSHMARK(SP); + perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ + SPAGAIN; /* for the PUTBACK added by xsubpp */ + LEAVE; + + +int +verify_opset(opset, fatal = 0) + SV *opset + int fatal + + +void +invert_opset(opset) + SV *opset +CODE: + { + char *bitmap; + STRLEN len = opset_len; + opset = sv_2mortal(new_opset(opset)); /* verify and clone opset */ + bitmap = SvPVX(opset); + while(len-- > 0) + bitmap[len] = ~bitmap[len]; + /* take care of extra bits beyond PL_maxo in last byte */ + if (PL_maxo & 07) + bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07)); + } + ST(0) = opset; + + +void +opset_to_ops(opset, desc = 0) + SV *opset + int desc +PPCODE: + { + STRLEN len; + int i, j, myopcode; + char *bitmap = SvPV(opset, len); + char **names = (desc) ? get_op_descs() : get_op_names(); + verify_opset(opset,1); + for (myopcode=0, i=0; i < opset_len; i++) { + U16 bits = bitmap[i]; + for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { + if ( bits & (1 << j) ) + XPUSHs(sv_2mortal(newSVpv(names[myopcode], 0))); + } + } + } + + +void +opset(...) +CODE: + int i, j; + SV *bitspec, *opset; + char *bitmap; + STRLEN len, on; + opset = sv_2mortal(new_opset(Nullsv)); + bitmap = SvPVX(opset); + for (i = 0; i < items; i++) { + char *opname; + on = 1; + if (verify_opset(ST(i),0)) { + opname = "(opset)"; + bitspec = ST(i); + } + else { + opname = SvPV(ST(i), len); + if (*opname == '!') { on=0; ++opname;--len; } + bitspec = get_op_bitspec(opname, len, 1); + } + set_opset_bits(bitmap, bitspec, on, opname); + } + ST(0) = opset; + + +#define PERMITING (ix == 0 || ix == 1) +#define ONLY_THESE (ix == 0 || ix == 2) + +void +permit_only(safe, ...) + SV *safe +ALIAS: + permit = 1 + deny_only = 2 + deny = 3 +CODE: + int i, on; + SV *bitspec, *mask; + char *bitmap, *opname; + STRLEN len; + + if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) + croak("Not a Safe object"); + mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1); + if (ONLY_THESE) /* *_only = new mask, else edit current */ + sv_setsv(mask, sv_2mortal(new_opset(PERMITING ? opset_all : Nullsv))); + else + verify_opset(mask,1); /* croaks */ + bitmap = SvPVX(mask); + for (i = 1; i < items; i++) { + on = PERMITING ? 0 : 1; /* deny = mask bit on */ + if (verify_opset(ST(i),0)) { /* it's a valid mask */ + opname = "(opset)"; + bitspec = ST(i); + } + else { /* it's an opname/optag */ + opname = SvPV(ST(i), len); + /* invert if op has ! prefix (only one allowed) */ + if (*opname == '!') { on = !on; ++opname; --len; } + bitspec = get_op_bitspec(opname, len, 1); /* croaks */ + } + set_opset_bits(bitmap, bitspec, on, opname); + } + ST(0) = &PL_sv_yes; + + + +void +opdesc(...) +PPCODE: + int i, myopcode; + STRLEN len; + SV **args; + char **op_desc = get_op_descs(); + /* copy args to a scratch area since we may push output values onto */ + /* the stack faster than we read values off it if masks are used. */ + args = (SV**)SvPVX(sv_2mortal(newSVpv((char*)&ST(0), items*sizeof(SV*)))); + for (i = 0; i < items; i++) { + char *opname = SvPV(args[i], len); + SV *bitspec = get_op_bitspec(opname, len, 1); + if (SvIOK(bitspec)) { + myopcode = SvIV(bitspec); + if (myopcode < 0 || myopcode >= PL_maxo) + croak("panic: opcode %d (%s) out of range",myopcode,opname); + XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); + } + else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { + int b, j; + char *bitmap = SvPV(bitspec,PL_na); + myopcode = 0; + for (b=0; b < opset_len; b++) { + U16 bits = bitmap[b]; + for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) + if (bits & (1 << j)) + XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); + } + } + else + croak("panic: invalid bitspec for \"%s\" (type %u)", + opname, (unsigned)SvTYPE(bitspec)); + } + + +void +define_optag(optagsv, mask) + SV *optagsv + SV *mask +CODE: + STRLEN len; + char *optag = SvPV(optagsv, len); + put_op_bitspec(optag, len, mask); /* croaks */ + ST(0) = &PL_sv_yes; + + +void +empty_opset() +CODE: + ST(0) = sv_2mortal(new_opset(Nullsv)); + +void +full_opset() +CODE: + ST(0) = sv_2mortal(new_opset(opset_all)); + +void +opmask_add(opset) + SV *opset +PREINIT: + if (!PL_op_mask) + Newz(0, PL_op_mask, PL_maxo, char); + +void +opcodes() +PPCODE: + if (GIMME == G_ARRAY) { + croak("opcodes in list context not yet implemented"); /* XXX */ + } + else { + XPUSHs(sv_2mortal(newSViv(PL_maxo))); + } + +void +opmask() +CODE: + ST(0) = sv_2mortal(new_opset(Nullsv)); + if (PL_op_mask) { + char *bitmap = SvPVX(ST(0)); + int myopcode; + for(myopcode=0; myopcode < PL_maxo; ++myopcode) { + if (PL_op_mask[myopcode]) + bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); + } + } + diff --git a/contrib/perl5/ext/Opcode/Safe.pm b/contrib/perl5/ext/Opcode/Safe.pm new file mode 100644 index 00000000000..940a972fd1b --- /dev/null +++ b/contrib/perl5/ext/Opcode/Safe.pm @@ -0,0 +1,559 @@ +package Safe; + +use 5.003_11; +use strict; +use vars qw($VERSION); + +$VERSION = "2.06"; + +use Carp; + +use Opcode 1.01, qw( + opset opset_to_ops opmask_add + empty_opset full_opset invert_opset verify_opset + opdesc opcodes opmask define_optag opset_to_hex +); + +*ops_to_opset = \&opset; # Temporary alias for old Penguins + + +my $default_root = 0; +my $default_share = ['*_']; #, '*main::']; + +sub new { + my($class, $root, $mask) = @_; + my $obj = {}; + bless $obj, $class; + + if (defined($root)) { + croak "Can't use \"$root\" as root name" + if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/; + $obj->{Root} = $root; + $obj->{Erase} = 0; + } + else { + $obj->{Root} = "Safe::Root".$default_root++; + $obj->{Erase} = 1; + } + + # use permit/deny methods instead till interface issues resolved + # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...; + croak "Mask parameter to new no longer supported" if defined $mask; + $obj->permit_only(':default'); + + # We must share $_ and @_ with the compartment or else ops such + # as split, length and so on won't default to $_ properly, nor + # will passing argument to subroutines work (via @_). In fact, + # for reasons I don't completely understand, we need to share + # the whole glob *_ rather than $_ and @_ separately, otherwise + # @_ in non default packages within the compartment don't work. + $obj->share_from('main', $default_share); + return $obj; +} + +sub DESTROY { + my $obj = shift; + $obj->erase('DESTROY') if $obj->{Erase}; +} + +sub erase { + my ($obj, $action) = @_; + my $pkg = $obj->root(); + my ($stem, $leaf); + + no strict 'refs'; + $pkg = "main::$pkg\::"; # expand to full symbol table name + ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; + + # The 'my $foo' is needed! Without it you get an + # 'Attempt to free unreferenced scalar' warning! + my $stem_symtab = *{$stem}{HASH}; + + #warn "erase($pkg) stem=$stem, leaf=$leaf"; + #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n"; + # ", join(', ', %$stem_symtab),"\n"; + +# delete $stem_symtab->{$leaf}; + + my $leaf_glob = $stem_symtab->{$leaf}; + my $leaf_symtab = *{$leaf_glob}{HASH}; +# warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n"; + %$leaf_symtab = (); + #delete $leaf_symtab->{'__ANON__'}; + #delete $leaf_symtab->{'foo'}; + #delete $leaf_symtab->{'main::'}; +# my $foo = undef ${"$stem\::"}{"$leaf\::"}; + + if ($action and $action eq 'DESTROY') { + delete $stem_symtab->{$leaf}; + } else { + $obj->share_from('main', $default_share); + } + 1; +} + + +sub reinit { + my $obj= shift; + $obj->erase; + $obj->share_redo; +} + +sub root { + my $obj = shift; + croak("Safe root method now read-only") if @_; + return $obj->{Root}; +} + + +sub mask { + my $obj = shift; + return $obj->{Mask} unless @_; + $obj->deny_only(@_); +} + +# v1 compatibility methods +sub trap { shift->deny(@_) } +sub untrap { shift->permit(@_) } + +sub deny { + my $obj = shift; + $obj->{Mask} |= opset(@_); +} +sub deny_only { + my $obj = shift; + $obj->{Mask} = opset(@_); +} + +sub permit { + my $obj = shift; + # XXX needs testing + $obj->{Mask} &= invert_opset opset(@_); +} +sub permit_only { + my $obj = shift; + $obj->{Mask} = invert_opset opset(@_); +} + + +sub dump_mask { + my $obj = shift; + print opset_to_hex($obj->{Mask}),"\n"; +} + + + +sub share { + my($obj, @vars) = @_; + $obj->share_from(scalar(caller), \@vars); +} + +sub share_from { + my $obj = shift; + my $pkg = shift; + my $vars = shift; + my $no_record = shift || 0; + my $root = $obj->root(); + croak("vars not an array ref") unless ref $vars eq 'ARRAY'; + no strict 'refs'; + # Check that 'from' package actually exists + croak("Package \"$pkg\" does not exist") + unless keys %{"$pkg\::"}; + my $arg; + foreach $arg (@$vars) { + # catch some $safe->share($var) errors: + croak("'$arg' not a valid symbol table name") + unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/ + or $arg =~ /^\$\W$/; + my ($var, $type); + $type = $1 if ($var = $arg) =~ s/^(\W)//; + # warn "share_from $pkg $type $var"; + *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} + : ($type eq '&') ? \&{$pkg."::$var"} + : ($type eq '$') ? \${$pkg."::$var"} + : ($type eq '@') ? \@{$pkg."::$var"} + : ($type eq '%') ? \%{$pkg."::$var"} + : ($type eq '*') ? *{$pkg."::$var"} + : croak(qq(Can't share "$type$var" of unknown type)); + } + $obj->share_record($pkg, $vars) unless $no_record or !$vars; +} + +sub share_record { + my $obj = shift; + my $pkg = shift; + my $vars = shift; + my $shares = \%{$obj->{Shares} ||= {}}; + # Record shares using keys of $obj->{Shares}. See reinit. + @{$shares}{@$vars} = ($pkg) x @$vars if @$vars; +} +sub share_redo { + my $obj = shift; + my $shares = \%{$obj->{Shares} ||= {}}; + my($var, $pkg); + while(($var, $pkg) = each %$shares) { + # warn "share_redo $pkg\:: $var"; + $obj->share_from($pkg, [ $var ], 1); + } +} +sub share_forget { + delete shift->{Shares}; +} + +sub varglob { + my ($obj, $var) = @_; + no strict 'refs'; + return *{$obj->root()."::$var"}; +} + + +sub reval { + my ($obj, $expr, $strict) = @_; + my $root = $obj->{Root}; + + # Create anon sub ref in root of compartment. + # Uses a closure (on $expr) to pass in the code to be executed. + # (eval on one line to keep line numbers as expected by caller) + my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); + my $evalsub; + + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } + + return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); +} + +sub rdo { + my ($obj, $file) = @_; + my $root = $obj->{Root}; + + my $evalsub = eval + sprintf('package %s; sub { do $file }', $root); + return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); +} + + +1; + +__DATA__ + +=head1 NAME + +Safe - Compile and execute code in restricted compartments + +=head1 SYNOPSIS + + use Safe; + + $compartment = new Safe; + + $compartment->permit(qw(time sort :browse)); + + $result = $compartment->reval($unsafe_code); + +=head1 DESCRIPTION + +The Safe extension module allows the creation of compartments +in which perl code can be evaluated. Each compartment has + +=over 8 + +=item a new namespace + +The "root" of the namespace (i.e. "main::") is changed to a +different package and code evaluated in the compartment cannot +refer to variables outside this namespace, even with run-time +glob lookups and other tricks. + +Code which is compiled outside the compartment can choose to place +variables into (or I variables with) the compartment's namespace +and only that data will be visible to code evaluated in the +compartment. + +By default, the only variables shared with compartments are the +"underscore" variables $_ and @_ (and, technically, the less frequently +used %_, the _ filehandle and so on). This is because otherwise perl +operators which default to $_ will not work and neither will the +assignment of arguments to @_ on subroutine entry. + +=item an operator mask + +Each compartment has an associated "operator mask". Recall that +perl code is compiled into an internal format before execution. +Evaluating perl code (e.g. via "eval" or "do 'file'") causes +the code to be compiled into an internal format and then, +provided there was no error in the compilation, executed. +Code evaulated in a compartment compiles subject to the +compartment's operator mask. Attempting to evaulate code in a +compartment which contains a masked operator will cause the +compilation to fail with an error. The code will not be executed. + +The default operator mask for a newly created compartment is +the ':default' optag. + +It is important that you read the Opcode(3) module documentation +for more information, especially for detailed definitions of opnames, +optags and opsets. + +Since it is only at the compilation stage that the operator mask +applies, controlled access to potentially unsafe operations can +be achieved by having a handle to a wrapper subroutine (written +outside the compartment) placed into the compartment. For example, + + $cpt = new Safe; + sub wrapper { + # vet arguments and perform potentially unsafe operations + } + $cpt->share('&wrapper'); + +=back + + +=head1 WARNING + +The authors make B, implied or otherwise, about the +suitability of this software for safety or security purposes. + +The authors shall not in any case be liable for special, incidental, +consequential, indirect or other similar damages arising from the use +of this software. + +Your mileage will vary. If in any doubt B. + + +=head2 RECENT CHANGES + +The interface to the Safe module has changed quite dramatically since +version 1 (as supplied with Perl5.002). Study these pages carefully if +you have code written to use Safe version 1 because you will need to +makes changes. + + +=head2 Methods in class Safe + +To create a new compartment, use + + $cpt = new Safe; + +Optional argument is (NAMESPACE), where NAMESPACE is the root namespace +to use for the compartment (defaults to "Safe::Root0", incremented for +each new compartment). + +Note that version 1.00 of the Safe module supported a second optional +parameter, MASK. That functionality has been withdrawn pending deeper +consideration. Use the permit and deny methods described below. + +The following methods can then be used on the compartment +object returned by the above constructor. The object argument +is implicit in each case. + + +=over 8 + +=item permit (OP, ...) + +Permit the listed operators to be used when compiling code in the +compartment (in I to any operators already permitted). + +=item permit_only (OP, ...) + +Permit I the listed operators to be used when compiling code in +the compartment (I other operators are permitted). + +=item deny (OP, ...) + +Deny the listed operators from being used when compiling code in the +compartment (other operators may still be permitted). + +=item deny_only (OP, ...) + +Deny I the listed operators from being used when compiling code +in the compartment (I other operators will be permitted). + +=item trap (OP, ...) + +=item untrap (OP, ...) + +The trap and untrap methods are synonyms for deny and permit +respectfully. + +=item share (NAME, ...) + +This shares the variable(s) in the argument list with the compartment. +This is almost identical to exporting variables using the L +module. + +Each NAME must be the B of a variable, typically with the leading +type identifier included. A bareword is treated as a function name. + +Examples of legal names are '$foo' for a scalar, '@foo' for an +array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo' +for a glob (i.e. all symbol table entries associated with "foo", +including scalar, array, hash, sub and filehandle). + +Each NAME is assumed to be in the calling package. See share_from +for an alternative method (which share uses). + +=item share_from (PACKAGE, ARRAYREF) + +This method is similar to share() but allows you to explicitly name the +package that symbols should be shared from. The symbol names (including +type characters) are supplied as an array reference. + + $safe->share_from('main', [ '$foo', '%bar', 'func' ]); + + +=item varglob (VARNAME) + +This returns a glob reference for the symbol table entry of VARNAME in +the package of the compartment. VARNAME must be the B of a +variable without any leading type marker. For example, + + $cpt = new Safe 'Root'; + $Root::foo = "Hello world"; + # Equivalent version which doesn't need to know $cpt's package name: + ${$cpt->varglob('foo')} = "Hello world"; + + +=item reval (STRING) + +This evaluates STRING as perl code inside the compartment. + +The code can only see the compartment's namespace (as returned by the +B method). The compartment's root package appears to be the +C package to the code inside the compartment. + +Any attempt by the code in STRING to use an operator which is not permitted +by the compartment will cause an error (at run-time of the main program +but at compile-time for the code in STRING). The error is of the form +"%s trapped by operation mask operation...". + +If an operation is trapped in this way, then the code in STRING will +not be executed. If such a trapped operation occurs or any other +compile-time or return error, then $@ is set to the error message, just +as with an eval(). + +If there is no error, then the method returns the value of the last +expression evaluated, or a return statement may be used, just as with +subroutines and B. The context (list or scalar) is determined +by the caller as usual. + +This behaviour differs from the beta distribution of the Safe extension +where earlier versions of perl made it hard to mimic the return +behaviour of the eval() command and the context was always scalar. + +Some points to note: + +If the entereval op is permitted then the code can use eval "..." to +'hide' code which might use denied ops. This is not a major problem +since when the code tries to execute the eval it will fail because the +opmask is still in effect. However this technique would allow clever, +and possibly harmful, code to 'probe' the boundaries of what is +possible. + +Any string eval which is executed by code executing in a compartment, +or by code called from code executing in a compartment, will be eval'd +in the namespace of the compartment. This is potentially a serious +problem. + +Consider a function foo() in package pkg compiled outside a compartment +but shared with it. Assume the compartment has a root package called +'Root'. If foo() contains an eval statement like eval '$foo = 1' then, +normally, $pkg::foo will be set to 1. If foo() is called from the +compartment (by whatever means) then instead of setting $pkg::foo, the +eval will actually set $Root::pkg::foo. + +This can easily be demonstrated by using a module, such as the Socket +module, which uses eval "..." as part of an AUTOLOAD function. You can +'use' the module outside the compartment and share an (autoloaded) +function with the compartment. If an autoload is triggered by code in +the compartment, or by any code anywhere that is called by any means +from the compartment, then the eval in the Socket module's AUTOLOAD +function happens in the namespace of the compartment. Any variables +created or used by the eval'd code are now under the control of +the code in the compartment. + +A similar effect applies to I runtime symbol lookups in code +called from a compartment but not compiled within it. + + + +=item rdo (FILENAME) + +This evaluates the contents of file FILENAME inside the compartment. +See above documentation on the B method for further details. + +=item root (NAMESPACE) + +This method returns the name of the package that is the root of the +compartment's namespace. + +Note that this behaviour differs from version 1.00 of the Safe module +where the root module could be used to change the namespace. That +functionality has been withdrawn pending deeper consideration. + +=item mask (MASK) + +This is a get-or-set method for the compartment's operator mask. + +With no MASK argument present, it returns the current operator mask of +the compartment. + +With the MASK argument present, it sets the operator mask for the +compartment (equivalent to calling the deny_only method). + +=back + + +=head2 Some Safety Issues + +This section is currently just an outline of some of the things code in +a compartment might do (intentionally or unintentionally) which can +have an effect outside the compartment. + +=over 8 + +=item Memory + +Consuming all (or nearly all) available memory. + +=item CPU + +Causing infinite loops etc. + +=item Snooping + +Copying private information out of your system. Even something as +simple as your user name is of value to others. Much useful information +could be gleaned from your environment variables for example. + +=item Signals + +Causing signals (especially SIGFPE and SIGALARM) to affect your process. + +Setting up a signal handler will need to be carefully considered +and controlled. What mask is in effect when a signal handler +gets called? If a user can get an imported function to get an +exception and call the user's signal handler, does that user's +restricted mask get re-instated before the handler is called? +Does an imported handler get called with its original mask or +the user's one? + +=item State Changes + +Ops such as chdir obviously effect the process as a whole and not just +the code in the compartment. Ops such as rand and srand have a similar +but more subtle effect. + +=back + +=head2 AUTHOR + +Originally designed and implemented by Malcolm Beattie, +mbeattie@sable.ox.ac.uk. + +Reworked to use the Opcode module and other changes added by Tim Bunce +EFE. + +=cut + diff --git a/contrib/perl5/ext/Opcode/ops.pm b/contrib/perl5/ext/Opcode/ops.pm new file mode 100644 index 00000000000..b9ea36cef39 --- /dev/null +++ b/contrib/perl5/ext/Opcode/ops.pm @@ -0,0 +1,45 @@ +package ops; + +use Opcode qw(opmask_add opset invert_opset); + +sub import { + shift; + # Not that unimport is the prefered form since import's don't + # accumulate well owing to the 'only ever add opmask' rule. + # E.g., perl -Mops=:set1 -Mops=:setb is unlikely to do as expected. + opmask_add(invert_opset opset(@_)) if @_; +} + +sub unimport { + shift; + opmask_add(opset(@_)) if @_; +} + +1; + +__END__ + +=head1 NAME + +ops - Perl pragma to restrict unsafe operations when compiling + +=head1 SYNOPSIS + + perl -Mops=:default ... # only allow reasonably safe operations + + perl -M-ops=system ... # disable the 'system' opcode + +=head1 DESCRIPTION + +Since the ops pragma currently has an irreversable global effect, it is +only of significant practical use with the C<-M> option on the command line. + +See the L module for information about opcodes, optags, opmasks +and important information about safety. + +=head1 SEE ALSO + +Opcode(3), Safe(3), perlrun(3) + +=cut + diff --git a/contrib/perl5/ext/POSIX/Makefile.PL b/contrib/perl5/ext/POSIX/Makefile.PL new file mode 100644 index 00000000000..bc1dda9387b --- /dev/null +++ b/contrib/perl5/ext/POSIX/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'POSIX', + ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'POSIX.pm', +); diff --git a/contrib/perl5/ext/POSIX/POSIX.pm b/contrib/perl5/ext/POSIX/POSIX.pm new file mode 100644 index 00000000000..5d3ef5cb503 --- /dev/null +++ b/contrib/perl5/ext/POSIX/POSIX.pm @@ -0,0 +1,926 @@ +package POSIX; + +use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT_OK $AUTOLOAD); + +use Carp; +use AutoLoader; +require Config; +use Symbol; + +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); + +$VERSION = "1.02" ; + +%EXPORT_TAGS = ( + + assert_h => [qw(assert NDEBUG)], + + ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower + isprint ispunct isspace isupper isxdigit tolower toupper)], + + dirent_h => [qw()], + + errno_h => [qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT + EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED + ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT + EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS + EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK + EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH + ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM + ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR + ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM + EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE + ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT + ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY + EUSERS EWOULDBLOCK EXDEV errno)], + + fcntl_h => [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK + F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK + O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK + O_RDONLY O_RDWR O_TRUNC O_WRONLY + creat + SEEK_CUR SEEK_END SEEK_SET + S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID + S_IWGRP S_IWOTH S_IWUSR)], + + float_h => [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG + DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP + DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP + FLT_DIG FLT_EPSILON FLT_MANT_DIG + FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP + FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP + FLT_RADIX FLT_ROUNDS + LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG + LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP + LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)], + + grp_h => [qw()], + + limits_h => [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX + INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON + MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX + PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN + SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX + ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX + _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT + _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX + _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX + _POSIX_STREAM_MAX _POSIX_TZNAME_MAX)], + + locale_h => [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC + LC_TIME NULL localeconv setlocale)], + + math_h => [qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod + frexp ldexp log10 modf pow sinh tan tanh)], + + pwd_h => [qw()], + + setjmp_h => [qw(longjmp setjmp siglongjmp sigsetjmp)], + + signal_h => [qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK + SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM + SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL + SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN + SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR + SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal + sigpending sigprocmask sigsuspend)], + + stdarg_h => [qw()], + + stddef_h => [qw(NULL offsetof)], + + stdio_h => [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid + L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET + STREAM_MAX TMP_MAX stderr stdin stdout + clearerr fclose fdopen feof ferror fflush fgetc fgetpos + fgets fopen fprintf fputc fputs fread freopen + fscanf fseek fsetpos ftell fwrite getchar gets + perror putc putchar puts remove rewind + scanf setbuf setvbuf sscanf tmpfile tmpnam + ungetc vfprintf vprintf vsprintf)], + + stdlib_h => [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX + abort atexit atof atoi atol bsearch calloc div + free getenv labs ldiv malloc mblen mbstowcs mbtowc + qsort realloc strtod strtol strtoul wcstombs wctomb)], + + string_h => [qw(NULL memchr memcmp memcpy memmove memset strcat + strchr strcmp strcoll strcpy strcspn strerror strlen + strncat strncmp strncpy strpbrk strrchr strspn strstr + strtok strxfrm)], + + sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG + S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR + fstat mkfifo)], + + sys_times_h => [qw()], + + sys_types_h => [qw()], + + sys_utsname_h => [qw(uname)], + + sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED + WNOHANG WSTOPSIG WTERMSIG WUNTRACED)], + + termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400 + B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL + CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK + ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR + INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST + PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION + TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW + TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART + VSTOP VSUSP VTIME + cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain + tcflow tcflush tcgetattr tcsendbreak tcsetattr )], + + time_h => [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime + difftime mktime strftime tzset tzname)], + + unistd_h => [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET + STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK + _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON + _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX + _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED + _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS + _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX + _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL + _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS + _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION + _exit access ctermid cuserid + dup2 dup execl execle execlp execv execve execvp + fpathconf getcwd getegid geteuid getgid getgroups + getpid getuid isatty lseek pathconf pause setgid setpgid + setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)], + + utime_h => [qw()], + +); + +Exporter::export_tags(); + +@EXPORT_OK = qw( + closedir opendir readdir rewinddir + fcntl open + getgrgid getgrnam + atan2 cos exp log sin sqrt + getpwnam getpwuid + kill + fileno getc printf rename sprintf + abs exit rand srand system + chmod mkdir stat umask + times + wait waitpid + gmtime localtime time + alarm chdir chown close fork getlogin getppid getpgrp link + pipe read rmdir sleep unlink write + utime + nice +); + +# Grandfather old foo_h form to new :foo_h form +sub import { + my $this = shift; + my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_; + local $Exporter::ExportLevel = 1; + Exporter::import($this,@list); +} + + +bootstrap POSIX $VERSION; + +my $EINVAL = constant("EINVAL", 0); +my $EAGAIN = constant("EAGAIN", 0); + +sub AUTOLOAD { + if ($AUTOLOAD =~ /::(_?[a-z])/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD + } + local $! = 0; + my $constname = $AUTOLOAD; + $constname =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! == 0) { + *$AUTOLOAD = sub { $val }; + } + elsif ($! == $EAGAIN) { # Not really a constant, so always call. + *$AUTOLOAD = sub { constant($constname, $_[0]) }; + } + elsif ($! == $EINVAL) { + croak "$constname is not a valid POSIX macro"; + } + else { + croak "Your vendor has not defined POSIX macro $constname, used"; + } + + goto &$AUTOLOAD; +} + +sub usage { + my ($mess) = @_; + croak "Usage: POSIX::$mess"; +} + +sub redef { + my ($mess) = @_; + croak "Use method $mess instead"; +} + +sub unimpl { + my ($mess) = @_; + $mess =~ s/xxx//; + croak "Unimplemented: POSIX::$mess"; +} + +############################ +package POSIX::SigAction; + +sub new { + bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0]; +} + +############################ +package POSIX; # return to package POSIX so AutoSplit is happy +1; +__END__ + +sub assert { + usage "assert(expr)" if @_ != 1; + if (!$_[0]) { + croak "Assertion failed"; + } +} + +sub tolower { + usage "tolower(string)" if @_ != 1; + lc($_[0]); +} + +sub toupper { + usage "toupper(string)" if @_ != 1; + uc($_[0]); +} + +sub closedir { + usage "closedir(dirhandle)" if @_ != 1; + closedir($_[0]); +} + +sub opendir { + usage "opendir(directory)" if @_ != 1; + my $dirhandle = gensym; + opendir($dirhandle, $_[0]) + ? $dirhandle + : undef; +} + +sub readdir { + usage "readdir(dirhandle)" if @_ != 1; + readdir($_[0]); +} + +sub rewinddir { + usage "rewinddir(dirhandle)" if @_ != 1; + rewinddir($_[0]); +} + +sub errno { + usage "errno()" if @_ != 0; + $! + 0; +} + +sub creat { + usage "creat(filename, mode)" if @_ != 2; + &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]); +} + +sub fcntl { + usage "fcntl(filehandle, cmd, arg)" if @_ != 3; + fcntl($_[0], $_[1], $_[2]); +} + +sub getgrgid { + usage "getgrgid(gid)" if @_ != 1; + getgrgid($_[0]); +} + +sub getgrnam { + usage "getgrnam(name)" if @_ != 1; + getgrnam($_[0]); +} + +sub atan2 { + usage "atan2(x,y)" if @_ != 2; + atan2($_[0], $_[1]); +} + +sub cos { + usage "cos(x)" if @_ != 1; + cos($_[0]); +} + +sub exp { + usage "exp(x)" if @_ != 1; + exp($_[0]); +} + +sub fabs { + usage "fabs(x)" if @_ != 1; + abs($_[0]); +} + +sub log { + usage "log(x)" if @_ != 1; + log($_[0]); +} + +sub pow { + usage "pow(x,exponent)" if @_ != 2; + $_[0] ** $_[1]; +} + +sub sin { + usage "sin(x)" if @_ != 1; + sin($_[0]); +} + +sub sqrt { + usage "sqrt(x)" if @_ != 1; + sqrt($_[0]); +} + +sub getpwnam { + usage "getpwnam(name)" if @_ != 1; + getpwnam($_[0]); +} + +sub getpwuid { + usage "getpwuid(uid)" if @_ != 1; + getpwuid($_[0]); +} + +sub longjmp { + unimpl "longjmp() is C-specific: use die instead"; +} + +sub setjmp { + unimpl "setjmp() is C-specific: use eval {} instead"; +} + +sub siglongjmp { + unimpl "siglongjmp() is C-specific: use die instead"; +} + +sub sigsetjmp { + unimpl "sigsetjmp() is C-specific: use eval {} instead"; +} + +sub kill { + usage "kill(pid, sig)" if @_ != 2; + kill $_[1], $_[0]; +} + +sub raise { + usage "raise(sig)" if @_ != 1; + kill $_[0], $$; # Is this good enough? +} + +sub offsetof { + unimpl "offsetof() is C-specific, stopped"; +} + +sub clearerr { + redef "IO::Handle::clearerr()"; +} + +sub fclose { + redef "IO::Handle::close()"; +} + +sub fdopen { + redef "IO::Handle::new_from_fd()"; +} + +sub feof { + redef "IO::Handle::eof()"; +} + +sub fgetc { + redef "IO::Handle::getc()"; +} + +sub fgets { + redef "IO::Handle::gets()"; +} + +sub fileno { + redef "IO::Handle::fileno()"; +} + +sub fopen { + redef "IO::File::open()"; +} + +sub fprintf { + unimpl "fprintf() is C-specific--use printf instead"; +} + +sub fputc { + unimpl "fputc() is C-specific--use print instead"; +} + +sub fputs { + unimpl "fputs() is C-specific--use print instead"; +} + +sub fread { + unimpl "fread() is C-specific--use read instead"; +} + +sub freopen { + unimpl "freopen() is C-specific--use open instead"; +} + +sub fscanf { + unimpl "fscanf() is C-specific--use <> and regular expressions instead"; +} + +sub fseek { + redef "IO::Seekable::seek()"; +} + +sub ferror { + redef "IO::Handle::error()"; +} + +sub fflush { + redef "IO::Handle::flush()"; +} + +sub fgetpos { + redef "IO::Seekable::getpos()"; +} + +sub fsetpos { + redef "IO::Seekable::setpos()"; +} + +sub ftell { + redef "IO::Seekable::tell()"; +} + +sub fwrite { + unimpl "fwrite() is C-specific--use print instead"; +} + +sub getc { + usage "getc(handle)" if @_ != 1; + getc($_[0]); +} + +sub getchar { + usage "getchar()" if @_ != 0; + getc(STDIN); +} + +sub gets { + usage "gets()" if @_ != 0; + scalar ; +} + +sub perror { + print STDERR "@_: " if @_; + print STDERR $!,"\n"; +} + +sub printf { + usage "printf(pattern, args...)" if @_ < 1; + printf STDOUT @_; +} + +sub putc { + unimpl "putc() is C-specific--use print instead"; +} + +sub putchar { + unimpl "putchar() is C-specific--use print instead"; +} + +sub puts { + unimpl "puts() is C-specific--use print instead"; +} + +sub remove { + usage "remove(filename)" if @_ != 1; + unlink($_[0]); +} + +sub rename { + usage "rename(oldfilename, newfilename)" if @_ != 2; + rename($_[0], $_[1]); +} + +sub rewind { + usage "rewind(filehandle)" if @_ != 1; + seek($_[0],0,0); +} + +sub scanf { + unimpl "scanf() is C-specific--use <> and regular expressions instead"; +} + +sub sprintf { + usage "sprintf(pattern,args)" if @_ == 0; + sprintf(shift,@_); +} + +sub sscanf { + unimpl "sscanf() is C-specific--use regular expressions instead"; +} + +sub tmpfile { + redef "IO::File::new_tmpfile()"; +} + +sub ungetc { + redef "IO::Handle::ungetc()"; +} + +sub vfprintf { + unimpl "vfprintf() is C-specific"; +} + +sub vprintf { + unimpl "vprintf() is C-specific"; +} + +sub vsprintf { + unimpl "vsprintf() is C-specific"; +} + +sub abs { + usage "abs(x)" if @_ != 1; + abs($_[0]); +} + +sub atexit { + unimpl "atexit() is C-specific: use END {} instead"; +} + +sub atof { + unimpl "atof() is C-specific, stopped"; +} + +sub atoi { + unimpl "atoi() is C-specific, stopped"; +} + +sub atol { + unimpl "atol() is C-specific, stopped"; +} + +sub bsearch { + unimpl "bsearch() not supplied"; +} + +sub calloc { + unimpl "calloc() is C-specific, stopped"; +} + +sub div { + unimpl "div() is C-specific, stopped"; +} + +sub exit { + usage "exit(status)" if @_ != 1; + exit($_[0]); +} + +sub free { + unimpl "free() is C-specific, stopped"; +} + +sub getenv { + usage "getenv(name)" if @_ != 1; + $ENV{$_[0]}; +} + +sub labs { + unimpl "labs() is C-specific, use abs instead"; +} + +sub ldiv { + unimpl "ldiv() is C-specific, use / and int instead"; +} + +sub malloc { + unimpl "malloc() is C-specific, stopped"; +} + +sub qsort { + unimpl "qsort() is C-specific, use sort instead"; +} + +sub rand { + unimpl "rand() is non-portable, use Perl's rand instead"; +} + +sub realloc { + unimpl "realloc() is C-specific, stopped"; +} + +sub srand { + unimpl "srand()"; +} + +sub system { + usage "system(command)" if @_ != 1; + system($_[0]); +} + +sub memchr { + unimpl "memchr() is C-specific, use index() instead"; +} + +sub memcmp { + unimpl "memcmp() is C-specific, use eq instead"; +} + +sub memcpy { + unimpl "memcpy() is C-specific, use = instead"; +} + +sub memmove { + unimpl "memmove() is C-specific, use = instead"; +} + +sub memset { + unimpl "memset() is C-specific, use x instead"; +} + +sub strcat { + unimpl "strcat() is C-specific, use .= instead"; +} + +sub strchr { + unimpl "strchr() is C-specific, use index() instead"; +} + +sub strcmp { + unimpl "strcmp() is C-specific, use eq instead"; +} + +sub strcpy { + unimpl "strcpy() is C-specific, use = instead"; +} + +sub strcspn { + unimpl "strcspn() is C-specific, use regular expressions instead"; +} + +sub strerror { + usage "strerror(errno)" if @_ != 1; + local $! = $_[0]; + $! . ""; +} + +sub strlen { + unimpl "strlen() is C-specific, use length instead"; +} + +sub strncat { + unimpl "strncat() is C-specific, use .= instead"; +} + +sub strncmp { + unimpl "strncmp() is C-specific, use eq instead"; +} + +sub strncpy { + unimpl "strncpy() is C-specific, use = instead"; +} + +sub strpbrk { + unimpl "strpbrk() is C-specific, stopped"; +} + +sub strrchr { + unimpl "strrchr() is C-specific, use rindex() instead"; +} + +sub strspn { + unimpl "strspn() is C-specific, stopped"; +} + +sub strstr { + usage "strstr(big, little)" if @_ != 2; + index($_[0], $_[1]); +} + +sub strtok { + unimpl "strtok() is C-specific, stopped"; +} + +sub chmod { + usage "chmod(mode, filename)" if @_ != 2; + chmod($_[0], $_[1]); +} + +sub fstat { + usage "fstat(fd)" if @_ != 1; + local *TMP; + open(TMP, "<&$_[0]"); # Gross. + my @l = stat(TMP); + close(TMP); + @l; +} + +sub mkdir { + usage "mkdir(directoryname, mode)" if @_ != 2; + mkdir($_[0], $_[1]); +} + +sub stat { + usage "stat(filename)" if @_ != 1; + stat($_[0]); +} + +sub umask { + usage "umask(mask)" if @_ != 1; + umask($_[0]); +} + +sub wait { + usage "wait()" if @_ != 0; + wait(); +} + +sub waitpid { + usage "waitpid(pid, options)" if @_ != 2; + waitpid($_[0], $_[1]); +} + +sub gmtime { + usage "gmtime(time)" if @_ != 1; + gmtime($_[0]); +} + +sub localtime { + usage "localtime(time)" if @_ != 1; + localtime($_[0]); +} + +sub time { + usage "time()" if @_ != 0; + time; +} + +sub alarm { + usage "alarm(seconds)" if @_ != 1; + alarm($_[0]); +} + +sub chdir { + usage "chdir(directory)" if @_ != 1; + chdir($_[0]); +} + +sub chown { + usage "chown(filename, uid, gid)" if @_ != 3; + chown($_[0], $_[1], $_[2]); +} + +sub execl { + unimpl "execl() is C-specific, stopped"; +} + +sub execle { + unimpl "execle() is C-specific, stopped"; +} + +sub execlp { + unimpl "execlp() is C-specific, stopped"; +} + +sub execv { + unimpl "execv() is C-specific, stopped"; +} + +sub execve { + unimpl "execve() is C-specific, stopped"; +} + +sub execvp { + unimpl "execvp() is C-specific, stopped"; +} + +sub fork { + usage "fork()" if @_ != 0; + fork; +} + +sub getcwd +{ + usage "getcwd()" if @_ != 0; + if ($^O eq 'MSWin32') { + # this perhaps applies to everyone else also? + require Cwd; + $cwd = &Cwd::cwd; + } + else { + chop($cwd = `pwd`); + } + $cwd; +} + +sub getegid { + usage "getegid()" if @_ != 0; + $) + 0; +} + +sub geteuid { + usage "geteuid()" if @_ != 0; + $> + 0; +} + +sub getgid { + usage "getgid()" if @_ != 0; + $( + 0; +} + +sub getgroups { + usage "getgroups()" if @_ != 0; + my %seen; + grep(!$seen{$_}++, split(' ', $) )); +} + +sub getlogin { + usage "getlogin()" if @_ != 0; + getlogin(); +} + +sub getpgrp { + usage "getpgrp()" if @_ != 0; + getpgrp($_[0]); +} + +sub getpid { + usage "getpid()" if @_ != 0; + $$; +} + +sub getppid { + usage "getppid()" if @_ != 0; + getppid; +} + +sub getuid { + usage "getuid()" if @_ != 0; + $<; +} + +sub isatty { + usage "isatty(filehandle)" if @_ != 1; + -t $_[0]; +} + +sub link { + usage "link(oldfilename, newfilename)" if @_ != 2; + link($_[0], $_[1]); +} + +sub rmdir { + usage "rmdir(directoryname)" if @_ != 1; + rmdir($_[0]); +} + +sub setgid { + usage "setgid(gid)" if @_ != 1; + $( = $_[0]; +} + +sub setuid { + usage "setuid(uid)" if @_ != 1; + $< = $_[0]; +} + +sub sleep { + usage "sleep(seconds)" if @_ != 1; + sleep($_[0]); +} + +sub unlink { + usage "unlink(filename)" if @_ != 1; + unlink($_[0]); +} + +sub utime { + usage "utime(filename, atime, mtime)" if @_ != 3; + utime($_[1], $_[2], $_[0]); +} + diff --git a/contrib/perl5/ext/POSIX/POSIX.pod b/contrib/perl5/ext/POSIX/POSIX.pod new file mode 100644 index 00000000000..4726487b47e --- /dev/null +++ b/contrib/perl5/ext/POSIX/POSIX.pod @@ -0,0 +1,1729 @@ +=head1 NAME + +POSIX - Perl interface to IEEE Std 1003.1 + +=head1 SYNOPSIS + + use POSIX; + use POSIX qw(setsid); + use POSIX qw(:errno_h :fcntl_h); + + printf "EINTR is %d\n", EINTR; + + $sess_id = POSIX::setsid(); + + $fd = POSIX::open($path, O_CREAT|O_EXCL|O_WRONLY, 0644); + # note: that's a filedescriptor, *NOT* a filehandle + +=head1 DESCRIPTION + +The POSIX module permits you to access all (or nearly all) the standard +POSIX 1003.1 identifiers. Many of these identifiers have been given Perl-ish +interfaces. Things which are C<#defines> in C, like EINTR or O_NDELAY, are +automatically exported into your namespace. All functions are only exported +if you ask for them explicitly. Most likely people will prefer to use the +fully-qualified function names. + +This document gives a condensed list of the features available in the POSIX +module. Consult your operating system's manpages for general information on +most features. Consult L for functions which are noted as being +identical to Perl's builtin functions. + +The first section describes POSIX functions from the 1003.1 specification. +The second section describes some classes for signal objects, TTY objects, +and other miscellaneous objects. The remaining sections list various +constants and macros in an organization which roughly follows IEEE Std +1003.1b-1993. + +=head1 NOTE + +The POSIX module is probably the most complex Perl module supplied with +the standard distribution. It incorporates autoloading, namespace games, +and dynamic loading of code that's in Perl, C, or both. It's a great +source of wisdom. + +=head1 CAVEATS + +A few functions are not implemented because they are C specific. If you +attempt to call these, they will print a message telling you that they +aren't implemented, and suggest using the Perl equivalent should one +exist. For example, trying to access the setjmp() call will elicit the +message "setjmp() is C-specific: use eval {} instead". + +Furthermore, some evil vendors will claim 1003.1 compliance, but in fact +are not so: they will not pass the PCTS (POSIX Compliance Test Suites). +For example, one vendor may not define EDEADLK, or the semantics of the +errno values set by open(2) might not be quite right. Perl does not +attempt to verify POSIX compliance. That means you can currently +successfully say "use POSIX", and then later in your program you find +that your vendor has been lax and there's no usable ICANON macro after +all. This could be construed to be a bug. + +=head1 FUNCTIONS + +=over 8 + +=item _exit + +This is identical to the C function C<_exit()>. + +=item abort + +This is identical to the C function C. + +=item abs + +This is identical to Perl's builtin C function. + +=item access + +Determines the accessibility of a file. + + if( POSIX::access( "/", &POSIX::R_OK ) ){ + print "have read permission\n"; + } + +Returns C on failure. + +=item acos + +This is identical to the C function C. + +=item alarm + +This is identical to Perl's builtin C function. + +=item asctime + +This is identical to the C function C. + +=item asin + +This is identical to the C function C. + +=item assert + +Unimplemented. + +=item atan + +This is identical to the C function C. + +=item atan2 + +This is identical to Perl's builtin C function. + +=item atexit + +atexit() is C-specific: use END {} instead. + +=item atof + +atof() is C-specific. + +=item atoi + +atoi() is C-specific. + +=item atol + +atol() is C-specific. + +=item bsearch + +bsearch() not supplied. + +=item calloc + +calloc() is C-specific. + +=item ceil + +This is identical to the C function C. + +=item chdir + +This is identical to Perl's builtin C function. + +=item chmod + +This is identical to Perl's builtin C function. + +=item chown + +This is identical to Perl's builtin C function. + +=item clearerr + +Use method C instead. + +=item clock + +This is identical to the C function C. + +=item close + +Close the file. This uses file descriptors such as those obtained by calling +C. + + $fd = POSIX::open( "foo", &POSIX::O_RDONLY ); + POSIX::close( $fd ); + +Returns C on failure. + +=item closedir + +This is identical to Perl's builtin C function. + +=item cos + +This is identical to Perl's builtin C function. + +=item cosh + +This is identical to the C function C. + +=item creat + +Create a new file. This returns a file descriptor like the ones returned by +C. Use C to close the file. + + $fd = POSIX::creat( "foo", 0611 ); + POSIX::close( $fd ); + +=item ctermid + +Generates the path name for the controlling terminal. + + $path = POSIX::ctermid(); + +=item ctime + +This is identical to the C function C. + +=item cuserid + +Get the character login name of the user. + + $name = POSIX::cuserid(); + +=item difftime + +This is identical to the C function C. + +=item div + +div() is C-specific. + +=item dup + +This is similar to the C function C. + +This uses file descriptors such as those obtained by calling +C. + +Returns C on failure. + +=item dup2 + +This is similar to the C function C. + +This uses file descriptors such as those obtained by calling +C. + +Returns C on failure. + +=item errno + +Returns the value of errno. + + $errno = POSIX::errno(); + +=item execl + +execl() is C-specific. + +=item execle + +execle() is C-specific. + +=item execlp + +execlp() is C-specific. + +=item execv + +execv() is C-specific. + +=item execve + +execve() is C-specific. + +=item execvp + +execvp() is C-specific. + +=item exit + +This is identical to Perl's builtin C function. + +=item exp + +This is identical to Perl's builtin C function. + +=item fabs + +This is identical to Perl's builtin C function. + +=item fclose + +Use method C instead. + +=item fcntl + +This is identical to Perl's builtin C function. + +=item fdopen + +Use method C instead. + +=item feof + +Use method C instead. + +=item ferror + +Use method C instead. + +=item fflush + +Use method C instead. + +=item fgetc + +Use method C instead. + +=item fgetpos + +Use method C instead. + +=item fgets + +Use method C instead. + +=item fileno + +Use method C instead. + +=item floor + +This is identical to the C function C. + +=item fmod + +This is identical to the C function C. + +=item fopen + +Use method C instead. + +=item fork + +This is identical to Perl's builtin C function. + +=item fpathconf + +Retrieves the value of a configurable limit on a file or directory. This +uses file descriptors such as those obtained by calling C. + +The following will determine the maximum length of the longest allowable +pathname on the filesystem which holds C. + + $fd = POSIX::open( "/tmp/foo", &POSIX::O_RDONLY ); + $path_max = POSIX::fpathconf( $fd, &POSIX::_PC_PATH_MAX ); + +Returns C on failure. + +=item fprintf + +fprintf() is C-specific--use printf instead. + +=item fputc + +fputc() is C-specific--use print instead. + +=item fputs + +fputs() is C-specific--use print instead. + +=item fread + +fread() is C-specific--use read instead. + +=item free + +free() is C-specific. + +=item freopen + +freopen() is C-specific--use open instead. + +=item frexp + +Return the mantissa and exponent of a floating-point number. + + ($mantissa, $exponent) = POSIX::frexp( 3.14 ); + +=item fscanf + +fscanf() is C-specific--use <> and regular expressions instead. + +=item fseek + +Use method C instead. + +=item fsetpos + +Use method C instead. + +=item fstat + +Get file status. This uses file descriptors such as those obtained by +calling C. The data returned is identical to the data from +Perl's builtin C function. + + $fd = POSIX::open( "foo", &POSIX::O_RDONLY ); + @stats = POSIX::fstat( $fd ); + +=item ftell + +Use method C instead. + +=item fwrite + +fwrite() is C-specific--use print instead. + +=item getc + +This is identical to Perl's builtin C function. + +=item getchar + +Returns one character from STDIN. + +=item getcwd + +Returns the name of the current working directory. + +=item getegid + +Returns the effective group id. + +=item getenv + +Returns the value of the specified enironment variable. + +=item geteuid + +Returns the effective user id. + +=item getgid + +Returns the user's real group id. + +=item getgrgid + +This is identical to Perl's builtin C function. + +=item getgrnam + +This is identical to Perl's builtin C function. + +=item getgroups + +Returns the ids of the user's supplementary groups. + +=item getlogin + +This is identical to Perl's builtin C function. + +=item getpgrp + +This is identical to Perl's builtin C function. + +=item getpid + +Returns the process's id. + +=item getppid + +This is identical to Perl's builtin C function. + +=item getpwnam + +This is identical to Perl's builtin C function. + +=item getpwuid + +This is identical to Perl's builtin C function. + +=item gets + +Returns one line from STDIN. + +=item getuid + +Returns the user's id. + +=item gmtime + +This is identical to Perl's builtin C function. + +=item isalnum + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isalpha + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isatty + +Returns a boolean indicating whether the specified filehandle is connected +to a tty. + +=item iscntrl + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isdigit + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isgraph + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item islower + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isprint + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item ispunct + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isspace + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isupper + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item isxdigit + +This is identical to the C function, except that it can apply to a single +character or to a whole string. + +=item kill + +This is identical to Perl's builtin C function. + +=item labs + +labs() is C-specific, use abs instead. + +=item ldexp + +This is identical to the C function C. + +=item ldiv + +ldiv() is C-specific, use / and int instead. + +=item link + +This is identical to Perl's builtin C function. + +=item localeconv + +Get numeric formatting information. Returns a reference to a hash +containing the current locale formatting values. + +The database for the B (Deutsch or German) locale. + + $loc = POSIX::setlocale( &POSIX::LC_ALL, "de" ); + print "Locale = $loc\n"; + $lconv = POSIX::localeconv(); + print "decimal_point = ", $lconv->{decimal_point}, "\n"; + print "thousands_sep = ", $lconv->{thousands_sep}, "\n"; + print "grouping = ", $lconv->{grouping}, "\n"; + print "int_curr_symbol = ", $lconv->{int_curr_symbol}, "\n"; + print "currency_symbol = ", $lconv->{currency_symbol}, "\n"; + print "mon_decimal_point = ", $lconv->{mon_decimal_point}, "\n"; + print "mon_thousands_sep = ", $lconv->{mon_thousands_sep}, "\n"; + print "mon_grouping = ", $lconv->{mon_grouping}, "\n"; + print "positive_sign = ", $lconv->{positive_sign}, "\n"; + print "negative_sign = ", $lconv->{negative_sign}, "\n"; + print "int_frac_digits = ", $lconv->{int_frac_digits}, "\n"; + print "frac_digits = ", $lconv->{frac_digits}, "\n"; + print "p_cs_precedes = ", $lconv->{p_cs_precedes}, "\n"; + print "p_sep_by_space = ", $lconv->{p_sep_by_space}, "\n"; + print "n_cs_precedes = ", $lconv->{n_cs_precedes}, "\n"; + print "n_sep_by_space = ", $lconv->{n_sep_by_space}, "\n"; + print "p_sign_posn = ", $lconv->{p_sign_posn}, "\n"; + print "n_sign_posn = ", $lconv->{n_sign_posn}, "\n"; + +=item localtime + +This is identical to Perl's builtin C function. + +=item log + +This is identical to Perl's builtin C function. + +=item log10 + +This is identical to the C function C. + +=item longjmp + +longjmp() is C-specific: use die instead. + +=item lseek + +Move the file's read/write position. This uses file descriptors such as +those obtained by calling C. + + $fd = POSIX::open( "foo", &POSIX::O_RDONLY ); + $off_t = POSIX::lseek( $fd, 0, &POSIX::SEEK_SET ); + +Returns C on failure. + +=item malloc + +malloc() is C-specific. + +=item mblen + +This is identical to the C function C. + +=item mbstowcs + +This is identical to the C function C. + +=item mbtowc + +This is identical to the C function C. + +=item memchr + +memchr() is C-specific, use index() instead. + +=item memcmp + +memcmp() is C-specific, use eq instead. + +=item memcpy + +memcpy() is C-specific, use = instead. + +=item memmove + +memmove() is C-specific, use = instead. + +=item memset + +memset() is C-specific, use x instead. + +=item mkdir + +This is identical to Perl's builtin C function. + +=item mkfifo + +This is similar to the C function C. + +Returns C on failure. + +=item mktime + +Convert date/time info to a calendar time. + +Synopsis: + + mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + +The month (C), weekday (C), and yearday (C) begin at zero. +I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The +year (C) is given in years since 1900. I.e. The year 1995 is 95; the +year 2001 is 101. Consult your system's C manpage for details +about these and the other arguments. + +Calendar time for December 12, 1995, at 10:30 am. + + $time_t = POSIX::mktime( 0, 30, 10, 12, 11, 95 ); + print "Date = ", POSIX::ctime($time_t); + +Returns C on failure. + +=item modf + +Return the integral and fractional parts of a floating-point number. + + ($fractional, $integral) = POSIX::modf( 3.14 ); + +=item nice + +This is similar to the C function C. + +Returns C on failure. + +=item offsetof + +offsetof() is C-specific. + +=item open + +Open a file for reading for writing. This returns file descriptors, not +Perl filehandles. Use C to close the file. + +Open a file read-only with mode 0666. + + $fd = POSIX::open( "foo" ); + +Open a file for read and write. + + $fd = POSIX::open( "foo", &POSIX::O_RDWR ); + +Open a file for write, with truncation. + + $fd = POSIX::open( "foo", &POSIX::O_WRONLY | &POSIX::O_TRUNC ); + +Create a new file with mode 0640. Set up the file for writing. + + $fd = POSIX::open( "foo", &POSIX::O_CREAT | &POSIX::O_WRONLY, 0640 ); + +Returns C on failure. + +=item opendir + +Open a directory for reading. + + $dir = POSIX::opendir( "/tmp" ); + @files = POSIX::readdir( $dir ); + POSIX::closedir( $dir ); + +Returns C on failure. + +=item pathconf + +Retrieves the value of a configurable limit on a file or directory. + +The following will determine the maximum length of the longest allowable +pathname on the filesystem which holds C. + + $path_max = POSIX::pathconf( "/tmp", &POSIX::_PC_PATH_MAX ); + +Returns C on failure. + +=item pause + +This is similar to the C function C. + +Returns C on failure. + +=item perror + +This is identical to the C function C. + +=item pipe + +Create an interprocess channel. This returns file descriptors like those +returned by C. + + ($fd0, $fd1) = POSIX::pipe(); + POSIX::write( $fd0, "hello", 5 ); + POSIX::read( $fd1, $buf, 5 ); + +=item pow + +Computes $x raised to the power $exponent. + + $ret = POSIX::pow( $x, $exponent ); + +=item printf + +Prints the specified arguments to STDOUT. + +=item putc + +putc() is C-specific--use print instead. + +=item putchar + +putchar() is C-specific--use print instead. + +=item puts + +puts() is C-specific--use print instead. + +=item qsort + +qsort() is C-specific, use sort instead. + +=item raise + +Sends the specified signal to the current process. + +=item rand + +rand() is non-portable, use Perl's rand instead. + +=item read + +Read from a file. This uses file descriptors such as those obtained by +calling C. If the buffer C<$buf> is not large enough for the +read then Perl will extend it to make room for the request. + + $fd = POSIX::open( "foo", &POSIX::O_RDONLY ); + $bytes = POSIX::read( $fd, $buf, 3 ); + +Returns C on failure. + +=item readdir + +This is identical to Perl's builtin C function. + +=item realloc + +realloc() is C-specific. + +=item remove + +This is identical to Perl's builtin C function. + +=item rename + +This is identical to Perl's builtin C function. + +=item rewind + +Seeks to the beginning of the file. + +=item rewinddir + +This is identical to Perl's builtin C function. + +=item rmdir + +This is identical to Perl's builtin C function. + +=item scanf + +scanf() is C-specific--use <> and regular expressions instead. + +=item setgid + +Sets the real group id for this process. + +=item setjmp + +setjmp() is C-specific: use eval {} instead. + +=item setlocale + +Modifies and queries program's locale. + +The following will set the traditional UNIX system locale behavior +(the second argument C<"C">). + + $loc = POSIX::setlocale( &POSIX::LC_ALL, "C" ); + +The following will query (the missing second argument) the current +LC_CTYPE category. + + $loc = POSIX::setlocale( &POSIX::LC_CTYPE); + +The following will set the LC_CTYPE behaviour according to the locale +environment variables (the second argument C<"">). +Please see your systems L documentation for the locale +environment variables' meaning or consult L. + + $loc = POSIX::setlocale( &POSIX::LC_CTYPE, ""); + +The following will set the LC_COLLATE behaviour to Argentinian +Spanish. B: The naming and availability of locales depends on +your operating system. Please consult L for how to find +out which locales are available in your system. + + $loc = POSIX::setlocale( &POSIX::LC_ALL, "es_AR.ISO8859-1" ); + +=item setpgid + +This is similar to the C function C. + +Returns C on failure. + +=item setsid + +This is identical to the C function C. + +=item setuid + +Sets the real user id for this process. + +=item sigaction + +Detailed signal management. This uses C objects for the +C and C arguments. Consult your system's C +manpage for details. + +Synopsis: + + sigaction(sig, action, oldaction = 0) + +Returns C on failure. + +=item siglongjmp + +siglongjmp() is C-specific: use die instead. + +=item sigpending + +Examine signals that are blocked and pending. This uses C +objects for the C argument. Consult your system's C +manpage for details. + +Synopsis: + + sigpending(sigset) + +Returns C on failure. + +=item sigprocmask + +Change and/or examine calling process's signal mask. This uses +C objects for the C and C arguments. +Consult your system's C manpage for details. + +Synopsis: + + sigprocmask(how, sigset, oldsigset = 0) + +Returns C on failure. + +=item sigsetjmp + +sigsetjmp() is C-specific: use eval {} instead. + +=item sigsuspend + +Install a signal mask and suspend process until signal arrives. This uses +C objects for the C argument. Consult your +system's C manpage for details. + +Synopsis: + + sigsuspend(signal_mask) + +Returns C on failure. + +=item sin + +This is identical to Perl's builtin C function. + +=item sinh + +This is identical to the C function C. + +=item sleep + +This is identical to Perl's builtin C function. + +=item sprintf + +This is identical to Perl's builtin C function. + +=item sqrt + +This is identical to Perl's builtin C function. + +=item srand + +srand(). + +=item sscanf + +sscanf() is C-specific--use regular expressions instead. + +=item stat + +This is identical to Perl's builtin C function. + +=item strcat + +strcat() is C-specific, use .= instead. + +=item strchr + +strchr() is C-specific, use index() instead. + +=item strcmp + +strcmp() is C-specific, use eq instead. + +=item strcoll + +This is identical to the C function C. + +=item strcpy + +strcpy() is C-specific, use = instead. + +=item strcspn + +strcspn() is C-specific, use regular expressions instead. + +=item strerror + +Returns the error string for the specified errno. + +=item strftime + +Convert date and time information to string. Returns the string. + +Synopsis: + + strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + +The month (C), weekday (C), and yearday (C) begin at zero. +I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The +year (C) is given in years since 1900. I.e. The year 1995 is 95; the +year 2001 is 101. Consult your system's C manpage for details +about these and the other arguments. + +The string for Tuesday, December 12, 1995. + + $str = POSIX::strftime( "%A, %B %d, %Y", 0, 0, 0, 12, 11, 95, 2 ); + print "$str\n"; + +=item strlen + +strlen() is C-specific, use length instead. + +=item strncat + +strncat() is C-specific, use .= instead. + +=item strncmp + +strncmp() is C-specific, use eq instead. + +=item strncpy + +strncpy() is C-specific, use = instead. + +=item stroul + +stroul() is C-specific. + +=item strpbrk + +strpbrk() is C-specific. + +=item strrchr + +strrchr() is C-specific, use rindex() instead. + +=item strspn + +strspn() is C-specific. + +=item strstr + +This is identical to Perl's builtin C function. + +=item strtod + +String to double translation. Returns the parsed number and the number +of characters in the unparsed portion of the string. Truly +POSIX-compliant systems set $! ($ERRNO) to indicate a translation +error, so clear $! before calling strtod. However, non-POSIX systems +may not check for overflow, and therefore will never set $!. + +strtod should respect any POSIX I settings. + +To parse a string $str as a floating point number use + + $! = 0; + ($num, $n_unparsed) = POSIX::strtod($str); + +The second returned item and $! can be used to check for valid input: + + if (($str eq '') || ($n_unparsed != 0) || !$!) { + die "Non-numeric input $str" . $! ? ": $!\n" : "\n"; + } + +When called in a scalar context strtod returns the parsed number. + +=item strtok + +strtok() is C-specific. + +=item strtol + +String to (long) integer translation. Returns the parsed number and +the number of characters in the unparsed portion of the string. Truly +POSIX-compliant systems set $! ($ERRNO) to indicate a translation +error, so clear $! before calling strtol. However, non-POSIX systems +may not check for overflow, and therefore will never set $!. + +strtol should respect any POSIX I settings. + +To parse a string $str as a number in some base $base use + + $! = 0; + ($num, $n_unparsed) = POSIX::strtol($str, $base); + +The base should be zero or between 2 and 36, inclusive. When the base +is zero or omitted strtol will use the string itself to determine the +base: a leading "0x" or "0X" means hexadecimal; a leading "0" means +octal; any other leading characters mean decimal. Thus, "1234" is +parsed as a decimal number, "01234" as an octal number, and "0x1234" +as a hexadecimal number. + +The second returned item and $! can be used to check for valid input: + + if (($str eq '') || ($n_unparsed != 0) || !$!) { + die "Non-numeric input $str" . $! ? ": $!\n" : "\n"; + } + +When called in a scalar context strtol returns the parsed number. + +=item strtoul + +String to unsigned (long) integer translation. strtoul is identical +to strtol except that strtoul only parses unsigned integers. See +I for details. + +Note: Some vendors supply strtod and strtol but not strtoul. +Other vendors that do suply strtoul parse "-1" as a valid value. + +=item strxfrm + +String transformation. Returns the transformed string. + + $dst = POSIX::strxfrm( $src ); + +=item sysconf + +Retrieves values of system configurable variables. + +The following will get the machine's clock speed. + + $clock_ticks = POSIX::sysconf( &POSIX::_SC_CLK_TCK ); + +Returns C on failure. + +=item system + +This is identical to Perl's builtin C function. + +=item tan + +This is identical to the C function C. + +=item tanh + +This is identical to the C function C. + +=item tcdrain + +This is similar to the C function C. + +Returns C on failure. + +=item tcflow + +This is similar to the C function C. + +Returns C on failure. + +=item tcflush + +This is similar to the C function C. + +Returns C on failure. + +=item tcgetpgrp + +This is identical to the C function C. + +=item tcsendbreak + +This is similar to the C function C. + +Returns C on failure. + +=item tcsetpgrp + +This is similar to the C function C. + +Returns C on failure. + +=item time + +This is identical to Perl's builtin C function. + +=item times + +The times() function returns elapsed realtime since some point in the past +(such as system startup), user and system times for this process, and user +and system times used by child processes. All times are returned in clock +ticks. + + ($realtime, $user, $system, $cuser, $csystem) = POSIX::times(); + +Note: Perl's builtin C function returns four values, measured in +seconds. + +=item tmpfile + +Use method C instead. + +=item tmpnam + +Returns a name for a temporary file. + + $tmpfile = POSIX::tmpnam(); + +=item tolower + +This is identical to Perl's builtin C function. + +=item toupper + +This is identical to Perl's builtin C function. + +=item ttyname + +This is identical to the C function C. + +=item tzname + +Retrieves the time conversion information from the C variable. + + POSIX::tzset(); + ($std, $dst) = POSIX::tzname(); + +=item tzset + +This is identical to the C function C. + +=item umask + +This is identical to Perl's builtin C function. + +=item uname + +Get name of current operating system. + + ($sysname, $nodename, $release, $version, $machine ) = POSIX::uname(); + +=item ungetc + +Use method C instead. + +=item unlink + +This is identical to Perl's builtin C function. + +=item utime + +This is identical to Perl's builtin C function. + +=item vfprintf + +vfprintf() is C-specific. + +=item vprintf + +vprintf() is C-specific. + +=item vsprintf + +vsprintf() is C-specific. + +=item wait + +This is identical to Perl's builtin C function. + +=item waitpid + +Wait for a child process to change state. This is identical to Perl's +builtin C function. + + $pid = POSIX::waitpid( -1, &POSIX::WNOHANG ); + print "status = ", ($? / 256), "\n"; + +=item wcstombs + +This is identical to the C function C. + +=item wctomb + +This is identical to the C function C. + +=item write + +Write to a file. This uses file descriptors such as those obtained by +calling C. + + $fd = POSIX::open( "foo", &POSIX::O_WRONLY ); + $buf = "hello"; + $bytes = POSIX::write( $b, $buf, 5 ); + +Returns C on failure. + +=back + +=head1 CLASSES + +=head2 POSIX::SigAction + +=over 8 + +=item new + +Creates a new C object which corresponds to the C +C. This object will be destroyed automatically when it is +no longer needed. The first parameter is the fully-qualified name of a sub +which is a signal-handler. The second parameter is a C +object, it defaults to the empty set. The third parameter contains the +C, it defaults to 0. + + $sigset = POSIX::SigSet->new(SIGINT, SIGQUIT); + $sigaction = POSIX::SigAction->new( 'main::handler', $sigset, &POSIX::SA_NOCLDSTOP ); + +This C object should be used with the C +function. + +=back + +=head2 POSIX::SigSet + +=over 8 + +=item new + +Create a new SigSet object. This object will be destroyed automatically +when it is no longer needed. Arguments may be supplied to initialize the +set. + +Create an empty set. + + $sigset = POSIX::SigSet->new; + +Create a set with SIGUSR1. + + $sigset = POSIX::SigSet->new( &POSIX::SIGUSR1 ); + +=item addset + +Add a signal to a SigSet object. + + $sigset->addset( &POSIX::SIGUSR2 ); + +Returns C on failure. + +=item delset + +Remove a signal from the SigSet object. + + $sigset->delset( &POSIX::SIGUSR2 ); + +Returns C on failure. + +=item emptyset + +Initialize the SigSet object to be empty. + + $sigset->emptyset(); + +Returns C on failure. + +=item fillset + +Initialize the SigSet object to include all signals. + + $sigset->fillset(); + +Returns C on failure. + +=item ismember + +Tests the SigSet object to see if it contains a specific signal. + + if( $sigset->ismember( &POSIX::SIGUSR1 ) ){ + print "contains SIGUSR1\n"; + } + +=back + +=head2 POSIX::Termios + +=over 8 + +=item new + +Create a new Termios object. This object will be destroyed automatically +when it is no longer needed. A Termios object corresponds to the termios +C struct. new() mallocs a new one, getattr() fills it from a file descriptor, +and setattr() sets a file descriptor's parameters to match Termios' contents. + + $termios = POSIX::Termios->new; + +=item getattr + +Get terminal control attributes. + +Obtain the attributes for stdin. + + $termios->getattr() + +Obtain the attributes for stdout. + + $termios->getattr( 1 ) + +Returns C on failure. + +=item getcc + +Retrieve a value from the c_cc field of a termios object. The c_cc field is +an array so an index must be specified. + + $c_cc[1] = $termios->getcc(1); + +=item getcflag + +Retrieve the c_cflag field of a termios object. + + $c_cflag = $termios->getcflag; + +=item getiflag + +Retrieve the c_iflag field of a termios object. + + $c_iflag = $termios->getiflag; + +=item getispeed + +Retrieve the input baud rate. + + $ispeed = $termios->getispeed; + +=item getlflag + +Retrieve the c_lflag field of a termios object. + + $c_lflag = $termios->getlflag; + +=item getoflag + +Retrieve the c_oflag field of a termios object. + + $c_oflag = $termios->getoflag; + +=item getospeed + +Retrieve the output baud rate. + + $ospeed = $termios->getospeed; + +=item setattr + +Set terminal control attributes. + +Set attributes immediately for stdout. + + $termios->setattr( 1, &POSIX::TCSANOW ); + +Returns C on failure. + +=item setcc + +Set a value in the c_cc field of a termios object. The c_cc field is an +array so an index must be specified. + + $termios->setcc( &POSIX::VEOF, 1 ); + +=item setcflag + +Set the c_cflag field of a termios object. + + $termios->setcflag( $c_cflag | &POSIX::CLOCAL ); + +=item setiflag + +Set the c_iflag field of a termios object. + + $termios->setiflag( $c_iflag | &POSIX::BRKINT ); + +=item setispeed + +Set the input baud rate. + + $termios->setispeed( &POSIX::B9600 ); + +Returns C on failure. + +=item setlflag + +Set the c_lflag field of a termios object. + + $termios->setlflag( $c_lflag | &POSIX::ECHO ); + +=item setoflag + +Set the c_oflag field of a termios object. + + $termios->setoflag( $c_oflag | &POSIX::OPOST ); + +=item setospeed + +Set the output baud rate. + + $termios->setospeed( &POSIX::B9600 ); + +Returns C on failure. + +=item Baud rate values + +B38400 B75 B200 B134 B300 B1800 B150 B0 B19200 B1200 B9600 B600 B4800 B50 B2400 B110 + +=item Terminal interface values + +TCSADRAIN TCSANOW TCOON TCIOFLUSH TCOFLUSH TCION TCIFLUSH TCSAFLUSH TCIOFF TCOOFF + +=item c_cc field values + +VEOF VEOL VERASE VINTR VKILL VQUIT VSUSP VSTART VSTOP VMIN VTIME NCCS + +=item c_cflag field values + +CLOCAL CREAD CSIZE CS5 CS6 CS7 CS8 CSTOPB HUPCL PARENB PARODD + +=item c_iflag field values + +BRKINT ICRNL IGNBRK IGNCR IGNPAR INLCR INPCK ISTRIP IXOFF IXON PARMRK + +=item c_lflag field values + +ECHO ECHOE ECHOK ECHONL ICANON IEXTEN ISIG NOFLSH TOSTOP + +=item c_oflag field values + +OPOST + +=back + +=head1 PATHNAME CONSTANTS + +=over 8 + +=item Constants + +_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE + +=back + +=head1 POSIX CONSTANTS + +=over 8 + +=item Constants + +_POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_CHOWN_RESTRICTED _POSIX_JOB_CONTROL _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_NO_TRUNC _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SAVED_IDS _POSIX_SSIZE_MAX _POSIX_STREAM_MAX _POSIX_TZNAME_MAX _POSIX_VDISABLE _POSIX_VERSION + +=back + +=head1 SYSTEM CONFIGURATION + +=over 8 + +=item Constants + +_SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION + +=back + +=head1 ERRNO + +=over 8 + +=item Constants + +E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF +EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ +EDOM EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR +EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG +ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC +ENOLCK ENOMEM ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR +ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE +EPROCLIM EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS +ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS +ETXTBSY EUSERS EWOULDBLOCK EXDEV + +=back + +=head1 FCNTL + +=over 8 + +=item Constants + +FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_OK F_RDLCK F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY + +=back + +=head1 FLOAT + +=over 8 + +=item Constants + +DBL_DIG DBL_EPSILON DBL_MANT_DIG DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP FLT_DIG FLT_EPSILON FLT_MANT_DIG FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX FLT_ROUNDS LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP + +=back + +=head1 LIMITS + +=over 8 + +=item Constants + +ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX ULONG_MAX USHRT_MAX + +=back + +=head1 LOCALE + +=over 8 + +=item Constants + +LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME + +=back + +=head1 MATH + +=over 8 + +=item Constants + +HUGE_VAL + +=back + +=head1 SIGNAL + +=over 8 + +=item Constants + +SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART +SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT +SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU +SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK +SIG_UNBLOCK + +=back + +=head1 STAT + +=over 8 + +=item Constants + +S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR + +=item Macros + +S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG + +=back + +=head1 STDLIB + +=over 8 + +=item Constants + +EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX RAND_MAX + +=back + +=head1 STDIO + +=over 8 + +=item Constants + +BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX + +=back + +=head1 TIME + +=over 8 + +=item Constants + +CLK_TCK CLOCKS_PER_SEC + +=back + +=head1 UNISTD + +=over 8 + +=item Constants + +R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STRERR_FILENO W_OK X_OK + +=back + +=head1 WAIT + +=over 8 + +=item Constants + +WNOHANG WUNTRACED + +=item Macros + +WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG + +=back + +=head1 CREATION + +This document generated by ./mkposixman.PL version 19960129. + diff --git a/contrib/perl5/ext/POSIX/POSIX.xs b/contrib/perl5/ext/POSIX/POSIX.xs new file mode 100644 index 00000000000..6958c00c473 --- /dev/null +++ b/contrib/perl5/ext/POSIX/POSIX.xs @@ -0,0 +1,3666 @@ +#ifdef WIN32 +#define _POSIX_ +#endif +#include "EXTERN.h" +#define PERLIO_NOT_STDIO 1 +#include "perl.h" +#include "XSUB.h" +#ifdef PERL_OBJECT /* XXX _very_ temporary hacks */ +# undef signal +# undef open +# undef setmode +# define open PerlLIO_open3 +# undef TAINT_PROPER +# define TAINT_PROPER(a) +#endif +#include +#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ +#include +#endif +#include +#ifdef I_FLOAT +#include +#endif +#ifdef I_LIMITS +#include +#endif +#include +#include +#ifdef I_PWD +#include +#endif +#include +#include +#include + +#ifdef I_STDDEF +#include +#endif + +/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to + metaconfig for future extension writers. We don't use them in POSIX. + (This is really sneaky :-) --AD +*/ +#if defined(I_TERMIOS) +#include +#endif +#ifdef I_STDLIB +#include +#endif +#include +#include +#include +#include +#ifdef I_UNISTD +#include +#endif +#include + +#if defined(__VMS) && !defined(__POSIX_SOURCE) +# include /* LIB$_INVARG constant */ +# include /* prototype for lib$ediv() */ +# include /* prototype for sys$gettim() */ +# if DECC_VERSION < 50000000 +# define pid_t int /* old versions of DECC miss this in types.h */ +# endif + +# undef mkfifo +# define mkfifo(a,b) (not_here("mkfifo"),-1) +# define tzset() not_here("tzset") + +#if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000) +# define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */ +# include +# endif /* __VMS_VER >= 70000000 or Dec C 5.6 */ + + /* The POSIX notion of ttyname() is better served by getname() under VMS */ + static char ttnambuf[64]; +# define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL) + + /* The non-POSIX CRTL times() has void return type, so we just get the + current time directly */ + clock_t vms_times(struct tms *PL_bufptr) { + clock_t retval; + /* Get wall time and convert to 10 ms intervals to + * produce the return value that the POSIX standard expects */ +# if defined(__DECC) && defined (__ALPHA) +# include + uint64 vmstime; + _ckvmssts(sys$gettim(&vmstime)); + vmstime /= 100000; + retval = vmstime & 0x7fffffff; +# else + /* (Older hw or ccs don't have an atomic 64-bit type, so we + * juggle 32-bit ints (and a float) to produce a time_t result + * with minimal loss of information.) */ + long int vmstime[2],remainder,divisor = 100000; + _ckvmssts(sys$gettim((unsigned long int *)vmstime)); + vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */ + _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); +# endif + /* Fill in the struct tms using the CRTL routine . . .*/ + times((tbuffer_t *)PL_bufptr); + return (clock_t) retval; + } +# define times(t) vms_times(t) +#else +#if defined (WIN32) +# undef mkfifo +# define mkfifo(a,b) not_here("mkfifo") +# define ttyname(a) (char*)not_here("ttyname") +# define sigset_t long +# define pid_t long +# ifdef __BORLANDC__ +# define tzname _tzname +# endif +# ifdef _MSC_VER +# define mode_t short +# endif +# ifdef __MINGW32__ +# define mode_t short +# ifndef tzset +# define tzset() not_here("tzset") +# endif +# ifndef _POSIX_OPEN_MAX +# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */ +# endif +# endif +# define sigaction(a,b,c) not_here("sigaction") +# define sigpending(a) not_here("sigpending") +# define sigprocmask(a,b,c) not_here("sigprocmask") +# define sigsuspend(a) not_here("sigsuspend") +# define sigemptyset(a) not_here("sigemptyset") +# define sigaddset(a,b) not_here("sigaddset") +# define sigdelset(a,b) not_here("sigdelset") +# define sigfillset(a) not_here("sigfillset") +# define sigismember(a,b) not_here("sigismember") +#else + +# ifndef HAS_MKFIFO +# ifndef mkfifo +# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) +# endif +# endif /* !HAS_MKFIFO */ + +# include +# include +# ifdef HAS_UNAME +# include +# endif +# include +# ifdef I_UTIME +# include +# endif +#endif /* WIN32 */ +#endif /* __VMS */ + +typedef int SysRet; +typedef long SysRetLong; +typedef sigset_t* POSIX__SigSet; +typedef HV* POSIX__SigAction; +#ifdef I_TERMIOS +typedef struct termios* POSIX__Termios; +#else /* Define termios types to int, and call not_here for the functions.*/ +#define POSIX__Termios int +#define speed_t int +#define tcflag_t int +#define cc_t int +#define cfgetispeed(x) not_here("cfgetispeed") +#define cfgetospeed(x) not_here("cfgetospeed") +#define tcdrain(x) not_here("tcdrain") +#define tcflush(x,y) not_here("tcflush") +#define tcsendbreak(x,y) not_here("tcsendbreak") +#define cfsetispeed(x,y) not_here("cfsetispeed") +#define cfsetospeed(x,y) not_here("cfsetospeed") +#define ctermid(x) (char *) not_here("ctermid") +#define tcflow(x,y) not_here("tcflow") +#define tcgetattr(x,y) not_here("tcgetattr") +#define tcsetattr(x,y,z) not_here("tcsetattr") +#endif + +/* Possibly needed prototypes */ +char *cuserid _((char *)); +double strtod _((const char *, char **)); +long strtol _((const char *, char **, int)); +unsigned long strtoul _((const char *, char **, int)); + +#ifndef HAS_CUSERID +#define cuserid(a) (char *) not_here("cuserid") +#endif +#ifndef HAS_DIFFTIME +#ifndef difftime +#define difftime(a,b) not_here("difftime") +#endif +#endif +#ifndef HAS_FPATHCONF +#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") +#endif +#ifndef HAS_MKTIME +#define mktime(a) not_here("mktime") +#endif +#ifndef HAS_NICE +#define nice(a) not_here("nice") +#endif +#ifndef HAS_PATHCONF +#define pathconf(f,n) (SysRetLong) not_here("pathconf") +#endif +#ifndef HAS_SYSCONF +#define sysconf(n) (SysRetLong) not_here("sysconf") +#endif +#ifndef HAS_READLINK +#define readlink(a,b,c) not_here("readlink") +#endif +#ifndef HAS_SETPGID +#define setpgid(a,b) not_here("setpgid") +#endif +#ifndef HAS_SETSID +#define setsid() not_here("setsid") +#endif +#ifndef HAS_STRCOLL +#define strcoll(s1,s2) not_here("strcoll") +#endif +#ifndef HAS_STRTOD +#define strtod(s1,s2) not_here("strtod") +#endif +#ifndef HAS_STRTOL +#define strtol(s1,s2,b) not_here("strtol") +#endif +#ifndef HAS_STRTOUL +#define strtoul(s1,s2,b) not_here("strtoul") +#endif +#ifndef HAS_STRXFRM +#define strxfrm(s1,s2,n) not_here("strxfrm") +#endif +#ifndef HAS_TCGETPGRP +#define tcgetpgrp(a) not_here("tcgetpgrp") +#endif +#ifndef HAS_TCSETPGRP +#define tcsetpgrp(a,b) not_here("tcsetpgrp") +#endif +#ifndef HAS_TIMES +#define times(a) not_here("times") +#endif +#ifndef HAS_UNAME +#define uname(a) not_here("uname") +#endif +#ifndef HAS_WAITPID +#define waitpid(a,b,c) not_here("waitpid") +#endif + +#ifndef HAS_MBLEN +#ifndef mblen +#define mblen(a,b) not_here("mblen") +#endif +#endif +#ifndef HAS_MBSTOWCS +#define mbstowcs(s, pwcs, n) not_here("mbstowcs") +#endif +#ifndef HAS_MBTOWC +#define mbtowc(pwc, s, n) not_here("mbtowc") +#endif +#ifndef HAS_WCSTOMBS +#define wcstombs(s, pwcs, n) not_here("wcstombs") +#endif +#ifndef HAS_WCTOMB +#define wctomb(s, wchar) not_here("wcstombs") +#endif +#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB) +/* If we don't have these functions, then we wouldn't have gotten a typedef + for wchar_t, the wide character type. Defining wchar_t allows the + functions referencing it to compile. Its actual type is then meaningless, + since without the above functions, all sections using it end up calling + not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */ +#ifndef wchar_t +#define wchar_t char +#endif +#endif + +#ifndef HAS_LOCALECONV +#define localeconv() not_here("localeconv") +#endif + +#ifdef HAS_TZNAME +# ifndef WIN32 +extern char *tzname[]; +# endif +#else +#if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname)) +char *tzname[] = { "" , "" }; +#endif +#endif + +/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) + * fields for which we don't have Configure support yet: + * char *tm_zone; -- abbreviation of timezone name + * long tm_gmtoff; -- offset from GMT in seconds + * To workaround core dumps from the uninitialised tm_zone we get the + * system to give us a reasonable struct to copy. This fix means that + * strftime uses the tm_zone and tm_gmtoff values returned by + * localtime(time()). That should give the desired result most of the + * time. But probably not always! + * + * This is a temporary workaround to be removed once Configure + * support is added and NETaa14816 is considered in full. + * It does not address tzname aspects of NETaa14816. + */ +#ifdef HAS_GNULIBC +# ifndef STRUCT_TM_HASZONE +# define STRUCT_TM_HAS_ZONE +# endif +#endif + +#ifdef STRUCT_TM_HASZONE +static void +init_tm(ptm) /* see mktime, strftime and asctime */ + struct tm *ptm; +{ + Time_t now; + (void)time(&now); + Copy(localtime(&now), ptm, 1, struct tm); +} + +#else +# define init_tm(ptm) +#endif + + +#ifdef HAS_LONG_DOUBLE +# if LONG_DOUBLESIZE > DOUBLESIZE +# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */ +# endif +#endif + +#ifndef HAS_LONG_DOUBLE +#ifdef LDBL_MAX +#undef LDBL_MAX +#endif +#ifdef LDBL_MIN +#undef LDBL_MIN +#endif +#ifdef LDBL_EPSILON +#undef LDBL_EPSILON +#endif +#endif + +static int +not_here(char *s) +{ + croak("POSIX::%s not implemented on this architecture", s); + return -1; +} + +static +#ifdef HAS_LONG_DOUBLE +long double +#else +double +#endif +constant(char *name, int arg) +{ + errno = 0; + switch (*name) { + case 'A': + if (strEQ(name, "ARG_MAX")) +#ifdef ARG_MAX + return ARG_MAX; +#else + goto not_there; +#endif + break; + case 'B': + if (strEQ(name, "BUFSIZ")) +#ifdef BUFSIZ + return BUFSIZ; +#else + goto not_there; +#endif + if (strEQ(name, "BRKINT")) +#ifdef BRKINT + return BRKINT; +#else + goto not_there; +#endif + if (strEQ(name, "B9600")) +#ifdef B9600 + return B9600; +#else + goto not_there; +#endif + if (strEQ(name, "B19200")) +#ifdef B19200 + return B19200; +#else + goto not_there; +#endif + if (strEQ(name, "B38400")) +#ifdef B38400 + return B38400; +#else + goto not_there; +#endif + if (strEQ(name, "B0")) +#ifdef B0 + return B0; +#else + goto not_there; +#endif + if (strEQ(name, "B110")) +#ifdef B110 + return B110; +#else + goto not_there; +#endif + if (strEQ(name, "B1200")) +#ifdef B1200 + return B1200; +#else + goto not_there; +#endif + if (strEQ(name, "B134")) +#ifdef B134 + return B134; +#else + goto not_there; +#endif + if (strEQ(name, "B150")) +#ifdef B150 + return B150; +#else + goto not_there; +#endif + if (strEQ(name, "B1800")) +#ifdef B1800 + return B1800; +#else + goto not_there; +#endif + if (strEQ(name, "B200")) +#ifdef B200 + return B200; +#else + goto not_there; +#endif + if (strEQ(name, "B2400")) +#ifdef B2400 + return B2400; +#else + goto not_there; +#endif + if (strEQ(name, "B300")) +#ifdef B300 + return B300; +#else + goto not_there; +#endif + if (strEQ(name, "B4800")) +#ifdef B4800 + return B4800; +#else + goto not_there; +#endif + if (strEQ(name, "B50")) +#ifdef B50 + return B50; +#else + goto not_there; +#endif + if (strEQ(name, "B600")) +#ifdef B600 + return B600; +#else + goto not_there; +#endif + if (strEQ(name, "B75")) +#ifdef B75 + return B75; +#else + goto not_there; +#endif + break; + case 'C': + if (strEQ(name, "CHAR_BIT")) +#ifdef CHAR_BIT + return CHAR_BIT; +#else + goto not_there; +#endif + if (strEQ(name, "CHAR_MAX")) +#ifdef CHAR_MAX + return CHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "CHAR_MIN")) +#ifdef CHAR_MIN + return CHAR_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "CHILD_MAX")) +#ifdef CHILD_MAX + return CHILD_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "CLK_TCK")) +#ifdef CLK_TCK + return CLK_TCK; +#else + goto not_there; +#endif + if (strEQ(name, "CLOCAL")) +#ifdef CLOCAL + return CLOCAL; +#else + goto not_there; +#endif + if (strEQ(name, "CLOCKS_PER_SEC")) +#ifdef CLOCKS_PER_SEC + return CLOCKS_PER_SEC; +#else + goto not_there; +#endif + if (strEQ(name, "CREAD")) +#ifdef CREAD + return CREAD; +#else + goto not_there; +#endif + if (strEQ(name, "CS5")) +#ifdef CS5 + return CS5; +#else + goto not_there; +#endif + if (strEQ(name, "CS6")) +#ifdef CS6 + return CS6; +#else + goto not_there; +#endif + if (strEQ(name, "CS7")) +#ifdef CS7 + return CS7; +#else + goto not_there; +#endif + if (strEQ(name, "CS8")) +#ifdef CS8 + return CS8; +#else + goto not_there; +#endif + if (strEQ(name, "CSIZE")) +#ifdef CSIZE + return CSIZE; +#else + goto not_there; +#endif + if (strEQ(name, "CSTOPB")) +#ifdef CSTOPB + return CSTOPB; +#else + goto not_there; +#endif + break; + case 'D': + if (strEQ(name, "DBL_MAX")) +#ifdef DBL_MAX + return DBL_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN")) +#ifdef DBL_MIN + return DBL_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_DIG")) +#ifdef DBL_DIG + return DBL_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_EPSILON")) +#ifdef DBL_EPSILON + return DBL_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MANT_DIG")) +#ifdef DBL_MANT_DIG + return DBL_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MAX_10_EXP")) +#ifdef DBL_MAX_10_EXP + return DBL_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MAX_EXP")) +#ifdef DBL_MAX_EXP + return DBL_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN_10_EXP")) +#ifdef DBL_MIN_10_EXP + return DBL_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN_EXP")) +#ifdef DBL_MIN_EXP + return DBL_MIN_EXP; +#else + goto not_there; +#endif + break; + case 'E': + switch (name[1]) { + case 'A': + if (strEQ(name, "EACCES")) +#ifdef EACCES + return EACCES; +#else + goto not_there; +#endif + if (strEQ(name, "EADDRINUSE")) +#ifdef EADDRINUSE + return EADDRINUSE; +#else + goto not_there; +#endif + if (strEQ(name, "EADDRNOTAVAIL")) +#ifdef EADDRNOTAVAIL + return EADDRNOTAVAIL; +#else + goto not_there; +#endif + if (strEQ(name, "EAFNOSUPPORT")) +#ifdef EAFNOSUPPORT + return EAFNOSUPPORT; +#else + goto not_there; +#endif + if (strEQ(name, "EAGAIN")) +#ifdef EAGAIN + return EAGAIN; +#else + goto not_there; +#endif + if (strEQ(name, "EALREADY")) +#ifdef EALREADY + return EALREADY; +#else + goto not_there; +#endif + break; + case 'B': + if (strEQ(name, "EBADF")) +#ifdef EBADF + return EBADF; +#else + goto not_there; +#endif + if (strEQ(name, "EBUSY")) +#ifdef EBUSY + return EBUSY; +#else + goto not_there; +#endif + break; + case 'C': + if (strEQ(name, "ECHILD")) +#ifdef ECHILD + return ECHILD; +#else + goto not_there; +#endif + if (strEQ(name, "ECHO")) +#ifdef ECHO + return ECHO; +#else + goto not_there; +#endif + if (strEQ(name, "ECHOE")) +#ifdef ECHOE + return ECHOE; +#else + goto not_there; +#endif + if (strEQ(name, "ECHOK")) +#ifdef ECHOK + return ECHOK; +#else + goto not_there; +#endif + if (strEQ(name, "ECHONL")) +#ifdef ECHONL + return ECHONL; +#else + goto not_there; +#endif + if (strEQ(name, "ECONNABORTED")) +#ifdef ECONNABORTED + return ECONNABORTED; +#else + goto not_there; +#endif + if (strEQ(name, "ECONNREFUSED")) +#ifdef ECONNREFUSED + return ECONNREFUSED; +#else + goto not_there; +#endif + if (strEQ(name, "ECONNRESET")) +#ifdef ECONNRESET + return ECONNRESET; +#else + goto not_there; +#endif + break; + case 'D': + if (strEQ(name, "EDEADLK")) +#ifdef EDEADLK + return EDEADLK; +#else + goto not_there; +#endif + if (strEQ(name, "EDESTADDRREQ")) +#ifdef EDESTADDRREQ + return EDESTADDRREQ; +#else + goto not_there; +#endif + if (strEQ(name, "EDOM")) +#ifdef EDOM + return EDOM; +#else + goto not_there; +#endif + if (strEQ(name, "EDQUOT")) +#ifdef EDQUOT + return EDQUOT; +#else + goto not_there; +#endif + break; + case 'E': + if (strEQ(name, "EEXIST")) +#ifdef EEXIST + return EEXIST; +#else + goto not_there; +#endif + break; + case 'F': + if (strEQ(name, "EFAULT")) +#ifdef EFAULT + return EFAULT; +#else + goto not_there; +#endif + if (strEQ(name, "EFBIG")) +#ifdef EFBIG + return EFBIG; +#else + goto not_there; +#endif + break; + case 'H': + if (strEQ(name, "EHOSTDOWN")) +#ifdef EHOSTDOWN + return EHOSTDOWN; +#else + goto not_there; +#endif + if (strEQ(name, "EHOSTUNREACH")) +#ifdef EHOSTUNREACH + return EHOSTUNREACH; +#else + goto not_there; +#endif + break; + case 'I': + if (strEQ(name, "EINPROGRESS")) +#ifdef EINPROGRESS + return EINPROGRESS; +#else + goto not_there; +#endif + if (strEQ(name, "EINTR")) +#ifdef EINTR + return EINTR; +#else + goto not_there; +#endif + if (strEQ(name, "EINVAL")) +#ifdef EINVAL + return EINVAL; +#else + goto not_there; +#endif + if (strEQ(name, "EIO")) +#ifdef EIO + return EIO; +#else + goto not_there; +#endif + if (strEQ(name, "EISCONN")) +#ifdef EISCONN + return EISCONN; +#else + goto not_there; +#endif + if (strEQ(name, "EISDIR")) +#ifdef EISDIR + return EISDIR; +#else + goto not_there; +#endif + break; + case 'L': + if (strEQ(name, "ELOOP")) +#ifdef ELOOP + return ELOOP; +#else + goto not_there; +#endif + break; + case 'M': + if (strEQ(name, "EMFILE")) +#ifdef EMFILE + return EMFILE; +#else + goto not_there; +#endif + if (strEQ(name, "EMLINK")) +#ifdef EMLINK + return EMLINK; +#else + goto not_there; +#endif + if (strEQ(name, "EMSGSIZE")) +#ifdef EMSGSIZE + return EMSGSIZE; +#else + goto not_there; +#endif + break; + case 'N': + if (strEQ(name, "ENETDOWN")) +#ifdef ENETDOWN + return ENETDOWN; +#else + goto not_there; +#endif + if (strEQ(name, "ENETRESET")) +#ifdef ENETRESET + return ENETRESET; +#else + goto not_there; +#endif + if (strEQ(name, "ENETUNREACH")) +#ifdef ENETUNREACH + return ENETUNREACH; +#else + goto not_there; +#endif + if (strEQ(name, "ENOBUFS")) +#ifdef ENOBUFS + return ENOBUFS; +#else + goto not_there; +#endif + if (strEQ(name, "ENOEXEC")) +#ifdef ENOEXEC + return ENOEXEC; +#else + goto not_there; +#endif + if (strEQ(name, "ENOMEM")) +#ifdef ENOMEM + return ENOMEM; +#else + goto not_there; +#endif + if (strEQ(name, "ENOPROTOOPT")) +#ifdef ENOPROTOOPT + return ENOPROTOOPT; +#else + goto not_there; +#endif + if (strEQ(name, "ENOSPC")) +#ifdef ENOSPC + return ENOSPC; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTBLK")) +#ifdef ENOTBLK + return ENOTBLK; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTCONN")) +#ifdef ENOTCONN + return ENOTCONN; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTDIR")) +#ifdef ENOTDIR + return ENOTDIR; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTEMPTY")) +#ifdef ENOTEMPTY + return ENOTEMPTY; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTSOCK")) +#ifdef ENOTSOCK + return ENOTSOCK; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTTY")) +#ifdef ENOTTY + return ENOTTY; +#else + goto not_there; +#endif + if (strEQ(name, "ENFILE")) +#ifdef ENFILE + return ENFILE; +#else + goto not_there; +#endif + if (strEQ(name, "ENODEV")) +#ifdef ENODEV + return ENODEV; +#else + goto not_there; +#endif + if (strEQ(name, "ENOENT")) +#ifdef ENOENT + return ENOENT; +#else + goto not_there; +#endif + if (strEQ(name, "ENOLCK")) +#ifdef ENOLCK + return ENOLCK; +#else + goto not_there; +#endif + if (strEQ(name, "ENOSYS")) +#ifdef ENOSYS + return ENOSYS; +#else + goto not_there; +#endif + if (strEQ(name, "ENXIO")) +#ifdef ENXIO + return ENXIO; +#else + goto not_there; +#endif + if (strEQ(name, "ENAMETOOLONG")) +#ifdef ENAMETOOLONG + return ENAMETOOLONG; +#else + goto not_there; +#endif + break; + case 'O': + if (strEQ(name, "EOF")) +#ifdef EOF + return EOF; +#else + goto not_there; +#endif + if (strEQ(name, "EOPNOTSUPP")) +#ifdef EOPNOTSUPP + return EOPNOTSUPP; +#else + goto not_there; +#endif + break; + case 'P': + if (strEQ(name, "EPERM")) +#ifdef EPERM + return EPERM; +#else + goto not_there; +#endif + if (strEQ(name, "EPFNOSUPPORT")) +#ifdef EPFNOSUPPORT + return EPFNOSUPPORT; +#else + goto not_there; +#endif + if (strEQ(name, "EPIPE")) +#ifdef EPIPE + return EPIPE; +#else + goto not_there; +#endif + if (strEQ(name, "EPROCLIM")) +#ifdef EPROCLIM + return EPROCLIM; +#else + goto not_there; +#endif + if (strEQ(name, "EPROTONOSUPPORT")) +#ifdef EPROTONOSUPPORT + return EPROTONOSUPPORT; +#else + goto not_there; +#endif + if (strEQ(name, "EPROTOTYPE")) +#ifdef EPROTOTYPE + return EPROTOTYPE; +#else + goto not_there; +#endif + break; + case 'R': + if (strEQ(name, "ERANGE")) +#ifdef ERANGE + return ERANGE; +#else + goto not_there; +#endif + if (strEQ(name, "EREMOTE")) +#ifdef EREMOTE + return EREMOTE; +#else + goto not_there; +#endif + if (strEQ(name, "ERESTART")) +#ifdef ERESTART + return ERESTART; +#else + goto not_there; +#endif + if (strEQ(name, "EROFS")) +#ifdef EROFS + return EROFS; +#else + goto not_there; +#endif + break; + case 'S': + if (strEQ(name, "ESHUTDOWN")) +#ifdef ESHUTDOWN + return ESHUTDOWN; +#else + goto not_there; +#endif + if (strEQ(name, "ESOCKTNOSUPPORT")) +#ifdef ESOCKTNOSUPPORT + return ESOCKTNOSUPPORT; +#else + goto not_there; +#endif + if (strEQ(name, "ESPIPE")) +#ifdef ESPIPE + return ESPIPE; +#else + goto not_there; +#endif + if (strEQ(name, "ESRCH")) +#ifdef ESRCH + return ESRCH; +#else + goto not_there; +#endif + if (strEQ(name, "ESTALE")) +#ifdef ESTALE + return ESTALE; +#else + goto not_there; +#endif + break; + case 'T': + if (strEQ(name, "ETIMEDOUT")) +#ifdef ETIMEDOUT + return ETIMEDOUT; +#else + goto not_there; +#endif + if (strEQ(name, "ETOOMANYREFS")) +#ifdef ETOOMANYREFS + return ETOOMANYREFS; +#else + goto not_there; +#endif + if (strEQ(name, "ETXTBSY")) +#ifdef ETXTBSY + return ETXTBSY; +#else + goto not_there; +#endif + break; + case 'U': + if (strEQ(name, "EUSERS")) +#ifdef EUSERS + return EUSERS; +#else + goto not_there; +#endif + break; + case 'W': + if (strEQ(name, "EWOULDBLOCK")) +#ifdef EWOULDBLOCK + return EWOULDBLOCK; +#else + goto not_there; +#endif + break; + case 'X': + if (strEQ(name, "EXIT_FAILURE")) +#ifdef EXIT_FAILURE + return EXIT_FAILURE; +#else + return 1; +#endif + if (strEQ(name, "EXIT_SUCCESS")) +#ifdef EXIT_SUCCESS + return EXIT_SUCCESS; +#else + return 0; +#endif + if (strEQ(name, "EXDEV")) +#ifdef EXDEV + return EXDEV; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "E2BIG")) +#ifdef E2BIG + return E2BIG; +#else + goto not_there; +#endif + break; + case 'F': + if (strnEQ(name, "FLT_", 4)) { + if (strEQ(name, "FLT_MAX")) +#ifdef FLT_MAX + return FLT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN")) +#ifdef FLT_MIN + return FLT_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_ROUNDS")) +#ifdef FLT_ROUNDS + return FLT_ROUNDS; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_DIG")) +#ifdef FLT_DIG + return FLT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_EPSILON")) +#ifdef FLT_EPSILON + return FLT_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MANT_DIG")) +#ifdef FLT_MANT_DIG + return FLT_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MAX_10_EXP")) +#ifdef FLT_MAX_10_EXP + return FLT_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MAX_EXP")) +#ifdef FLT_MAX_EXP + return FLT_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN_10_EXP")) +#ifdef FLT_MIN_10_EXP + return FLT_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN_EXP")) +#ifdef FLT_MIN_EXP + return FLT_MIN_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_RADIX")) +#ifdef FLT_RADIX + return FLT_RADIX; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "F_", 2)) { + if (strEQ(name, "F_DUPFD")) +#ifdef F_DUPFD + return F_DUPFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFD")) +#ifdef F_GETFD + return F_GETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFL")) +#ifdef F_GETFL + return F_GETFL; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETLK")) +#ifdef F_GETLK + return F_GETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_OK")) +#ifdef F_OK + return F_OK; +#else + goto not_there; +#endif + if (strEQ(name, "F_RDLCK")) +#ifdef F_RDLCK + return F_RDLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETFD")) +#ifdef F_SETFD + return F_SETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETFL")) +#ifdef F_SETFL + return F_SETFL; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLK")) +#ifdef F_SETLK + return F_SETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLKW")) +#ifdef F_SETLKW + return F_SETLKW; +#else + goto not_there; +#endif + if (strEQ(name, "F_UNLCK")) +#ifdef F_UNLCK + return F_UNLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_WRLCK")) +#ifdef F_WRLCK + return F_WRLCK; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "FD_CLOEXEC")) +#ifdef FD_CLOEXEC + return FD_CLOEXEC; +#else + goto not_there; +#endif + if (strEQ(name, "FILENAME_MAX")) +#ifdef FILENAME_MAX + return FILENAME_MAX; +#else + goto not_there; +#endif + break; + case 'H': + if (strEQ(name, "HUGE_VAL")) +#ifdef HUGE_VAL + return HUGE_VAL; +#else + goto not_there; +#endif + if (strEQ(name, "HUPCL")) +#ifdef HUPCL + return HUPCL; +#else + goto not_there; +#endif + break; + case 'I': + if (strEQ(name, "INT_MAX")) +#ifdef INT_MAX + return INT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "INT_MIN")) +#ifdef INT_MIN + return INT_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "ICANON")) +#ifdef ICANON + return ICANON; +#else + goto not_there; +#endif + if (strEQ(name, "ICRNL")) +#ifdef ICRNL + return ICRNL; +#else + goto not_there; +#endif + if (strEQ(name, "IEXTEN")) +#ifdef IEXTEN + return IEXTEN; +#else + goto not_there; +#endif + if (strEQ(name, "IGNBRK")) +#ifdef IGNBRK + return IGNBRK; +#else + goto not_there; +#endif + if (strEQ(name, "IGNCR")) +#ifdef IGNCR + return IGNCR; +#else + goto not_there; +#endif + if (strEQ(name, "IGNPAR")) +#ifdef IGNPAR + return IGNPAR; +#else + goto not_there; +#endif + if (strEQ(name, "INLCR")) +#ifdef INLCR + return INLCR; +#else + goto not_there; +#endif + if (strEQ(name, "INPCK")) +#ifdef INPCK + return INPCK; +#else + goto not_there; +#endif + if (strEQ(name, "ISIG")) +#ifdef ISIG + return ISIG; +#else + goto not_there; +#endif + if (strEQ(name, "ISTRIP")) +#ifdef ISTRIP + return ISTRIP; +#else + goto not_there; +#endif + if (strEQ(name, "IXOFF")) +#ifdef IXOFF + return IXOFF; +#else + goto not_there; +#endif + if (strEQ(name, "IXON")) +#ifdef IXON + return IXON; +#else + goto not_there; +#endif + break; + case 'L': + if (strnEQ(name, "LC_", 3)) { + if (strEQ(name, "LC_ALL")) +#ifdef LC_ALL + return LC_ALL; +#else + goto not_there; +#endif + if (strEQ(name, "LC_COLLATE")) +#ifdef LC_COLLATE + return LC_COLLATE; +#else + goto not_there; +#endif + if (strEQ(name, "LC_CTYPE")) +#ifdef LC_CTYPE + return LC_CTYPE; +#else + goto not_there; +#endif + if (strEQ(name, "LC_MONETARY")) +#ifdef LC_MONETARY + return LC_MONETARY; +#else + goto not_there; +#endif + if (strEQ(name, "LC_NUMERIC")) +#ifdef LC_NUMERIC + return LC_NUMERIC; +#else + goto not_there; +#endif + if (strEQ(name, "LC_TIME")) +#ifdef LC_TIME + return LC_TIME; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "LDBL_", 5)) { + if (strEQ(name, "LDBL_MAX")) +#ifdef LDBL_MAX + return LDBL_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN")) +#ifdef LDBL_MIN + return LDBL_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_DIG")) +#ifdef LDBL_DIG + return LDBL_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_EPSILON")) +#ifdef LDBL_EPSILON + return LDBL_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MANT_DIG")) +#ifdef LDBL_MANT_DIG + return LDBL_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MAX_10_EXP")) +#ifdef LDBL_MAX_10_EXP + return LDBL_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MAX_EXP")) +#ifdef LDBL_MAX_EXP + return LDBL_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN_10_EXP")) +#ifdef LDBL_MIN_10_EXP + return LDBL_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN_EXP")) +#ifdef LDBL_MIN_EXP + return LDBL_MIN_EXP; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "L_", 2)) { + if (strEQ(name, "L_ctermid")) +#ifdef L_ctermid + return L_ctermid; +#else + goto not_there; +#endif + if (strEQ(name, "L_cuserid")) +#ifdef L_cuserid + return L_cuserid; +#else + goto not_there; +#endif + if (strEQ(name, "L_tmpname")) +#ifdef L_tmpname + return L_tmpname; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "LONG_MAX")) +#ifdef LONG_MAX + return LONG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "LONG_MIN")) +#ifdef LONG_MIN + return LONG_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "LINK_MAX")) +#ifdef LINK_MAX + return LINK_MAX; +#else + goto not_there; +#endif + break; + case 'M': + if (strEQ(name, "MAX_CANON")) +#ifdef MAX_CANON + return MAX_CANON; +#else + goto not_there; +#endif + if (strEQ(name, "MAX_INPUT")) +#ifdef MAX_INPUT + return MAX_INPUT; +#else + goto not_there; +#endif + if (strEQ(name, "MB_CUR_MAX")) +#ifdef MB_CUR_MAX + return MB_CUR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "MB_LEN_MAX")) +#ifdef MB_LEN_MAX + return MB_LEN_MAX; +#else + goto not_there; +#endif + break; + case 'N': + if (strEQ(name, "NULL")) return 0; + if (strEQ(name, "NAME_MAX")) +#ifdef NAME_MAX + return NAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "NCCS")) +#ifdef NCCS + return NCCS; +#else + goto not_there; +#endif + if (strEQ(name, "NGROUPS_MAX")) +#ifdef NGROUPS_MAX + return NGROUPS_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "NOFLSH")) +#ifdef NOFLSH + return NOFLSH; +#else + goto not_there; +#endif + break; + case 'O': + if (strnEQ(name, "O_", 2)) { + if (strEQ(name, "O_APPEND")) +#ifdef O_APPEND + return O_APPEND; +#else + goto not_there; +#endif + if (strEQ(name, "O_CREAT")) +#ifdef O_CREAT + return O_CREAT; +#else + goto not_there; +#endif + if (strEQ(name, "O_TRUNC")) +#ifdef O_TRUNC + return O_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDONLY")) +#ifdef O_RDONLY + return O_RDONLY; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDWR")) +#ifdef O_RDWR + return O_RDWR; +#else + goto not_there; +#endif + if (strEQ(name, "O_WRONLY")) +#ifdef O_WRONLY + return O_WRONLY; +#else + goto not_there; +#endif + if (strEQ(name, "O_EXCL")) +#ifdef O_EXCL + return O_EXCL; +#else + goto not_there; +#endif + if (strEQ(name, "O_NOCTTY")) +#ifdef O_NOCTTY + return O_NOCTTY; +#else + goto not_there; +#endif + if (strEQ(name, "O_NONBLOCK")) +#ifdef O_NONBLOCK + return O_NONBLOCK; +#else + goto not_there; +#endif + if (strEQ(name, "O_ACCMODE")) +#ifdef O_ACCMODE + return O_ACCMODE; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "OPEN_MAX")) +#ifdef OPEN_MAX + return OPEN_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "OPOST")) +#ifdef OPOST + return OPOST; +#else + goto not_there; +#endif + break; + case 'P': + if (strEQ(name, "PATH_MAX")) +#ifdef PATH_MAX + return PATH_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "PARENB")) +#ifdef PARENB + return PARENB; +#else + goto not_there; +#endif + if (strEQ(name, "PARMRK")) +#ifdef PARMRK + return PARMRK; +#else + goto not_there; +#endif + if (strEQ(name, "PARODD")) +#ifdef PARODD + return PARODD; +#else + goto not_there; +#endif + if (strEQ(name, "PIPE_BUF")) +#ifdef PIPE_BUF + return PIPE_BUF; +#else + goto not_there; +#endif + break; + case 'R': + if (strEQ(name, "RAND_MAX")) +#ifdef RAND_MAX + return RAND_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "R_OK")) +#ifdef R_OK + return R_OK; +#else + goto not_there; +#endif + break; + case 'S': + if (strnEQ(name, "SIG", 3)) { + if (name[3] == '_') { + if (strEQ(name, "SIG_BLOCK")) +#ifdef SIG_BLOCK + return SIG_BLOCK; +#else + goto not_there; +#endif +#ifdef SIG_DFL + if (strEQ(name, "SIG_DFL")) return (IV)SIG_DFL; +#endif +#ifdef SIG_ERR + if (strEQ(name, "SIG_ERR")) return (IV)SIG_ERR; +#endif +#ifdef SIG_IGN + if (strEQ(name, "SIG_IGN")) return (IV)SIG_IGN; +#endif + if (strEQ(name, "SIG_SETMASK")) +#ifdef SIG_SETMASK + return SIG_SETMASK; +#else + goto not_there; +#endif + if (strEQ(name, "SIG_UNBLOCK")) +#ifdef SIG_UNBLOCK + return SIG_UNBLOCK; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "SIGABRT")) +#ifdef SIGABRT + return SIGABRT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGALRM")) +#ifdef SIGALRM + return SIGALRM; +#else + goto not_there; +#endif + if (strEQ(name, "SIGCHLD")) +#ifdef SIGCHLD + return SIGCHLD; +#else + goto not_there; +#endif + if (strEQ(name, "SIGCONT")) +#ifdef SIGCONT + return SIGCONT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGFPE")) +#ifdef SIGFPE + return SIGFPE; +#else + goto not_there; +#endif + if (strEQ(name, "SIGHUP")) +#ifdef SIGHUP + return SIGHUP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGILL")) +#ifdef SIGILL + return SIGILL; +#else + goto not_there; +#endif + if (strEQ(name, "SIGINT")) +#ifdef SIGINT + return SIGINT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGKILL")) +#ifdef SIGKILL + return SIGKILL; +#else + goto not_there; +#endif + if (strEQ(name, "SIGPIPE")) +#ifdef SIGPIPE + return SIGPIPE; +#else + goto not_there; +#endif + if (strEQ(name, "SIGQUIT")) +#ifdef SIGQUIT + return SIGQUIT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGSEGV")) +#ifdef SIGSEGV + return SIGSEGV; +#else + goto not_there; +#endif + if (strEQ(name, "SIGSTOP")) +#ifdef SIGSTOP + return SIGSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTERM")) +#ifdef SIGTERM + return SIGTERM; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTSTP")) +#ifdef SIGTSTP + return SIGTSTP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTTIN")) +#ifdef SIGTTIN + return SIGTTIN; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTTOU")) +#ifdef SIGTTOU + return SIGTTOU; +#else + goto not_there; +#endif + if (strEQ(name, "SIGUSR1")) +#ifdef SIGUSR1 + return SIGUSR1; +#else + goto not_there; +#endif + if (strEQ(name, "SIGUSR2")) +#ifdef SIGUSR2 + return SIGUSR2; +#else + goto not_there; +#endif + break; + } + if (name[1] == '_') { + if (strEQ(name, "S_ISGID")) +#ifdef S_ISGID + return S_ISGID; +#else + goto not_there; +#endif + if (strEQ(name, "S_ISUID")) +#ifdef S_ISUID + return S_ISUID; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRGRP")) +#ifdef S_IRGRP + return S_IRGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IROTH")) +#ifdef S_IROTH + return S_IROTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRUSR")) +#ifdef S_IRUSR + return S_IRUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXG")) +#ifdef S_IRWXG + return S_IRWXG; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXO")) +#ifdef S_IRWXO + return S_IRWXO; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXU")) +#ifdef S_IRWXU + return S_IRWXU; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWGRP")) +#ifdef S_IWGRP + return S_IWGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWOTH")) +#ifdef S_IWOTH + return S_IWOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWUSR")) +#ifdef S_IWUSR + return S_IWUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXGRP")) +#ifdef S_IXGRP + return S_IXGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXOTH")) +#ifdef S_IXOTH + return S_IXOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXUSR")) +#ifdef S_IXUSR + return S_IXUSR; +#else + goto not_there; +#endif + errno = EAGAIN; /* the following aren't constants */ +#ifdef S_ISBLK + if (strEQ(name, "S_ISBLK")) return S_ISBLK(arg); +#endif +#ifdef S_ISCHR + if (strEQ(name, "S_ISCHR")) return S_ISCHR(arg); +#endif +#ifdef S_ISDIR + if (strEQ(name, "S_ISDIR")) return S_ISDIR(arg); +#endif +#ifdef S_ISFIFO + if (strEQ(name, "S_ISFIFO")) return S_ISFIFO(arg); +#endif +#ifdef S_ISREG + if (strEQ(name, "S_ISREG")) return S_ISREG(arg); +#endif + break; + } + if (strEQ(name, "SEEK_CUR")) +#ifdef SEEK_CUR + return SEEK_CUR; +#else + goto not_there; +#endif + if (strEQ(name, "SEEK_END")) +#ifdef SEEK_END + return SEEK_END; +#else + goto not_there; +#endif + if (strEQ(name, "SEEK_SET")) +#ifdef SEEK_SET + return SEEK_SET; +#else + goto not_there; +#endif + if (strEQ(name, "STREAM_MAX")) +#ifdef STREAM_MAX + return STREAM_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SHRT_MAX")) +#ifdef SHRT_MAX + return SHRT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SHRT_MIN")) +#ifdef SHRT_MIN + return SHRT_MIN; +#else + goto not_there; +#endif + if (strnEQ(name, "SA_", 3)) { + if (strEQ(name, "SA_NOCLDSTOP")) +#ifdef SA_NOCLDSTOP + return SA_NOCLDSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "SA_NOCLDWAIT")) +#ifdef SA_NOCLDWAIT + return SA_NOCLDWAIT; +#else + goto not_there; +#endif + if (strEQ(name, "SA_NODEFER")) +#ifdef SA_NODEFER + return SA_NODEFER; +#else + goto not_there; +#endif + if (strEQ(name, "SA_ONSTACK")) +#ifdef SA_ONSTACK + return SA_ONSTACK; +#else + goto not_there; +#endif + if (strEQ(name, "SA_RESETHAND")) +#ifdef SA_RESETHAND + return SA_RESETHAND; +#else + goto not_there; +#endif + if (strEQ(name, "SA_RESTART")) +#ifdef SA_RESTART + return SA_RESTART; +#else + goto not_there; +#endif + if (strEQ(name, "SA_SIGINFO")) +#ifdef SA_SIGINFO + return SA_SIGINFO; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "SCHAR_MAX")) +#ifdef SCHAR_MAX + return SCHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SCHAR_MIN")) +#ifdef SCHAR_MIN + return SCHAR_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "SSIZE_MAX")) +#ifdef SSIZE_MAX + return SSIZE_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "STDIN_FILENO")) +#ifdef STDIN_FILENO + return STDIN_FILENO; +#else + goto not_there; +#endif + if (strEQ(name, "STDOUT_FILENO")) +#ifdef STDOUT_FILENO + return STDOUT_FILENO; +#else + goto not_there; +#endif + if (strEQ(name, "STRERR_FILENO")) +#ifdef STRERR_FILENO + return STRERR_FILENO; +#else + goto not_there; +#endif + break; + case 'T': + if (strEQ(name, "TCIFLUSH")) +#ifdef TCIFLUSH + return TCIFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCIOFF")) +#ifdef TCIOFF + return TCIOFF; +#else + goto not_there; +#endif + if (strEQ(name, "TCIOFLUSH")) +#ifdef TCIOFLUSH + return TCIOFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCION")) +#ifdef TCION + return TCION; +#else + goto not_there; +#endif + if (strEQ(name, "TCOFLUSH")) +#ifdef TCOFLUSH + return TCOFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCOOFF")) +#ifdef TCOOFF + return TCOOFF; +#else + goto not_there; +#endif + if (strEQ(name, "TCOON")) +#ifdef TCOON + return TCOON; +#else + goto not_there; +#endif + if (strEQ(name, "TCSADRAIN")) +#ifdef TCSADRAIN + return TCSADRAIN; +#else + goto not_there; +#endif + if (strEQ(name, "TCSAFLUSH")) +#ifdef TCSAFLUSH + return TCSAFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCSANOW")) +#ifdef TCSANOW + return TCSANOW; +#else + goto not_there; +#endif + if (strEQ(name, "TMP_MAX")) +#ifdef TMP_MAX + return TMP_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "TOSTOP")) +#ifdef TOSTOP + return TOSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "TZNAME_MAX")) +#ifdef TZNAME_MAX + return TZNAME_MAX; +#else + goto not_there; +#endif + break; + case 'U': + if (strEQ(name, "UCHAR_MAX")) +#ifdef UCHAR_MAX + return UCHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "UINT_MAX")) +#ifdef UINT_MAX + return UINT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "ULONG_MAX")) +#ifdef ULONG_MAX + return ULONG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "USHRT_MAX")) +#ifdef USHRT_MAX + return USHRT_MAX; +#else + goto not_there; +#endif + break; + case 'V': + if (strEQ(name, "VEOF")) +#ifdef VEOF + return VEOF; +#else + goto not_there; +#endif + if (strEQ(name, "VEOL")) +#ifdef VEOL + return VEOL; +#else + goto not_there; +#endif + if (strEQ(name, "VERASE")) +#ifdef VERASE + return VERASE; +#else + goto not_there; +#endif + if (strEQ(name, "VINTR")) +#ifdef VINTR + return VINTR; +#else + goto not_there; +#endif + if (strEQ(name, "VKILL")) +#ifdef VKILL + return VKILL; +#else + goto not_there; +#endif + if (strEQ(name, "VMIN")) +#ifdef VMIN + return VMIN; +#else + goto not_there; +#endif + if (strEQ(name, "VQUIT")) +#ifdef VQUIT + return VQUIT; +#else + goto not_there; +#endif + if (strEQ(name, "VSTART")) +#ifdef VSTART + return VSTART; +#else + goto not_there; +#endif + if (strEQ(name, "VSTOP")) +#ifdef VSTOP + return VSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "VSUSP")) +#ifdef VSUSP + return VSUSP; +#else + goto not_there; +#endif + if (strEQ(name, "VTIME")) +#ifdef VTIME + return VTIME; +#else + goto not_there; +#endif + break; + case 'W': + if (strEQ(name, "W_OK")) +#ifdef W_OK + return W_OK; +#else + goto not_there; +#endif + if (strEQ(name, "WNOHANG")) +#ifdef WNOHANG + return WNOHANG; +#else + goto not_there; +#endif + if (strEQ(name, "WUNTRACED")) +#ifdef WUNTRACED + return WUNTRACED; +#else + goto not_there; +#endif + errno = EAGAIN; /* the following aren't constants */ +#ifdef WEXITSTATUS + if (strEQ(name, "WEXITSTATUS")) return WEXITSTATUS(arg); +#endif +#ifdef WIFEXITED + if (strEQ(name, "WIFEXITED")) return WIFEXITED(arg); +#endif +#ifdef WIFSIGNALED + if (strEQ(name, "WIFSIGNALED")) return WIFSIGNALED(arg); +#endif +#ifdef WIFSTOPPED + if (strEQ(name, "WIFSTOPPED")) return WIFSTOPPED(arg); +#endif +#ifdef WSTOPSIG + if (strEQ(name, "WSTOPSIG")) return WSTOPSIG(arg); +#endif +#ifdef WTERMSIG + if (strEQ(name, "WTERMSIG")) return WTERMSIG(arg); +#endif + break; + case 'X': + if (strEQ(name, "X_OK")) +#ifdef X_OK + return X_OK; +#else + goto not_there; +#endif + break; + case '_': + if (strnEQ(name, "_PC_", 4)) { + if (strEQ(name, "_PC_CHOWN_RESTRICTED")) +#if defined(_PC_CHOWN_RESTRICTED) || HINT_SC_EXIST + return _PC_CHOWN_RESTRICTED; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_LINK_MAX")) +#if defined(_PC_LINK_MAX) || HINT_SC_EXIST + return _PC_LINK_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_MAX_CANON")) +#if defined(_PC_MAX_CANON) || HINT_SC_EXIST + return _PC_MAX_CANON; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_MAX_INPUT")) +#if defined(_PC_MAX_INPUT) || HINT_SC_EXIST + return _PC_MAX_INPUT; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_NAME_MAX")) +#if defined(_PC_NAME_MAX) || HINT_SC_EXIST + return _PC_NAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_NO_TRUNC")) +#if defined(_PC_NO_TRUNC) || HINT_SC_EXIST + return _PC_NO_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_PATH_MAX")) +#if defined(_PC_PATH_MAX) || HINT_SC_EXIST + return _PC_PATH_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_PIPE_BUF")) +#if defined(_PC_PIPE_BUF) || HINT_SC_EXIST + return _PC_PIPE_BUF; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_VDISABLE")) +#if defined(_PC_VDISABLE) || HINT_SC_EXIST + return _PC_VDISABLE; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "_POSIX_", 7)) { + if (strEQ(name, "_POSIX_ARG_MAX")) +#ifdef _POSIX_ARG_MAX + return _POSIX_ARG_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_CHILD_MAX")) +#ifdef _POSIX_CHILD_MAX + return _POSIX_CHILD_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_CHOWN_RESTRICTED")) +#ifdef _POSIX_CHOWN_RESTRICTED + return _POSIX_CHOWN_RESTRICTED; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_JOB_CONTROL")) +#ifdef _POSIX_JOB_CONTROL + return _POSIX_JOB_CONTROL; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_LINK_MAX")) +#ifdef _POSIX_LINK_MAX + return _POSIX_LINK_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_MAX_CANON")) +#ifdef _POSIX_MAX_CANON + return _POSIX_MAX_CANON; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_MAX_INPUT")) +#ifdef _POSIX_MAX_INPUT + return _POSIX_MAX_INPUT; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NAME_MAX")) +#ifdef _POSIX_NAME_MAX + return _POSIX_NAME_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NGROUPS_MAX")) +#ifdef _POSIX_NGROUPS_MAX + return _POSIX_NGROUPS_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NO_TRUNC")) +#ifdef _POSIX_NO_TRUNC + return _POSIX_NO_TRUNC; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_OPEN_MAX")) +#ifdef _POSIX_OPEN_MAX + return _POSIX_OPEN_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_PATH_MAX")) +#ifdef _POSIX_PATH_MAX + return _POSIX_PATH_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_PIPE_BUF")) +#ifdef _POSIX_PIPE_BUF + return _POSIX_PIPE_BUF; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_SAVED_IDS")) +#ifdef _POSIX_SAVED_IDS + return _POSIX_SAVED_IDS; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_SSIZE_MAX")) +#ifdef _POSIX_SSIZE_MAX + return _POSIX_SSIZE_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_STREAM_MAX")) +#ifdef _POSIX_STREAM_MAX + return _POSIX_STREAM_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_TZNAME_MAX")) +#ifdef _POSIX_TZNAME_MAX + return _POSIX_TZNAME_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_VDISABLE")) +#ifdef _POSIX_VDISABLE + return _POSIX_VDISABLE; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_VERSION")) +#ifdef _POSIX_VERSION + return _POSIX_VERSION; +#else + return 0; +#endif + break; + } + if (strnEQ(name, "_SC_", 4)) { + if (strEQ(name, "_SC_ARG_MAX")) +#if defined(_SC_ARG_MAX) || HINT_SC_EXIST + return _SC_ARG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_CHILD_MAX")) +#if defined(_SC_CHILD_MAX) || HINT_SC_EXIST + return _SC_CHILD_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_CLK_TCK")) +#if defined(_SC_CLK_TCK) || HINT_SC_EXIST + return _SC_CLK_TCK; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_JOB_CONTROL")) +#if defined(_SC_JOB_CONTROL) || HINT_SC_EXIST + return _SC_JOB_CONTROL; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_NGROUPS_MAX")) +#if defined(_SC_NGROUPS_MAX) || HINT_SC_EXIST + return _SC_NGROUPS_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_OPEN_MAX")) +#if defined(_SC_OPEN_MAX) || HINT_SC_EXIST + return _SC_OPEN_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_SAVED_IDS")) +#if defined(_SC_SAVED_IDS) || HINT_SC_EXIST + return _SC_SAVED_IDS; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_STREAM_MAX")) +#if defined(_SC_STREAM_MAX) || HINT_SC_EXIST + return _SC_STREAM_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_TZNAME_MAX")) +#if defined(_SC_TZNAME_MAX) || HINT_SC_EXIST + return _SC_TZNAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_VERSION")) +#if defined(_SC_VERSION) || HINT_SC_EXIST + return _SC_VERSION; +#else + goto not_there; +#endif + break; + } + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig + +POSIX::SigSet +new(packname = "POSIX::SigSet", ...) + char * packname + CODE: + { + int i; + RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); + sigemptyset(RETVAL); + for (i = 1; i < items; i++) + sigaddset(RETVAL, SvIV(ST(i))); + } + OUTPUT: + RETVAL + +void +DESTROY(sigset) + POSIX::SigSet sigset + CODE: + safefree((char *)sigset); + +SysRet +sigaddset(sigset, sig) + POSIX::SigSet sigset + int sig + +SysRet +sigdelset(sigset, sig) + POSIX::SigSet sigset + int sig + +SysRet +sigemptyset(sigset) + POSIX::SigSet sigset + +SysRet +sigfillset(sigset) + POSIX::SigSet sigset + +int +sigismember(sigset, sig) + POSIX::SigSet sigset + int sig + + +MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf + +POSIX::Termios +new(packname = "POSIX::Termios", ...) + char * packname + CODE: + { +#ifdef I_TERMIOS + RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); +#else + not_here("termios"); + RETVAL = 0; +#endif + } + OUTPUT: + RETVAL + +void +DESTROY(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS + safefree((char *)termios_ref); +#else + not_here("termios"); +#endif + +SysRet +getattr(termios_ref, fd = 0) + POSIX::Termios termios_ref + int fd + CODE: + RETVAL = tcgetattr(fd, termios_ref); + OUTPUT: + RETVAL + +SysRet +setattr(termios_ref, fd = 0, optional_actions = 0) + POSIX::Termios termios_ref + int fd + int optional_actions + CODE: + RETVAL = tcsetattr(fd, optional_actions, termios_ref); + OUTPUT: + RETVAL + +speed_t +cfgetispeed(termios_ref) + POSIX::Termios termios_ref + +speed_t +cfgetospeed(termios_ref) + POSIX::Termios termios_ref + +tcflag_t +getiflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_iflag; +#else + not_here("getiflag"); + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +tcflag_t +getoflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_oflag; +#else + not_here("getoflag"); + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +tcflag_t +getcflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_cflag; +#else + not_here("getcflag"); + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +tcflag_t +getlflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_lflag; +#else + not_here("getlflag"); + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +cc_t +getcc(termios_ref, ccix) + POSIX::Termios termios_ref + int ccix + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + if (ccix >= NCCS) + croak("Bad getcc subscript"); + RETVAL = termios_ref->c_cc[ccix]; +#else + not_here("getcc"); + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +SysRet +cfsetispeed(termios_ref, speed) + POSIX::Termios termios_ref + speed_t speed + +SysRet +cfsetospeed(termios_ref, speed) + POSIX::Termios termios_ref + speed_t speed + +void +setiflag(termios_ref, iflag) + POSIX::Termios termios_ref + tcflag_t iflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_iflag = iflag; +#else + not_here("setiflag"); +#endif + +void +setoflag(termios_ref, oflag) + POSIX::Termios termios_ref + tcflag_t oflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_oflag = oflag; +#else + not_here("setoflag"); +#endif + +void +setcflag(termios_ref, cflag) + POSIX::Termios termios_ref + tcflag_t cflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_cflag = cflag; +#else + not_here("setcflag"); +#endif + +void +setlflag(termios_ref, lflag) + POSIX::Termios termios_ref + tcflag_t lflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_lflag = lflag; +#else + not_here("setlflag"); +#endif + +void +setcc(termios_ref, ccix, cc) + POSIX::Termios termios_ref + int ccix + cc_t cc + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + if (ccix >= NCCS) + croak("Bad setcc subscript"); + termios_ref->c_cc[ccix] = cc; +#else + not_here("setcc"); +#endif + + +MODULE = POSIX PACKAGE = POSIX + +double +constant(name,arg) + char * name + int arg + +int +isalnum(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isalnum(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isalpha(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isalpha(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +iscntrl(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!iscntrl(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isdigit(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isdigit(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isgraph(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isgraph(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +islower(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!islower(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isprint(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isprint(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +ispunct(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!ispunct(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isspace(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isspace(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isupper(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isupper(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isxdigit(charstring) + unsigned char * charstring + CODE: + unsigned char *s = charstring; + unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */ + for (RETVAL = 1; RETVAL && s < e; s++) + if (!isxdigit(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +SysRet +open(filename, flags = O_RDONLY, mode = 0666) + char * filename + int flags + Mode_t mode + CODE: + if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL)) + TAINT_PROPER("open"); + RETVAL = open(filename, flags, mode); + OUTPUT: + RETVAL + + +HV * +localeconv() + CODE: +#ifdef HAS_LOCALECONV + struct lconv *lcbuf; + RETVAL = newHV(); + if (lcbuf = localeconv()) { + /* the strings */ + if (lcbuf->decimal_point && *lcbuf->decimal_point) + hv_store(RETVAL, "decimal_point", 13, + newSVpv(lcbuf->decimal_point, 0), 0); + if (lcbuf->thousands_sep && *lcbuf->thousands_sep) + hv_store(RETVAL, "thousands_sep", 13, + newSVpv(lcbuf->thousands_sep, 0), 0); +#ifndef NO_LOCALECONV_GROUPING + if (lcbuf->grouping && *lcbuf->grouping) + hv_store(RETVAL, "grouping", 8, + newSVpv(lcbuf->grouping, 0), 0); +#endif + if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol) + hv_store(RETVAL, "int_curr_symbol", 15, + newSVpv(lcbuf->int_curr_symbol, 0), 0); + if (lcbuf->currency_symbol && *lcbuf->currency_symbol) + hv_store(RETVAL, "currency_symbol", 15, + newSVpv(lcbuf->currency_symbol, 0), 0); + if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point) + hv_store(RETVAL, "mon_decimal_point", 17, + newSVpv(lcbuf->mon_decimal_point, 0), 0); +#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP + if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) + hv_store(RETVAL, "mon_thousands_sep", 17, + newSVpv(lcbuf->mon_thousands_sep, 0), 0); +#endif +#ifndef NO_LOCALECONV_MON_GROUPING + if (lcbuf->mon_grouping && *lcbuf->mon_grouping) + hv_store(RETVAL, "mon_grouping", 12, + newSVpv(lcbuf->mon_grouping, 0), 0); +#endif + if (lcbuf->positive_sign && *lcbuf->positive_sign) + hv_store(RETVAL, "positive_sign", 13, + newSVpv(lcbuf->positive_sign, 0), 0); + if (lcbuf->negative_sign && *lcbuf->negative_sign) + hv_store(RETVAL, "negative_sign", 13, + newSVpv(lcbuf->negative_sign, 0), 0); + /* the integers */ + if (lcbuf->int_frac_digits != CHAR_MAX) + hv_store(RETVAL, "int_frac_digits", 15, + newSViv(lcbuf->int_frac_digits), 0); + if (lcbuf->frac_digits != CHAR_MAX) + hv_store(RETVAL, "frac_digits", 11, + newSViv(lcbuf->frac_digits), 0); + if (lcbuf->p_cs_precedes != CHAR_MAX) + hv_store(RETVAL, "p_cs_precedes", 13, + newSViv(lcbuf->p_cs_precedes), 0); + if (lcbuf->p_sep_by_space != CHAR_MAX) + hv_store(RETVAL, "p_sep_by_space", 14, + newSViv(lcbuf->p_sep_by_space), 0); + if (lcbuf->n_cs_precedes != CHAR_MAX) + hv_store(RETVAL, "n_cs_precedes", 13, + newSViv(lcbuf->n_cs_precedes), 0); + if (lcbuf->n_sep_by_space != CHAR_MAX) + hv_store(RETVAL, "n_sep_by_space", 14, + newSViv(lcbuf->n_sep_by_space), 0); + if (lcbuf->p_sign_posn != CHAR_MAX) + hv_store(RETVAL, "p_sign_posn", 11, + newSViv(lcbuf->p_sign_posn), 0); + if (lcbuf->n_sign_posn != CHAR_MAX) + hv_store(RETVAL, "n_sign_posn", 11, + newSViv(lcbuf->n_sign_posn), 0); + } +#else + localeconv(); /* A stub to call not_here(). */ +#endif + OUTPUT: + RETVAL + +char * +setlocale(category, locale = 0) + int category + char * locale + CODE: + RETVAL = setlocale(category, locale); + if (RETVAL) { +#ifdef USE_LOCALE_CTYPE + if (category == LC_CTYPE +#ifdef LC_ALL + || category == LC_ALL +#endif + ) + { + char *newctype; +#ifdef LC_ALL + if (category == LC_ALL) + newctype = setlocale(LC_CTYPE, NULL); + else +#endif + newctype = RETVAL; + perl_new_ctype(newctype); + } +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE + if (category == LC_COLLATE +#ifdef LC_ALL + || category == LC_ALL +#endif + ) + { + char *newcoll; +#ifdef LC_ALL + if (category == LC_ALL) + newcoll = setlocale(LC_COLLATE, NULL); + else +#endif + newcoll = RETVAL; + perl_new_collate(newcoll); + } +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC + if (category == LC_NUMERIC +#ifdef LC_ALL + || category == LC_ALL +#endif + ) + { + char *newnum; +#ifdef LC_ALL + if (category == LC_ALL) + newnum = setlocale(LC_NUMERIC, NULL); + else +#endif + newnum = RETVAL; + perl_new_numeric(newnum); + } +#endif /* USE_LOCALE_NUMERIC */ + } + OUTPUT: + RETVAL + + +double +acos(x) + double x + +double +asin(x) + double x + +double +atan(x) + double x + +double +ceil(x) + double x + +double +cosh(x) + double x + +double +floor(x) + double x + +double +fmod(x,y) + double x + double y + +void +frexp(x) + double x + PPCODE: + int expvar; + /* (We already know stack is long enough.) */ + PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); + PUSHs(sv_2mortal(newSViv(expvar))); + +double +ldexp(x,exp) + double x + int exp + +double +log10(x) + double x + +void +modf(x) + double x + PPCODE: + double intvar; + /* (We already know stack is long enough.) */ + PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); + PUSHs(sv_2mortal(newSVnv(intvar))); + +double +sinh(x) + double x + +double +tan(x) + double x + +double +tanh(x) + double x + +SysRet +sigaction(sig, action, oldaction = 0) + int sig + POSIX::SigAction action + POSIX::SigAction oldaction + CODE: +#ifdef WIN32 + RETVAL = not_here("sigaction"); +#else +# This code is really grody because we're trying to make the signal +# interface look beautiful, which is hard. + + if (!PL_siggv) + gv_fetchpv("SIG", TRUE, SVt_PVHV); + + { + struct sigaction act; + struct sigaction oact; + POSIX__SigSet sigset; + SV** svp; + SV** sigsvp = hv_fetch(GvHVn(PL_siggv), + sig_name[sig], + strlen(sig_name[sig]), + TRUE); + + /* Remember old handler name if desired. */ + if (oldaction) { + char *hand = SvPVx(*sigsvp, PL_na); + svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); + sv_setpv(*svp, *hand ? hand : "DEFAULT"); + } + + if (action) { + /* Vector new handler through %SIG. (We always use sighandler + for the C signal handler, which reads %SIG to dispatch.) */ + svp = hv_fetch(action, "HANDLER", 7, FALSE); + if (!svp) + croak("Can't supply an action without a HANDLER"); + sv_setpv(*sigsvp, SvPV(*svp, PL_na)); + mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ + act.sa_handler = sighandler; + + /* Set up any desired mask. */ + svp = hv_fetch(action, "MASK", 4, FALSE); + if (svp && sv_isa(*svp, "POSIX::SigSet")) { + unsigned long tmp; + tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); + sigset = (sigset_t*) tmp; + act.sa_mask = *sigset; + } + else + sigemptyset(& act.sa_mask); + + /* Set up any desired flags. */ + svp = hv_fetch(action, "FLAGS", 5, FALSE); + act.sa_flags = svp ? SvIV(*svp) : 0; + } + + /* Now work around sigaction oddities */ + if (action && oldaction) + RETVAL = sigaction(sig, & act, & oact); + else if (action) + RETVAL = sigaction(sig, & act, (struct sigaction *)0); + else if (oldaction) + RETVAL = sigaction(sig, (struct sigaction *)0, & oact); + else + RETVAL = -1; + + if (oldaction) { + /* Get back the mask. */ + svp = hv_fetch(oldaction, "MASK", 4, TRUE); + if (sv_isa(*svp, "POSIX::SigSet")) { + unsigned long tmp; + tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); + sigset = (sigset_t*) tmp; + } + else { + sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); + sv_setptrobj(*svp, sigset, "POSIX::SigSet"); + } + *sigset = oact.sa_mask; + + /* Get back the flags. */ + svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); + sv_setiv(*svp, oact.sa_flags); + } + } +#endif + OUTPUT: + RETVAL + +SysRet +sigpending(sigset) + POSIX::SigSet sigset + +SysRet +sigprocmask(how, sigset, oldsigset = 0) + int how + POSIX::SigSet sigset + POSIX::SigSet oldsigset + +SysRet +sigsuspend(signal_mask) + POSIX::SigSet signal_mask + +void +_exit(status) + int status + +SysRet +close(fd) + int fd + +SysRet +dup(fd) + int fd + +SysRet +dup2(fd1, fd2) + int fd1 + int fd2 + +SysRetLong +lseek(fd, offset, whence) + int fd + Off_t offset + int whence + +SysRet +nice(incr) + int incr + +int +pipe() + PPCODE: + int fds[2]; + if (pipe(fds) != -1) { + EXTEND(SP,2); + PUSHs(sv_2mortal(newSViv(fds[0]))); + PUSHs(sv_2mortal(newSViv(fds[1]))); + } + +SysRet +read(fd, buffer, nbytes) + PREINIT: + SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); + INPUT: + int fd + size_t nbytes + char * buffer = sv_grow( sv_buffer, nbytes+1 ); + CLEANUP: + if (RETVAL >= 0) { + SvCUR(sv_buffer) = RETVAL; + SvPOK_only(sv_buffer); + *SvEND(sv_buffer) = '\0'; + SvTAINTED_on(sv_buffer); + } + +SysRet +setpgid(pid, pgid) + pid_t pid + pid_t pgid + +pid_t +setsid() + +pid_t +tcgetpgrp(fd) + int fd + +SysRet +tcsetpgrp(fd, pgrp_id) + int fd + pid_t pgrp_id + +int +uname() + PPCODE: +#ifdef HAS_UNAME + struct utsname buf; + if (uname(&buf) >= 0) { + EXTEND(SP, 5); + PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); + PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); + PUSHs(sv_2mortal(newSVpv(buf.release, 0))); + PUSHs(sv_2mortal(newSVpv(buf.version, 0))); + PUSHs(sv_2mortal(newSVpv(buf.machine, 0))); + } +#else + uname((char *) 0); /* A stub to call not_here(). */ +#endif + +SysRet +write(fd, buffer, nbytes) + int fd + char * buffer + size_t nbytes + +char * +tmpnam(s = 0) + char * s = 0; + +void +abort() + +int +mblen(s, n) + char * s + size_t n + +size_t +mbstowcs(s, pwcs, n) + wchar_t * s + char * pwcs + size_t n + +int +mbtowc(pwc, s, n) + wchar_t * pwc + char * s + size_t n + +int +wcstombs(s, pwcs, n) + char * s + wchar_t * pwcs + size_t n + +int +wctomb(s, wchar) + char * s + wchar_t wchar + +int +strcoll(s1, s2) + char * s1 + char * s2 + +void +strtod(str) + char * str + PREINIT: + double num; + char *unparsed; + PPCODE: + SET_NUMERIC_LOCAL(); + num = strtod(str, &unparsed); + PUSHs(sv_2mortal(newSVnv(num))); + if (GIMME == G_ARRAY) { + EXTEND(SP, 1); + if (unparsed) + PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); + else + PUSHs(&PL_sv_undef); + } + +void +strtol(str, base = 0) + char * str + int base + PREINIT: + long num; + char *unparsed; + PPCODE: + num = strtol(str, &unparsed, base); + if (num >= IV_MIN && num <= IV_MAX) + PUSHs(sv_2mortal(newSViv((IV)num))); + else + PUSHs(sv_2mortal(newSVnv((double)num))); + if (GIMME == G_ARRAY) { + EXTEND(SP, 1); + if (unparsed) + PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); + else + PUSHs(&PL_sv_undef); + } + +void +strtoul(str, base = 0) + char * str + int base + PREINIT: + unsigned long num; + char *unparsed; + PPCODE: + num = strtoul(str, &unparsed, base); + if (num <= IV_MAX) + PUSHs(sv_2mortal(newSViv((IV)num))); + else + PUSHs(sv_2mortal(newSVnv((double)num))); + if (GIMME == G_ARRAY) { + EXTEND(SP, 1); + if (unparsed) + PUSHs(sv_2mortal(newSViv(strlen(unparsed)))); + else + PUSHs(&PL_sv_undef); + } + +SV * +strxfrm(src) + SV * src + CODE: + { + STRLEN srclen; + STRLEN dstlen; + char *p = SvPV(src,srclen); + srclen++; + ST(0) = sv_2mortal(NEWSV(800,srclen)); + dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen); + if (dstlen > srclen) { + dstlen++; + SvGROW(ST(0), dstlen); + strxfrm(SvPVX(ST(0)), p, (size_t)dstlen); + dstlen--; + } + SvCUR(ST(0)) = dstlen; + SvPOK_only(ST(0)); + } + +SysRet +mkfifo(filename, mode) + char * filename + Mode_t mode + CODE: + TAINT_PROPER("mkfifo"); + RETVAL = mkfifo(filename, mode); + OUTPUT: + RETVAL + +SysRet +tcdrain(fd) + int fd + + +SysRet +tcflow(fd, action) + int fd + int action + + +SysRet +tcflush(fd, queue_selector) + int fd + int queue_selector + +SysRet +tcsendbreak(fd, duration) + int fd + int duration + +char * +asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + struct tm mytm; + init_tm(&mytm); /* XXX workaround - see init_tm() above */ + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + RETVAL = asctime(&mytm); + } + OUTPUT: + RETVAL + +long +clock() + +char * +ctime(time) + Time_t &time + +void +times() + PPCODE: + struct tms tms; + clock_t realtime; + realtime = times( &tms ); + EXTEND(SP,5); + PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) ); + PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) ); + +double +difftime(time1, time2) + Time_t time1 + Time_t time2 + +SysRetLong +mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + struct tm mytm; + init_tm(&mytm); /* XXX workaround - see init_tm() above */ + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + RETVAL = mktime(&mytm); + } + OUTPUT: + RETVAL + +char * +strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + char * fmt + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + char tmpbuf[128]; + struct tm mytm; + int len; + init_tm(&mytm); /* XXX workaround - see init_tm() above */ + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } + +void +tzset() + +void +tzname() + PPCODE: + EXTEND(SP,2); + PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0])))); + PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1])))); + +SysRet +access(filename, mode) + char * filename + Mode_t mode + +char * +ctermid(s = 0) + char * s = 0; + +char * +cuserid(s = 0) + char * s = 0; + +SysRetLong +fpathconf(fd, name) + int fd + int name + +SysRetLong +pathconf(filename, name) + char * filename + int name + +SysRet +pause() + +SysRetLong +sysconf(name) + int name + +char * +ttyname(fd) + int fd diff --git a/contrib/perl5/ext/POSIX/hints/bsdos.pl b/contrib/perl5/ext/POSIX/hints/bsdos.pl new file mode 100644 index 00000000000..62732ac7b9d --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/bsdos.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/contrib/perl5/ext/POSIX/hints/freebsd.pl b/contrib/perl5/ext/POSIX/hints/freebsd.pl new file mode 100644 index 00000000000..62732ac7b9d --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/freebsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/contrib/perl5/ext/POSIX/hints/linux.pl b/contrib/perl5/ext/POSIX/hints/linux.pl new file mode 100644 index 00000000000..f1d19814ae1 --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/linux.pl @@ -0,0 +1,5 @@ +# libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined. +# Thanks to Bart Schuller +# See Message-ID: <19971009002636.50729@tanglefoot> +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DHINT_SC_EXIST' ; diff --git a/contrib/perl5/ext/POSIX/hints/netbsd.pl b/contrib/perl5/ext/POSIX/hints/netbsd.pl new file mode 100644 index 00000000000..62732ac7b9d --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/netbsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/contrib/perl5/ext/POSIX/hints/next_3.pl b/contrib/perl5/ext/POSIX/hints/next_3.pl new file mode 100644 index 00000000000..d90778398b2 --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/next_3.pl @@ -0,0 +1,5 @@ +# NeXT *does* have setpgid when we use the -posix flag, but +# doesn't when we don't. The main perl sources are compiled +# without -posix, so the hints/next_3.sh hint file tells Configure +# that d_setpgid=undef. +$self->{CCFLAGS} = $Config{ccflags} . ' -posix -DHAS_SETPGID' ; diff --git a/contrib/perl5/ext/POSIX/hints/openbsd.pl b/contrib/perl5/ext/POSIX/hints/openbsd.pl new file mode 100644 index 00000000000..62732ac7b9d --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/openbsd.pl @@ -0,0 +1,3 @@ +# BSD platforms have extra fields in struct tm that need to be initialized. +# XXX A Configure test is needed. +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE' ; diff --git a/contrib/perl5/ext/POSIX/hints/sunos_4.pl b/contrib/perl5/ext/POSIX/hints/sunos_4.pl new file mode 100644 index 00000000000..32b3558a5e8 --- /dev/null +++ b/contrib/perl5/ext/POSIX/hints/sunos_4.pl @@ -0,0 +1,10 @@ +# SunOS 4.1.3 has two extra fields in struct tm. This works around +# the problem. Other BSD platforms may have similar problems. +# This state of affairs also persists in glibc2, found +# on linux systems running libc6. +# XXX A Configure test is needed. + +# Although is inappropriate in general for SunOS, we need it +# in POSIX.xs to get the correct prototype for ttyname(). + +$self->{CCFLAGS} = $Config{ccflags} . ' -DSTRUCT_TM_HASZONE -DI_UNISTD' ; diff --git a/contrib/perl5/ext/POSIX/typemap b/contrib/perl5/ext/POSIX/typemap new file mode 100644 index 00000000000..63e41c77bf1 --- /dev/null +++ b/contrib/perl5/ext/POSIX/typemap @@ -0,0 +1,14 @@ +Mode_t T_NV +pid_t T_NV +Uid_t T_NV +Time_t T_NV +Gid_t T_NV +Off_t T_NV +Dev_t T_NV +fd T_IV +speed_t T_IV +tcflag_t T_IV +cc_t T_IV +POSIX::SigSet T_PTROBJ +POSIX::Termios T_PTROBJ +POSIX::SigAction T_HVREF diff --git a/contrib/perl5/ext/SDBM_File/Makefile.PL b/contrib/perl5/ext/SDBM_File/Makefile.PL new file mode 100644 index 00000000000..b639b2948f1 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/Makefile.PL @@ -0,0 +1,35 @@ +use ExtUtils::MakeMaker; + +# The existence of the ./sdbm/Makefile.PL file causes MakeMaker +# to automatically include Makefile code for the targets +# config, all, clean, realclean and sdbm/Makefile +# which perform the corresponding actions in the subdirectory. + +$define = ($^O eq 'MSWin32') ? '-DMSDOS' : ''; +if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; } +else { $myextlib = 'sdbm/libsdbm$(LIB_EXT)'; } + +WriteMakefile( + NAME => 'SDBM_File', + MYEXTLIB => $myextlib, + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'SDBM_File.pm', + DEFINE => $define, + ); + +sub MY::postamble { + if ($^O ne 'VMS') { + ' +$(MYEXTLIB): sdbm/Makefile + cd sdbm && $(MAKE) all +'; + } else { + ' +$(MYEXTLIB) : [.sdbm]descrip.mms + set def [.sdbm] + $(MMS) all + set def [-] +'; + } +} diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.pm b/contrib/perl5/ext/SDBM_File/SDBM_File.pm new file mode 100644 index 00000000000..a2d4df85587 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.pm @@ -0,0 +1,35 @@ +package SDBM_File; + +use strict; +use vars qw($VERSION @ISA); + +require Tie::Hash; +require DynaLoader; + +@ISA = qw(Tie::Hash DynaLoader); + +$VERSION = "1.00" ; + +bootstrap SDBM_File $VERSION; + +1; + +__END__ + +=head1 NAME + +SDBM_File - Tied access to sdbm files + +=head1 SYNOPSIS + + use SDBM_File; + + tie(%h, 'SDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + + untie %h; + +=head1 DESCRIPTION + +See L + +=cut diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.xs b/contrib/perl5/ext/SDBM_File/SDBM_File.xs new file mode 100644 index 00000000000..38eaebf5c5e --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.xs @@ -0,0 +1,71 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "sdbm/sdbm.h" + +typedef DBM* SDBM_File; +#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) +#define sdbm_FETCH(db,key) sdbm_fetch(db,key) +#define sdbm_STORE(db,key,value,flags) sdbm_store(db,key,value,flags) +#define sdbm_DELETE(db,key) sdbm_delete(db,key) +#define sdbm_FIRSTKEY(db) sdbm_firstkey(db) +#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db) + + +MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ + +SDBM_File +sdbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +sdbm_DESTROY(db) + SDBM_File db + CODE: + sdbm_close(db); + +datum +sdbm_FETCH(db, key) + SDBM_File db + datum key + +int +sdbm_STORE(db, key, value, flags = DBM_REPLACE) + SDBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to sdbm file"); + croak("sdbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + sdbm_clearerr(db); + } + +int +sdbm_DELETE(db, key) + SDBM_File db + datum key + +datum +sdbm_FIRSTKEY(db) + SDBM_File db + +datum +sdbm_NEXTKEY(db, key) + SDBM_File db + datum key + +int +sdbm_error(db) + SDBM_File db + +int +sdbm_clearerr(db) + SDBM_File db + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/CHANGES b/contrib/perl5/ext/SDBM_File/sdbm/CHANGES new file mode 100644 index 00000000000..f7296d1b3aa --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/CHANGES @@ -0,0 +1,18 @@ +Changes from the earlier BETA releases. + +o dbm_prep does everything now, so dbm_open is just a simple + wrapper that builds the default filenames. dbm_prep no longer + requires a (DBM *) db parameter: it allocates one itself. It + returns (DBM *) db or (DBM *) NULL. + +o makroom is now reliable. In the common-case optimization of the page + split, the page into which the incoming key/value pair is to be inserted + is write-deferred (if the split is successful), thereby saving a cosly + write. BUT, if the split does not make enough room (unsuccessful), the + deferred page is written out, as the failure-window is now dependent on + the number of split attempts. + +o if -DDUFF is defined, hash function will also use the DUFF construct. + This may look like a micro-performance tweak (maybe it is), but in fact, + the hash function is the third most-heavily used function, after read + and write. diff --git a/contrib/perl5/ext/SDBM_File/sdbm/COMPARE b/contrib/perl5/ext/SDBM_File/sdbm/COMPARE new file mode 100644 index 00000000000..a595e831d26 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/COMPARE @@ -0,0 +1,88 @@ + +Script started on Thu Sep 28 15:41:06 1989 +% uname -a +titan titan 4_0 UMIPS mips +% make all x-dbm + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbm.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c sdbm.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c pair.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c hash.c + ar cr libsdbm.a sdbm.o pair.o hash.o + ranlib libsdbm.a + cc -o dbm dbm.o libsdbm.a + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dba.c + cc -o dba dba.o + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbd.c + cc -o dbd dbd.o + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -o x-dbm dbm.o +% +% +% wc history + 65110 218344 3204883 history +% +% /bin/time dbm build foo 'sdbm', # (doesn't matter what the name is here) oh yes it does +# LINKTYPE => 'static', + DEFINE => $define, + INC => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's + INST_ARCHLIB => '.', + SKIP => [qw(dynamic dynamic_lib dlsyms)], + OBJECT => '$(O_FILES)', + clean => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'}, + H => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)], + C => [qw(sdbm.c pair.c hash.c)] +); + +sub MY::constants { + package MY; + my $r = shift->SUPER::constants(); + if ($^O eq 'VMS') { + $r =~ s/^INST_STATIC =.*$/INST_STATIC = libsdbm\$(LIB_EXT)/m + } + return $r; +} + +sub MY::post_constants { + package MY; + if ($^O eq 'VMS') { + shift->SUPER::post_constants(); + } else { +' +INST_STATIC = libsdbm$(LIB_EXT) +' + } +} + +sub MY::top_targets { + my $r = ' +all :: static + $(NOECHO) $(NOOP) + +config :: + $(NOECHO) $(NOOP) + +lint: + lint -abchx $(LIBSRCS) + +'; + $r .= ' +# This is a workaround, the problem is that our old GNU make exports +# variables into the environment so $(MYEXTLIB) is set in here to this +# value which can not be built. +sdbm/libsdbm.a: + $(NOECHO) $(NOOP) +' unless $^O eq 'VMS'; + + return $r; +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/README b/contrib/perl5/ext/SDBM_File/sdbm/README new file mode 100644 index 00000000000..cd7312cc575 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/README @@ -0,0 +1,396 @@ + + + + + + + sdbm - Substitute DBM + or + Berkeley ndbm for Every UN*X[1] Made Simple + + Ozan (oz) Yigit + + The Guild of PD Software Toolmakers + Toronto - Canada + + oz@nexus.yorku.ca + + + +Implementation is the sincerest form of flattery. - L. Peter +Deutsch + +A The Clone of the ndbm library + + The sources accompanying this notice - sdbm - consti- +tute the first public release (Dec. 1990) of a complete +clone of the Berkeley UN*X ndbm library. The sdbm library is +meant to clone the proven functionality of ndbm as closely +as possible, including a few improvements. It is practical, +easy to understand, and compatible. The sdbm library is not +derived from any licensed, proprietary or copyrighted +software. + + The sdbm implementation is based on a 1978 algorithm +[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +In the course of searching for a substitute for ndbm, I pro- +totyped three different external-hashing algorithms [Lar78, +Fag79, Lit80] and ultimately chose Larson's algorithm as a +basis of the sdbm implementation. The Bell Labs dbm (and +therefore ndbm) is based on an algorithm invented by Ken +Thompson, [Tho90, Tor87] and predates Larson's work. + + The sdbm programming interface is totally compatible +with ndbm and includes a slight improvement in database ini- +tialization. It is also expected to be binary-compatible +under most UN*X versions that support the ndbm library. + + The sdbm implementation shares the shortcomings of the +ndbm library, as a side effect of various simplifications to +the original Larson algorithm. It does produce holes in the +page file as it writes pages past the end of file. (Larson's +paper include a clever solution to this problem that is a +result of using the hash value directly as a block address.) +On the other hand, extensive tests seem to indicate that +sdbm creates fewer holes in general, and the resulting page- +files are smaller. The sdbm implementation is also faster +than ndbm in database creation. Unlike the ndbm, the sdbm +_________________________ + + [1] UN*X is not a trademark of any (dis)organization. + + + + + + + + + + - 2 - + + +store operation will not ``wander away'' trying to split its +data pages to insert a datum that cannot (due to elaborate +worst-case situations) be inserted. (It will fail after a +pre-defined number of attempts.) + +Important Compatibility Warning + + The sdbm and ndbm libraries cannot share databases: one +cannot read the (dir/pag) database created by the other. +This is due to the differences between the ndbm and sdbm +algorithms[2], and the hash functions used. It is easy to +convert between the dbm/ndbm databases and sdbm by ignoring +the index completely: see dbd, dbu etc. + + +Notice of Intellectual Property + +The entire sdbm library package, as authored by me, Ozan S. +Yigit, is hereby placed in the public domain. As such, the +author is not responsible for the consequences of use of +this software, no matter how awful, even if they arise from +defects in it. There is no expressed or implied warranty for +the sdbm library. + + Since the sdbm library package is in the public domain, +this original release or any additional public-domain +releases of the modified original cannot possibly (by defin- +ition) be withheld from you. Also by definition, You (singu- +lar) have all the rights to this code (including the right +to sell without permission, the right to hoard[3] and the +right to do other icky things as you see fit) but those +rights are also granted to everyone else. + + Please note that all previous distributions of this +software contained a copyright (which is now dropped) to +protect its origins and its current public domain status +against any possible claims and/or challenges. + +Acknowledgments + + Many people have been very helpful and supportive. A +partial list would necessarily include Rayan Zacherissen +(who contributed the man page, and also hacked a MMAP +_________________________ + + [2] Torek's discussion [Tor87] indicates that +dbm/ndbm implementations use the hash value to traverse +the radix trie differently than sdbm and as a result, +the page indexes are generated in different order. For +more information, send e-mail to the author. + [3] You cannot really hoard something that is avail- +able to the public at large, but try if it makes you +feel any better. + + + + + + + + + + + - 3 - + + +version of sdbm), Arnold Robbins, Chris Lewis, Bill David- +sen, Henry Spencer, Geoff Collyer, Rich Salz (who got me +started in the first place), Johannes Ruschein (who did the +minix port) and David Tilbrook. I thank you all. + +Distribution Manifest and Notes + +This distribution of sdbm includes (at least) the following: + + CHANGES change log + README this file. + biblio a small bibliography on external hashing + dba.c a crude (n/s)dbm page file analyzer + dbd.c a crude (n/s)dbm page file dumper (for conversion) + dbe.1 man page for dbe.c + dbe.c Janick's database editor + dbm.c a dbm library emulation wrapper for ndbm/sdbm + dbm.h header file for the above + dbu.c a crude db management utility + hash.c hashing function + makefile guess. + pair.c page-level routines (posted earlier) + pair.h header file for the above + readme.ms troff source for the README file + sdbm.3 man page + sdbm.c the real thing + sdbm.h header file for the above + tune.h place for tuning & portability thingies + util.c miscellaneous + + dbu is a simple database manipulation program[4] that +tries to look like Bell Labs' cbt utility. It is currently +incomplete in functionality. I use dbu to test out the rou- +tines: it takes (from stdin) tab separated key/value pairs +for commands like build or insert or takes keys for commands +like delete or look. + + dbu dbmfile + + dba is a crude analyzer of dbm/sdbm/ndbm page files. It +scans the entire page file, reporting page level statistics, +and totals at the end. + + dbd is a crude dump program for dbm/ndbm/sdbm data- +bases. It ignores the bitmap, and dumps the data pages in +sequence. It can be used to create input for the dbu util- +ity. Note that dbd will skip any NULLs in the key and data +fields, thus is unsuitable to convert some peculiar +_________________________ + + [4] The dbd, dba, dbu utilities are quick hacks and +are not fit for production use. They were developed +late one night, just to test out sdbm, and convert some +databases. + + + + + + + + + + - 4 - + + +databases that insist in including the terminating null. + + I have also included a copy of the dbe (ndbm DataBase +Editor) by Janick Bergeron [janick@bnr.ca] for your pleas- +ure. You may find it more useful than the little dbu util- +ity. + + dbm.[ch] is a dbm library emulation on top of ndbm (and +hence suitable for sdbm). Written by Robert Elz. + + The sdbm library has been around in beta test for quite +a long time, and from whatever little feedback I received +(maybe no news is good news), I believe it has been func- +tioning without any significant problems. I would, of +course, appreciate all fixes and/or improvements. Portabil- +ity enhancements would especially be useful. + +Implementation Issues + + Hash functions: The algorithm behind sdbm implementa- +tion needs a good bit-scrambling hash function to be effec- +tive. I ran into a set of constants for a simple hash func- +tion that seem to help sdbm perform better than ndbm for +various inputs: + + /* + * polynomial conversion ignoring overflows + * 65599 nice. 65587 even better. + */ + long + dbm_hash(char *str, int len) { + register unsigned long n = 0; + + while (len--) + n = n * 65599 + *str++; + return n; + } + + There may be better hash functions for the purposes of +dynamic hashing. Try your favorite, and check the pagefile. +If it contains too many pages with too many holes, (in rela- +tion to this one for example) or if sdbm simply stops work- +ing (fails after SPLTMAX attempts to split) when you feed +your NEWS history file to it, you probably do not have a +good hashing function. If you do better (for different +types of input), I would like to know about the function you +use. + + Block sizes: It seems (from various tests on a few +machines) that a page file block size PBLKSIZ of 1024 is by +far the best for performance, but this also happens to limit +the size of a key/value pair. Depending on your needs, you +may wish to increase the page size, and also adjust PAIRMAX +(the maximum size of a key/value pair allowed: should always + + + + + + + + + + - 5 - + + +be at least three words smaller than PBLKSIZ.) accordingly. +The system-wide version of the library should probably be +configured with 1024 (distribution default), as this appears +to be sufficient for most common uses of sdbm. + +Portability + + This package has been tested in many different UN*Xes +even including minix, and appears to be reasonably portable. +This does not mean it will port easily to non-UN*X systems. + +Notes and Miscellaneous + + The sdbm is not a very complicated package, at least +not after you familiarize yourself with the literature on +external hashing. There are other interesting algorithms in +existence that ensure (approximately) single-read access to +a data value associated with any key. These are directory- +less schemes such as linear hashing [Lit80] (+ Larson varia- +tions), spiral storage [Mar79] or directory schemes such as +extensible hashing [Fag79] by Fagin et al. I do hope these +sources provide a reasonable playground for experimentation +with other algorithms. See the June 1988 issue of ACM Com- +puting Surveys [Enb88] for an excellent overview of the +field. + +References + + +[Lar78] + P.-A. Larson, ``Dynamic Hashing'', BIT, vol. 18, pp. + 184-201, 1978. + +[Tho90] + Ken Thompson, private communication, Nov. 1990 + +[Lit80] + W. Litwin, `` Linear Hashing: A new tool for file and + table addressing'', Proceedings of the 6th Conference on + Very Large Dabatases (Montreal), pp. 212-223, Very + Large Database Foundation, Saratoga, Calif., 1980. + +[Fag79] + R. Fagin, J. Nievergelt, N. Pippinger, and H. R. + Strong, ``Extendible Hashing - A Fast Access Method for + Dynamic Files'', ACM Trans. Database Syst., vol. 4, + no.3, pp. 315-344, Sept. 1979. + +[Wal84] + Rich Wales, ``Discussion of "dbm" data base system'', + USENET newsgroup unix.wizards, Jan. 1984. + +[Tor87] + Chris Torek, ``Re: dbm.a and ndbm.a archives'', + + + + + + + + + + - 6 - + + + USENET newsgroup comp.unix, 1987. + +[Mar79] + G. N. Martin, ``Spiral Storage: Incrementally Augment- + able Hash Addressed Storage'', Technical Report #27, + University of Varwick, Coventry, U.K., 1979. + +[Enb88] + R. J. Enbody and H. C. Du, ``Dynamic Hashing + Schemes'',ACM Computing Surveys, vol. 20, no. 2, pp. + 85-113, June 1988. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/README.too b/contrib/perl5/ext/SDBM_File/sdbm/README.too new file mode 100644 index 00000000000..c2d095944da --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/README.too @@ -0,0 +1,9 @@ +This version of sdbm merely has all the dbm_* names translated to sdbm_* +so that we can link ndbm and sdbm into the same executable. (It also has +the bad() macro redefined to allow a zero-length key.) + + +Fri Apr 15 10:15:30 EDT 1994. + +Additional portability/configuration changes for libsdbm by Andy Dougherty +doughera@lafcol.lafayette.edu. diff --git a/contrib/perl5/ext/SDBM_File/sdbm/biblio b/contrib/perl5/ext/SDBM_File/sdbm/biblio new file mode 100644 index 00000000000..0be09fa005b --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/biblio @@ -0,0 +1,64 @@ +%A R. J. Enbody +%A H. C. Du +%T Dynamic Hashing Schemes +%J ACM Computing Surveys +%V 20 +%N 2 +%D June 1988 +%P 85-113 +%K surveys + +%A P.-A. Larson +%T Dynamic Hashing +%J BIT +%V 18 +%P 184-201 +%D 1978 +%K dynamic + +%A W. Litwin +%T Linear Hashing: A new tool for file and table addressing +%J Proceedings of the 6th Conference on Very Large Dabatases (Montreal) +%I Very Large Database Foundation +%C Saratoga, Calif. +%P 212-223 +%D 1980 +%K linear + +%A R. Fagin +%A J. Nievergelt +%A N. Pippinger +%A H. R. Strong +%T Extendible Hashing - A Fast Access Method for Dynamic Files +%J ACM Trans. Database Syst. +%V 4 +%N 3 +%D Sept. 1979 +%P 315-344 +%K extend + +%A G. N. Martin +%T Spiral Storage: Incrementally Augmentable Hash Addressed Storage +%J Technical Report #27 +%I University of Varwick +%C Coventry, U.K. +%D 1979 +%K spiral + +%A Chris Torek +%T Re: dbm.a and ndbm.a archives +%B USENET newsgroup comp.unix +%D 1987 +%K torek + +%A Rich Wales +%T Discusson of "dbm" data base system +%B USENET newsgroup unix.wizards +%D Jan. 1984 +%K rich + + + + + + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dba.c b/contrib/perl5/ext/SDBM_File/sdbm/dba.c new file mode 100644 index 00000000000..05e70c8961c --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dba.c @@ -0,0 +1,85 @@ +/* + * dba dbm analysis/recovery + */ + +#include +#include +#include "EXTERN.h" +#include "sdbm.h" + +char *progname; +extern void oops(); + +int +main(argc, argv) +char **argv; +{ + int n; + char *p; + char *name; + int pagf; + + progname = argv[0]; + + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + strcpy(name, p); + strcpy(name + n, ".pag"); + + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); + + sdump(pagf); + } + else + oops("usage: %s dbname", progname); + + return 0; +} + +sdump(pagf) +int pagf; +{ + register b; + register n = 0; + register t = 0; + register o = 0; + register e; + char pag[PBLKSIZ]; + + while ((b = read(pagf, pag, PBLKSIZ)) > 0) { + printf("#%d: ", n); + if (!okpage(pag)) + printf("bad\n"); + else { + printf("ok. "); + if (!(e = pagestat(pag))) + o++; + else + t += e; + } + n++; + } + + if (b == 0) + printf("%d pages (%d holes): %d entries\n", n, o, t); + else + oops("read failed: block %d", n); +} + +pagestat(pag) +char *pag; +{ + register n; + register free; + register short *ino = (short *) pag; + + if (!(n = ino[0])) + printf("no entries.\n"); + else { + free = ino[n] - (n + 1) * sizeof(short); + printf("%3d entries %2d%% used free %d.\n", + n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); + } + return n / 2; +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbd.c b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c new file mode 100644 index 00000000000..04ab842e2d6 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c @@ -0,0 +1,111 @@ +/* + * dbd - dump a dbm data file + */ + +#include +#include +#include "EXTERN.h" +#include "sdbm.h" + +char *progname; +extern void oops(); + + +#define empty(page) (((short *) page)[0] == 0) + +int +main(argc, argv) +char **argv; +{ + int n; + char *p; + char *name; + int pagf; + + progname = argv[0]; + + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + strcpy(name, p); + strcpy(name + n, ".pag"); + + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); + + sdump(pagf); + } + else + oops("usage: %s dbname", progname); + return 0; +} + +sdump(pagf) +int pagf; +{ + register r; + register n = 0; + register o = 0; + char pag[PBLKSIZ]; + + while ((r = read(pagf, pag, PBLKSIZ)) > 0) { + if (!okpage(pag)) + fprintf(stderr, "%d: bad page.\n", n); + else if (empty(pag)) + o++; + else + dispage(pag); + n++; + } + + if (r == 0) + fprintf(stderr, "%d pages (%d holes).\n", n, o); + else + oops("read failed: block %d", n); +} + + +#ifdef OLD +dispage(pag) +char *pag; +{ + register i, n; + register off; + register short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + printf("\t[%d]: ", ino[i]); + for (n = ino[i]; n < off; n++) + putchar(pag[n]); + putchar(' '); + off = ino[i]; + printf("[%d]: ", ino[i + 1]); + for (n = ino[i + 1]; n < off; n++) + putchar(pag[n]); + off = ino[i + 1]; + putchar('\n'); + } +} +#else +dispage(pag) +char *pag; +{ + register i, n; + register off; + register short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + for (n = ino[i]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\t'); + off = ino[i]; + for (n = ino[i + 1]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\n'); + off = ino[i + 1]; + } +} +#endif diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbe.1 b/contrib/perl5/ext/SDBM_File/sdbm/dbe.1 new file mode 100644 index 00000000000..3b32272684b --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbe.1 @@ -0,0 +1,46 @@ +.TH dbe 1 "ndbm(3) EDITOR" +.SH NAME +dbe \- Edit a ndbm(3) database +.SH USAGE +dbe [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [ []] +.SH DESCRIPTION +\fIdbme\fP operates on ndbm(3) databases. +It can be used to create them, look at them or change them. +When specifying the value of a key or the content of its associated entry, +\\nnn, \\0, \\n, \\t, \\f and \\r are interpreted as usual. +When displaying key/content pairs, non-printable characters are displayed +using the \\nnn notation. +.SH OPTIONS +.IP -a +List all entries in the database. +.IP -c +Create the database if it does not exist. +.IP -d +Delete the entry associated with the specified key. +.IP -f +Fetch and display the entry associated with the specified key. +.IP -F +Fetch and display all the entries whose key match the specified +regular-expression +.IP "-m r|w|rw" +Open the database in read-only, write-only or read-write mode +.IP -r +Replace the entry associated with the specified key if it already exists. +See option -s. +.IP -s +Store an entry under a specific key. +An error occurs if the key already exists and the option -r was not specified. +.IP -t +Re-initialize the database before executing the command. +.IP -v +Verbose mode. +Confirm stores and deletions. +.IP -x +If option -x is used with option -c, then if the database already exists, +an error occurs. +This can be used to implement a simple exclusive access locking mechanism. +.SH SEE ALSO +ndbm(3) +.SH AUTHOR +janick@bnr.ca + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbe.c b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c new file mode 100644 index 00000000000..2a306f276ec --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c @@ -0,0 +1,435 @@ +#include +#ifndef VMS +#include +#include +#else +#include "file.h" +#include "ndbm.h" +#endif +#include + +/***************************************************************************\ +** ** +** Function name: getopt() ** +** Author: Henry Spencer, UofT ** +** Coding date: 84/04/28 ** +** ** +** Description: ** +** ** +** Parses argv[] for arguments. ** +** Works with Whitesmith's C compiler. ** +** ** +** Inputs - The number of arguments ** +** - The base address of the array of arguments ** +** - A string listing the valid options (':' indicates an ** +** argument to the preceding option is required, a ';' ** +** indicates an argument to the preceding option is optional) ** +** ** +** Outputs - Returns the next option character, ** +** '?' for non '-' arguments ** +** or ':' when there is no more arguments. ** +** ** +** Side Effects + The argument to an option is pointed to by 'optarg' ** +** ** +***************************************************************************** +** ** +** REVISION HISTORY: ** +** ** +** DATE NAME DESCRIPTION ** +** YY/MM/DD ------------------ ------------------------------------ ** +** 88/10/20 Janick Bergeron Returns '?' on unamed arguments ** +** returns '!' on unknown options ** +** and 'EOF' only when exhausted. ** +** 88/11/18 Janick Bergeron Return ':' when no more arguments ** +** 89/08/11 Janick Bergeron Optional optarg when ';' in optstring ** +** ** +\***************************************************************************/ + +char *optarg; /* Global argument pointer. */ + +#ifdef VMS +#define index strchr +#endif + +char +getopt(argc, argv, optstring) +int argc; +char **argv; +char *optstring; +{ + register int c; + register char *place; + extern char *index(); + static int optind = 0; + static char *scan = NULL; + + optarg = NULL; + + if (scan == NULL || *scan == '\0') { + + if (optind == 0) + optind++; + if (optind >= argc) + return ':'; + + optarg = place = argv[optind++]; + if (place[0] != '-' || place[1] == '\0') + return '?'; + if (place[1] == '-' && place[2] == '\0') + return '?'; + scan = place + 1; + } + + c = *scan++; + place = index(optstring, c); + if (place == NULL || c == ':' || c == ';') { + + (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); + scan = NULL; + return '!'; + } + if (*++place == ':') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc) { + + (void) fprintf(stderr, "%s: %c requires an argument\n", + argv[0], c); + return '!'; + } + optarg = argv[optind]; + optind++; + } + } + else if (*place == ';') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc || *argv[optind] == '-') + optarg = NULL; + else { + optarg = argv[optind]; + optind++; + } + } + } + return c; +} + + +void +print_datum(db) +datum db; +{ + int i; + + putchar('"'); + for (i = 0; i < db.dsize; i++) { + if (isprint(db.dptr[i])) + putchar(db.dptr[i]); + else { + putchar('\\'); + putchar('0' + ((db.dptr[i] >> 6) & 0x07)); + putchar('0' + ((db.dptr[i] >> 3) & 0x07)); + putchar('0' + (db.dptr[i] & 0x07)); + } + } + putchar('"'); +} + + +datum +read_datum(s) +char *s; +{ + datum db; + char *p; + int i; + + db.dsize = 0; + db.dptr = (char *) malloc(strlen(s) * sizeof(char)); + for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { + if (*s == '\\') { + if (*++s == 'n') + *p = '\n'; + else if (*s == 'r') + *p = '\r'; + else if (*s == 'f') + *p = '\f'; + else if (*s == 't') + *p = '\t'; + else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) { + i = (*s++ - '0') << 6; + i |= (*s++ - '0') << 3; + i |= *s - '0'; + *p = i; + } + else if (*s == '0') + *p = '\0'; + else + *p = *s; + } + else + *p = *s; + } + + return db; +} + + +char * +key2s(db) +datum db; +{ + char *buf; + char *p1, *p2; + + buf = (char *) malloc((db.dsize + 1) * sizeof(char)); + for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); + *p1 = '\0'; + return buf; +} + + +main(argc, argv) +int argc; +char **argv; +{ + typedef enum { + YOW, FETCH, STORE, DELETE, SCAN, REGEXP + } commands; + char opt; + int flags; + int giveusage = 0; + int verbose = 0; + commands what = YOW; + char *comarg[3]; + int st_flag = DBM_INSERT; + int argn; + DBM *db; + datum key; + datum content; + + flags = O_RDWR; + argn = 0; + + while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { + switch (opt) { + case 'a': + what = SCAN; + break; + case 'c': + flags |= O_CREAT; + break; + case 'd': + what = DELETE; + break; + case 'f': + what = FETCH; + break; + case 'F': + what = REGEXP; + break; + case 'm': + flags &= ~(000007); + if (strcmp(optarg, "r") == 0) + flags |= O_RDONLY; + else if (strcmp(optarg, "w") == 0) + flags |= O_WRONLY; + else if (strcmp(optarg, "rw") == 0) + flags |= O_RDWR; + else { + fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); + giveusage = 1; + } + break; + case 'r': + st_flag = DBM_REPLACE; + break; + case 's': + what = STORE; + break; + case 't': + flags |= O_TRUNC; + break; + case 'v': + verbose = 1; + break; + case 'x': + flags |= O_EXCL; + break; + case '!': + giveusage = 1; + break; + case '?': + if (argn < 3) + comarg[argn++] = optarg; + else { + fprintf(stderr, "Too many arguments.\n"); + giveusage = 1; + } + break; + } + } + + if (giveusage | what == YOW | argn < 1) { + fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); + exit(-1); + } + + if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { + fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); + exit(-1); + } + + if (argn > 1) + key = read_datum(comarg[1]); + if (argn > 2) + content = read_datum(comarg[2]); + + switch (what) { + + case SCAN: + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + key = dbm_nextkey(db); + } + break; + + case REGEXP: + if (argn < 2) { + fprintf(stderr, "Missing regular expression.\n"); + goto db_exit; + } + if (re_comp(comarg[1])) { + fprintf(stderr, "Invalid regular expression\n"); + goto db_exit; + } + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + if (re_exec(key2s(key))) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + } + key = dbm_nextkey(db); + } + break; + + case FETCH: + if (argn < 2) { + fprintf(stderr, "Missing fetch key.\n"); + goto db_exit; + } + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (content.dptr == NULL) { + fprintf(stderr, "Cannot find "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + break; + + case DELETE: + if (argn < 2) { + fprintf(stderr, "Missing delete key.\n"); + goto db_exit; + } + if (dbm_delete(db, key) || dbm_error(db)) { + fprintf(stderr, "Error when deleting "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": DELETED\n"); + } + break; + + case STORE: + if (argn < 3) { + fprintf(stderr, "Missing key and/or content.\n"); + goto db_exit; + } + if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { + fprintf(stderr, "Error when storing "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": "); + print_datum(content); + printf(" STORED\n"); + } + break; + } + +db_exit: + dbm_clearerr(db); + dbm_close(db); + if (dbm_error(db)) { + fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); + exit(-1); + } +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c new file mode 100644 index 00000000000..1388230e2d3 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c @@ -0,0 +1,120 @@ +/* + * Copyright (c) 1985 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms are permitted + * provided that the above copyright notice and this paragraph are + * duplicated in all such forms and that any documentation, + * advertising materials, and other materials related to such + * distribution and use acknowledge that the software was developed + * by the University of California, Berkeley. The name of the + * University may not be used to endorse or promote products derived + * from this software without specific prior written permission. + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +#ifndef lint +static char sccsid[] = "@(#)dbm.c 5.4 (Berkeley) 5/24/89"; +#endif /* not lint */ + +#include "dbm.h" + +#define NODB ((DBM *)0) + +static DBM *cur_db = NODB; + +static char no_db[] = "dbm: no open database\n"; + +dbminit(file) + char *file; +{ + if (cur_db != NODB) + dbm_close(cur_db); + + cur_db = dbm_open(file, 2, 0); + if (cur_db == NODB) { + cur_db = dbm_open(file, 0, 0); + if (cur_db == NODB) + return (-1); + } + return (0); +} + +long +forder(key) +datum key; +{ + if (cur_db == NODB) { + printf(no_db); + return (0L); + } + return (dbm_forder(cur_db, key)); +} + +datum +fetch(key) +datum key; +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_fetch(cur_db, key)); +} + +delete(key) +datum key; +{ + if (cur_db == NODB) { + printf(no_db); + return (-1); + } + if (dbm_rdonly(cur_db)) + return (-1); + return (dbm_delete(cur_db, key)); +} + +store(key, dat) +datum key, dat; +{ + if (cur_db == NODB) { + printf(no_db); + return (-1); + } + if (dbm_rdonly(cur_db)) + return (-1); + + return (dbm_store(cur_db, key, dat, DBM_REPLACE)); +} + +datum +firstkey() +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_firstkey(cur_db)); +} + +datum +nextkey(key) +datum key; +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_nextkey(cur_db, key)); +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.h b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h new file mode 100644 index 00000000000..1196953d965 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.h @@ -0,0 +1,35 @@ +/* + * Copyright (c) 1983 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms are permitted + * provided that the above copyright notice and this paragraph are + * duplicated in all such forms and that any documentation, + * advertising materials, and other materials related to such + * distribution and use acknowledge that the software was developed + * by the University of California, Berkeley. The name of the + * University may not be used to endorse or promote products derived + * from this software without specific prior written permission. + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + * + * @(#)dbm.h 5.2 (Berkeley) 5/24/89 + */ + +#ifndef NULL +/* + * this is lunacy, we no longer use it (and never should have + * unconditionally defined it), but, this whole file is for + * backwards compatability - someone may rely on this. + */ +#define NULL ((char *) 0) +#endif + +#ifdef I_NDBM +# include +#endif + +datum fetch(); +datum firstkey(); +datum nextkey(); diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbu.c b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c new file mode 100644 index 00000000000..a3c0004da9f --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c @@ -0,0 +1,251 @@ +#include +#include +#ifdef SDBM +#include "EXTERN.h" +#include "sdbm.h" +#else +#include +#endif +#include + +#ifdef BSD42 +#define strchr index +#endif + +extern int getopt(); +extern char *strchr(); +extern void oops(); + +char *progname; + +static int rflag; +static char *usage = "%s [-R] cat | look |... dbmname"; + +#define DERROR 0 +#define DLOOK 1 +#define DINSERT 2 +#define DDELETE 3 +#define DCAT 4 +#define DBUILD 5 +#define DPRESS 6 +#define DCREAT 7 + +#define LINEMAX 8192 + +typedef struct { + char *sname; + int scode; + int flags; +} cmd; + +static cmd cmds[] = { + + "fetch", DLOOK, O_RDONLY, + "get", DLOOK, O_RDONLY, + "look", DLOOK, O_RDONLY, + "add", DINSERT, O_RDWR, + "insert", DINSERT, O_RDWR, + "store", DINSERT, O_RDWR, + "delete", DDELETE, O_RDWR, + "remove", DDELETE, O_RDWR, + "dump", DCAT, O_RDONLY, + "list", DCAT, O_RDONLY, + "cat", DCAT, O_RDONLY, + "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "build", DBUILD, O_RDWR | O_CREAT, + "squash", DPRESS, O_RDWR, + "compact", DPRESS, O_RDWR, + "compress", DPRESS, O_RDWR +}; + +#define CTABSIZ (sizeof (cmds)/sizeof (cmd)) + +static cmd *parse(); +static void badk(), doit(), prdatum(); + +int +main(argc, argv) +int argc; +char *argv[]; +{ + int c; + register cmd *act; + extern int optind; + extern char *optarg; + + progname = argv[0]; + + while ((c = getopt(argc, argv, "R")) != EOF) + switch (c) { + case 'R': /* raw processing */ + rflag++; + break; + + default: + oops("usage: %s", usage); + break; + } + + if ((argc -= optind) < 2) + oops("usage: %s", usage); + + if ((act = parse(argv[optind])) == NULL) + badk(argv[optind]); + optind++; + doit(act, argv[optind]); + return 0; +} + +static void +doit(act, file) +register cmd *act; +char *file; +{ + datum key; + datum val; + register DBM *db; + register char *op; + register int n; + char *line; +#ifdef TIME + long start; + extern long time(); +#endif + + if ((db = dbm_open(file, act->flags, 0644)) == NULL) + oops("cannot open: %s", file); + + if ((line = (char *) malloc(LINEMAX)) == NULL) + oops("%s: cannot get memory", "line alloc"); + + switch (act->scode) { + + case DLOOK: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + val = dbm_fetch(db, key); + if (val.dptr != NULL) { + prdatum(stdout, val); + putchar('\n'); + continue; + } + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + break; + case DINSERT: + break; + case DDELETE: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + if (dbm_delete(db, key) == -1) { + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + } + break; + case DCAT: + for (key = dbm_firstkey(db); key.dptr != 0; + key = dbm_nextkey(db)) { + prdatum(stdout, key); + putchar('\t'); + prdatum(stdout, dbm_fetch(db, key)); + putchar('\n'); + } + break; + case DBUILD: +#ifdef TIME + start = time(0); +#endif + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + if ((op = strchr(line, '\t')) != 0) { + key.dsize = op - line; + *op++ = 0; + val.dptr = op; + val.dsize = line + n - op; + } + else + oops("bad input; %s", line); + + if (dbm_store(db, key, val, DBM_REPLACE) < 0) { + prdatum(stderr, key); + fprintf(stderr, ": "); + oops("store: %s", "failed"); + } + } +#ifdef TIME + printf("done: %d seconds.\n", time(0) - start); +#endif + break; + case DPRESS: + break; + case DCREAT: + break; + } + + dbm_close(db); +} + +static void +badk(word) +char *word; +{ + register int i; + + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, "bad keywd %s. use one of\n", word); + for (i = 0; i < (int)CTABSIZ; i++) + fprintf(stderr, "%-8s%c", cmds[i].sname, + ((i + 1) % 6 == 0) ? '\n' : ' '); + fprintf(stderr, "\n"); + exit(1); + /*NOTREACHED*/ +} + +static cmd * +parse(str) +register char *str; +{ + register int i = CTABSIZ; + register cmd *p; + + for (p = cmds; i--; p++) + if (strcmp(p->sname, str) == 0) + return p; + return NULL; +} + +static void +prdatum(stream, d) +FILE *stream; +datum d; +{ + register int c; + register char *p = d.dptr; + register int n = d.dsize; + + while (n--) { + c = *p++ & 0377; + if (c & 0200) { + fprintf(stream, "M-"); + c &= 0177; + } + if (c == 0177 || c < ' ') + fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@'); + else + putc(c, stream); + } +} + + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/grind b/contrib/perl5/ext/SDBM_File/sdbm/grind new file mode 100755 index 00000000000..23728b7d494 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/grind @@ -0,0 +1,9 @@ +#!/bin/sh +rm -f /tmp/*.dir /tmp/*.pag +awk -e '{ + printf "%s\t", $0 + for (i = 0; i < 40; i++) + printf "%s.", $0 + printf "\n" +}' < /usr/dict/words | $1 build /tmp/$2 + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/hash.c b/contrib/perl5/ext/SDBM_File/sdbm/hash.c new file mode 100644 index 00000000000..9b276485993 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/hash.c @@ -0,0 +1,47 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. keep it that way. + * + * hashing routine + */ + +#include "config.h" +#include "EXTERN.h" +#include "sdbm.h" +/* + * polynomial conversion ignoring overflows + * [this seems to work remarkably well, in fact better + * then the ndbm hash function. Replace at your own risk] + * use: 65599 nice. + * 65587 even better. + */ +long +sdbm_hash(register char *str, register int len) +{ + register unsigned long n = 0; + +#ifdef DUFF + +#define HASHC n = *str++ + 65599 * n + + if (len > 0) { + register int loop = (len + 8 - 1) >> 3; + + switch(len & (8 - 1)) { + case 0: do { + HASHC; case 7: HASHC; + case 6: HASHC; case 5: HASHC; + case 4: HASHC; case 3: HASHC; + case 2: HASHC; case 1: HASHC; + } while (--loop); + } + + } +#else + while (len--) + n = *str++ + 65599 * n; +#endif + return n; +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/linux.patches b/contrib/perl5/ext/SDBM_File/sdbm/linux.patches new file mode 100644 index 00000000000..cb7b1b7d8eb --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/linux.patches @@ -0,0 +1,67 @@ +*** sdbm.dist/./dbu.c Mon Feb 17 21:18:52 1992 +--- sdbm/./dbu.c Mon Feb 17 21:11:20 1992 +*************** +*** 12,18 **** + #endif + + extern int getopt(); +! extern char *strchr(); + extern void oops(); + + char *progname; +--- 12,18 ---- + #endif + + extern int getopt(); +! /* extern char *strchr(); */ + extern void oops(); + + char *progname; +*** sdbm.dist/./makefile Mon Feb 17 21:18:56 1992 +--- sdbm/./makefile Mon Feb 17 21:10:46 1992 +*************** +*** 2,8 **** + # makefile for public domain ndbm-clone: sdbm + # DUFF: use duff's device (loop unroll) in parts of the code + # +! CFLAGS = -O -DSDBM -DDUFF -DBSD42 + #LDFLAGS = -p + + OBJS = sdbm.o pair.o hash.o +--- 2,8 ---- + # makefile for public domain ndbm-clone: sdbm + # DUFF: use duff's device (loop unroll) in parts of the code + # +! CFLAGS = -O -DSDBM -DDUFF + #LDFLAGS = -p + + OBJS = sdbm.o pair.o hash.o +*** sdbm.dist/./sdbm.c Mon Feb 17 21:19:17 1992 +--- sdbm/./sdbm.c Mon Feb 17 21:12:59 1992 +*************** +*** 25,30 **** +--- 25,31 ---- + #endif + #include + #include ++ #include + + #ifdef __STDC__ + #include +*************** +*** 43,49 **** + + extern char *malloc proto((unsigned int)); + extern void free proto((void *)); +! extern long lseek(); + + /* + * forward +--- 44,50 ---- + + extern char *malloc proto((unsigned int)); + extern void free proto((void *)); +! /* extern long lseek(); */ + + /* + * forward diff --git a/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm b/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm new file mode 100644 index 00000000000..c959c1fab55 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/makefile.sdbm @@ -0,0 +1,55 @@ +# +# makefile for public domain ndbm-clone: sdbm +# DUFF: use duff's device (loop unroll) in parts of the code +# +CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic +#LDFLAGS = -p + +OBJS = sdbm.o pair.o hash.o +SRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c +HDRS = tune.h sdbm.h pair.h +MISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \ + readme.ms readme.ps + +all: dbu dba dbd dbe + +dbu: dbu.o sdbm util.o + cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a + +dba: dba.o util.o + cc $(LDFLAGS) -o dba dba.o util.o +dbd: dbd.o util.o + cc $(LDFLAGS) -o dbd dbd.o util.o +dbe: dbe.o sdbm + cc $(LDFLAGS) -o dbe dbe.o libsdbm.a + +sdbm: $(OBJS) + ar cr libsdbm.a $(OBJS) + ranlib libsdbm.a +### cp libsdbm.a /usr/lib/libsdbm.a + +dba.o: sdbm.h +dbu.o: sdbm.h +util.o:sdbm.h + +$(OBJS): sdbm.h tune.h pair.h + +# +# dbu using berkelezoid ndbm routines [if you have them] for testing +# +#x-dbu: dbu.o util.o +# cc $(CFLAGS) -o x-dbu dbu.o util.o +lint: + lint -abchx $(SRCS) + +clean: + rm -f *.o mon.out core + +purge: clean + rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag + +shar: + shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR + +readme: + nroff -ms readme.ms | col -b >README diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.c b/contrib/perl5/ext/SDBM_File/sdbm/pair.c new file mode 100644 index 00000000000..a9a805a4aa3 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.c @@ -0,0 +1,283 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + * + * page-level routines + */ + +#include "config.h" +#include "EXTERN.h" +#include "sdbm.h" +#include "tune.h" +#include "pair.h" + +#define exhash(item) sdbm_hash((item).dptr, (item).dsize) + +/* + * forward + */ +static int seepair proto((char *, int, char *, int)); + +/* + * page format: + * +------------------------------+ + * ino | n | keyoff | datoff | keyoff | + * +------------+--------+--------+ + * | datoff | - - - ----> | + * +--------+---------------------+ + * | F R E E A R E A | + * +--------------+---------------+ + * | <---- - - - | data | + * +--------+-----+----+----------+ + * | key | data | key | + * +--------+----------+----------+ + * + * calculating the offsets for free area: if the number + * of entries (ino[0]) is zero, the offset to the END of + * the free area is the block size. Otherwise, it is the + * nth (ino[ino[0]]) entry's offset. + */ + +int +fitpair(char *pag, int need) +{ + register int n; + register int off; + register int free; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; + free = off - (n + 1) * sizeof(short); + need += 2 * sizeof(short); + + debug(("free %d need %d\n", free, need)); + + return need <= free; +} + +void +putpair(char *pag, datum key, datum val) +{ + register int n; + register int off; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; +/* + * enter the key first + */ + off -= key.dsize; + (void) memcpy(pag + off, key.dptr, key.dsize); + ino[n + 1] = off; +/* + * now the data + */ + off -= val.dsize; + (void) memcpy(pag + off, val.dptr, val.dsize); + ino[n + 2] = off; +/* + * adjust item count + */ + ino[0] += 2; +} + +datum +getpair(char *pag, datum key) +{ + register int i; + register int n; + datum val; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return nullitem; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return nullitem; + + val.dptr = pag + ino[i + 1]; + val.dsize = ino[i] - ino[i + 1]; + return val; +} + +#ifdef SEEDUPS +int +duppair(char *pag, datum key) +{ + register short *ino = (short *) pag; + return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; +} +#endif + +datum +getnkey(char *pag, int num) +{ + datum key; + register int off; + register short *ino = (short *) pag; + + num = num * 2 - 1; + if (ino[0] == 0 || num > ino[0]) + return nullitem; + + off = (num > 1) ? ino[num - 1] : PBLKSIZ; + + key.dptr = pag + ino[num]; + key.dsize = off - ino[num]; + + return key; +} + +int +delpair(char *pag, datum key) +{ + register int n; + register int i; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return 0; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return 0; +/* + * found the key. if it is the last entry + * [i.e. i == n - 1] we just adjust the entry count. + * hard case: move all data down onto the deleted pair, + * shift offsets onto deleted offsets, and adjust them. + * [note: 0 < i < n] + */ + if (i < n - 1) { + register int m; + register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); + register char *src = pag + ino[i + 1]; + register int zoo = dst - src; + + debug(("free-up %d ", zoo)); +/* + * shift data/keys down + */ + m = ino[i + 1] - ino[n]; +#ifdef DUFF +#define MOVB *--dst = *--src + + if (m > 0) { + register int loop = (m + 8 - 1) >> 3; + + switch (m & (8 - 1)) { + case 0: do { + MOVB; case 7: MOVB; + case 6: MOVB; case 5: MOVB; + case 4: MOVB; case 3: MOVB; + case 2: MOVB; case 1: MOVB; + } while (--loop); + } + } +#else +#ifdef HAS_MEMMOVE + dst -= m; + src -= m; + memmove(dst, src, m); +#else + while (m--) + *--dst = *--src; +#endif +#endif +/* + * adjust offset index up + */ + while (i < n - 1) { + ino[i] = ino[i + 2] + zoo; + i++; + } + } + ino[0] -= 2; + return 1; +} + +/* + * search for the key in the page. + * return offset index in the range 0 < i < n. + * return 0 if not found. + */ +static int +seepair(char *pag, register int n, register char *key, register int siz) +{ + register int i; + register int off = PBLKSIZ; + register short *ino = (short *) pag; + + for (i = 1; i < n; i += 2) { + if (siz == off - ino[i] && + memEQ(key, pag + ino[i], siz)) + return i; + off = ino[i + 1]; + } + return 0; +} + +void +splpage(char *pag, char *New, long int sbit) +{ + datum key; + datum val; + + register int n; + register int off = PBLKSIZ; + char cur[PBLKSIZ]; + register short *ino = (short *) cur; + + (void) memcpy(cur, pag, PBLKSIZ); + (void) memset(pag, 0, PBLKSIZ); + (void) memset(New, 0, PBLKSIZ); + + n = ino[0]; + for (ino++; n > 0; ino += 2) { + key.dptr = cur + ino[0]; + key.dsize = off - ino[0]; + val.dptr = cur + ino[1]; + val.dsize = ino[0] - ino[1]; +/* + * select the page pointer (by looking at sbit) and insert + */ + (void) putpair((exhash(key) & sbit) ? New : pag, key, val); + + off = ino[1]; + n -= 2; + } + + debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, + ((short *) New)[0] / 2, + ((short *) pag)[0] / 2)); +} + +/* + * check page sanity: + * number of entries should be something + * reasonable, and all offsets in the index should be in order. + * this could be made more rigorous. + */ +int +chkpage(char *pag) +{ + register int n; + register int off; + register short *ino = (short *) pag; + + if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) + return 0; + + if (n > 0) { + off = PBLKSIZ; + for (ino++; n > 0; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } + } + return 1; +} diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.h b/contrib/perl5/ext/SDBM_File/sdbm/pair.h new file mode 100644 index 00000000000..8a675b90659 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.h @@ -0,0 +1,20 @@ +/* Mini EMBED (pair.c) */ +#define chkpage sdbm__chkpage +#define delpair sdbm__delpair +#define duppair sdbm__duppair +#define fitpair sdbm__fitpair +#define getnkey sdbm__getnkey +#define getpair sdbm__getpair +#define putpair sdbm__putpair +#define splpage sdbm__splpage + +extern int fitpair proto((char *, int)); +extern void putpair proto((char *, datum, datum)); +extern datum getpair proto((char *, datum)); +extern int delpair proto((char *, datum)); +extern int chkpage proto((char *)); +extern datum getnkey proto((char *, int)); +extern void splpage proto((char *, char *, long)); +#ifdef SEEDUPS +extern int duppair proto((char *, datum)); +#endif diff --git a/contrib/perl5/ext/SDBM_File/sdbm/readme.ms b/contrib/perl5/ext/SDBM_File/sdbm/readme.ms new file mode 100644 index 00000000000..01ca17ccdfd --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/readme.ms @@ -0,0 +1,353 @@ +.\" tbl | readme.ms | [tn]roff -ms | ... +.\" note the "C" (courier) and "CB" fonts: you will probably have to +.\" change these. +.\" $Id: readme.ms,v 1.1 90/12/13 13:09:15 oz Exp Locker: oz $ + +.de P1 +.br +.nr dT 4 +.nf +.ft C +.sp .5 +.nr t \\n(dT*\\w'x'u +.ta 1u*\\ntu 2u*\\ntu 3u*\\ntu 4u*\\ntu 5u*\\ntu 6u*\\ntu 7u*\\ntu 8u*\\ntu 9u*\\ntu 10u*\\ntu 11u*\\ntu 12u*\\ntu 13u*\\ntu 14u*\\ntu +.. +.de P2 +.br +.ft 1 +.br +.sp .5 +.br +.fi +.. +.\" CW uses the typewriter/courier font. +.de CW +\fC\\$1\\fP\\$2 +.. + +.\" Footnote numbering [by Henry Spencer] +.\" \*f for a footnote number.. +.\" .FS +.\" \*F +.\" .FE +.\" +.ds f \\u\\s-2\\n+f\\s+2\\d +.nr f 0 1 +.ds F \\n+F. +.nr F 0 1 + +.ND +.LP +.TL +\fIsdbm\fP \(em Substitute DBM +.br +or +.br +Berkeley \fIndbm\fP for Every UN*X\** Made Simple +.AU +Ozan (oz) Yigit +.AI +The Guild of PD Software Toolmakers +Toronto - Canada +.sp +oz@nexus.yorku.ca +.LP +.FS +UN*X is not a trademark of any (dis)organization. +.FE +.sp 2 +\fIImplementation is the sincerest form of flattery. \(em L. Peter Deutsch\fP +.SH +A The Clone of the \fIndbm\fP library +.PP +The sources accompanying this notice \(em \fIsdbm\fP \(em constitute +the first public release (Dec. 1990) of a complete clone of +the Berkeley UN*X \fIndbm\fP library. The \fIsdbm\fP library is meant to +clone the proven functionality of \fIndbm\fP as closely as possible, +including a few improvements. It is practical, easy to understand, and +compatible. +The \fIsdbm\fP library is not derived from any licensed, proprietary or +copyrighted software. +.PP +The \fIsdbm\fP implementation is based on a 1978 algorithm +[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +In the course of searching for a substitute for \fIndbm\fP, I +prototyped three different external-hashing algorithms [Lar78, Fag79, Lit80] +and ultimately chose Larson's algorithm as a basis of the \fIsdbm\fP +implementation. The Bell Labs +\fIdbm\fP (and therefore \fIndbm\fP) is based on an algorithm invented by +Ken Thompson, [Tho90, Tor87] and predates Larson's work. +.PP +The \fIsdbm\fR programming interface is totally compatible +with \fIndbm\fP and includes a slight improvement in database initialization. +It is also expected to be binary-compatible under most UN*X versions that +support the \fIndbm\fP library. +.PP +The \fIsdbm\fP implementation shares the shortcomings of the \fIndbm\fP +library, as a side effect of various simplifications to the original Larson +algorithm. It does produce \fIholes\fP in the page file as it writes +pages past the end of file. (Larson's paper include a clever solution to +this problem that is a result of using the hash value directly as a block +address.) On the other hand, extensive tests seem to indicate that \fIsdbm\fP +creates fewer holes in general, and the resulting pagefiles are +smaller. The \fIsdbm\fP implementation is also faster than \fIndbm\fP +in database creation. +Unlike the \fIndbm\fP, the \fIsdbm\fP +.CW store +operation will not ``wander away'' trying to split its +data pages to insert a datum that \fIcannot\fP (due to elaborate worst-case +situations) be inserted. (It will fail after a pre-defined number of attempts.) +.SH +Important Compatibility Warning +.PP +The \fIsdbm\fP and \fIndbm\fP +libraries \fIcannot\fP share databases: one cannot read the (dir/pag) +database created by the other. This is due to the differences +between the \fIndbm\fP and \fIsdbm\fP algorithms\**, +.FS +Torek's discussion [Tor87] +indicates that \fIdbm/ndbm\fP implementations use the hash +value to traverse the radix trie differently than \fIsdbm\fP +and as a result, the page indexes are generated in \fIdifferent\fP order. +For more information, send e-mail to the author. +.FE +and the hash functions +used. +It is easy to convert between the \fIdbm/ndbm\fP databases and \fIsdbm\fP +by ignoring the index completely: see +.CW dbd , +.CW dbu +etc. +.R +.LP +.SH +Notice of Intellectual Property +.LP +\fIThe entire\fP sdbm \fIlibrary package, as authored by me,\fP Ozan S. Yigit, +\fIis hereby placed in the public domain.\fP As such, the author is not +responsible for the consequences of use of this software, no matter how +awful, even if they arise from defects in it. There is no expressed or +implied warranty for the \fIsdbm\fP library. +.PP +Since the \fIsdbm\fP +library package is in the public domain, this \fIoriginal\fP +release or any additional public-domain releases of the modified original +cannot possibly (by definition) be withheld from you. Also by definition, +You (singular) have all the rights to this code (including the right to +sell without permission, the right to hoard\** +.FS +You cannot really hoard something that is available to the public at +large, but try if it makes you feel any better. +.FE +and the right to do other icky things as +you see fit) but those rights are also granted to everyone else. +.PP +Please note that all previous distributions of this software contained +a copyright (which is now dropped) to protect its +origins and its current public domain status against any possible claims +and/or challenges. +.SH +Acknowledgments +.PP +Many people have been very helpful and supportive. A partial list would +necessarily include Rayan Zacherissen (who contributed the man page, +and also hacked a MMAP version of \fIsdbm\fP), +Arnold Robbins, Chris Lewis, +Bill Davidsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me started +in the first place), Johannes Ruschein +(who did the minix port) and David Tilbrook. I thank you all. +.SH +Distribution Manifest and Notes +.LP +This distribution of \fIsdbm\fP includes (at least) the following: +.P1 + CHANGES change log + README this file. + biblio a small bibliography on external hashing + dba.c a crude (n/s)dbm page file analyzer + dbd.c a crude (n/s)dbm page file dumper (for conversion) + dbe.1 man page for dbe.c + dbe.c Janick's database editor + dbm.c a dbm library emulation wrapper for ndbm/sdbm + dbm.h header file for the above + dbu.c a crude db management utility + hash.c hashing function + makefile guess. + pair.c page-level routines (posted earlier) + pair.h header file for the above + readme.ms troff source for the README file + sdbm.3 man page + sdbm.c the real thing + sdbm.h header file for the above + tune.h place for tuning & portability thingies + util.c miscellaneous +.P2 +.PP +.CW dbu +is a simple database manipulation program\** that tries to look +.FS +The +.CW dbd , +.CW dba , +.CW dbu +utilities are quick hacks and are not fit for production use. They were +developed late one night, just to test out \fIsdbm\fP, and convert some +databases. +.FE +like Bell Labs' +.CW cbt +utility. It is currently incomplete in functionality. +I use +.CW dbu +to test out the routines: it takes (from stdin) tab separated +key/value pairs for commands like +.CW build +or +.CW insert +or takes keys for +commands like +.CW delete +or +.CW look . +.P1 + dbu dbmfile +.P2 +.PP +.CW dba +is a crude analyzer of \fIdbm/sdbm/ndbm\fP +page files. It scans the entire +page file, reporting page level statistics, and totals at the end. +.PP +.CW dbd +is a crude dump program for \fIdbm/ndbm/sdbm\fP +databases. It ignores the +bitmap, and dumps the data pages in sequence. It can be used to create +input for the +.CW dbu +utility. +Note that +.CW dbd +will skip any NULLs in the key and data +fields, thus is unsuitable to convert some peculiar databases that +insist in including the terminating null. +.PP +I have also included a copy of the +.CW dbe +(\fIndbm\fP DataBase Editor) by Janick Bergeron [janick@bnr.ca] for +your pleasure. You may find it more useful than the little +.CW dbu +utility. +.PP +.CW dbm.[ch] +is a \fIdbm\fP library emulation on top of \fIndbm\fP +(and hence suitable for \fIsdbm\fP). Written by Robert Elz. +.PP +The \fIsdbm\fP +library has been around in beta test for quite a long time, and from whatever +little feedback I received (maybe no news is good news), I believe it has been +functioning without any significant problems. I would, of course, appreciate +all fixes and/or improvements. Portability enhancements would especially be +useful. +.SH +Implementation Issues +.PP +Hash functions: +The algorithm behind \fIsdbm\fP implementation needs a good bit-scrambling +hash function to be effective. I ran into a set of constants for a simple +hash function that seem to help \fIsdbm\fP perform better than \fIndbm\fP +for various inputs: +.P1 + /* + * polynomial conversion ignoring overflows + * 65599 nice. 65587 even better. + */ + long + dbm_hash(char *str, int len) { + register unsigned long n = 0; + + while (len--) + n = n * 65599 + *str++; + return n; + } +.P2 +.PP +There may be better hash functions for the purposes of dynamic hashing. +Try your favorite, and check the pagefile. If it contains too many pages +with too many holes, (in relation to this one for example) or if +\fIsdbm\fP +simply stops working (fails after +.CW SPLTMAX +attempts to split) when you feed your +NEWS +.CW history +file to it, you probably do not have a good hashing function. +If you do better (for different types of input), I would like to know +about the function you use. +.PP +Block sizes: It seems (from various tests on a few machines) that a page +file block size +.CW PBLKSIZ +of 1024 is by far the best for performance, but +this also happens to limit the size of a key/value pair. Depending on your +needs, you may wish to increase the page size, and also adjust +.CW PAIRMAX +(the maximum size of a key/value pair allowed: should always be at least +three words smaller than +.CW PBLKSIZ .) +accordingly. The system-wide version of the library +should probably be +configured with 1024 (distribution default), as this appears to be sufficient +for most common uses of \fIsdbm\fP. +.SH +Portability +.PP +This package has been tested in many different UN*Xes even including minix, +and appears to be reasonably portable. This does not mean it will port +easily to non-UN*X systems. +.SH +Notes and Miscellaneous +.PP +The \fIsdbm\fP is not a very complicated package, at least not after you +familiarize yourself with the literature on external hashing. There are +other interesting algorithms in existence that ensure (approximately) +single-read access to a data value associated with any key. These are +directory-less schemes such as \fIlinear hashing\fP [Lit80] (+ Larson +variations), \fIspiral storage\fP [Mar79] or directory schemes such as +\fIextensible hashing\fP [Fag79] by Fagin et al. I do hope these sources +provide a reasonable playground for experimentation with other algorithms. +See the June 1988 issue of ACM Computing Surveys [Enb88] for an +excellent overview of the field. +.PG +.SH +References +.LP +.IP [Lar78] 4m +P.-A. Larson, +``Dynamic Hashing'', \fIBIT\fP, vol. 18, pp. 184-201, 1978. +.IP [Tho90] 4m +Ken Thompson, \fIprivate communication\fP, Nov. 1990 +.IP [Lit80] 4m +W. Litwin, +`` Linear Hashing: A new tool for file and table addressing'', +\fIProceedings of the 6th Conference on Very Large Dabatases (Montreal)\fP, +pp. 212-223, Very Large Database Foundation, Saratoga, Calif., 1980. +.IP [Fag79] 4m +R. Fagin, J. Nievergelt, N. Pippinger, and H. R. Strong, +``Extendible Hashing - A Fast Access Method for Dynamic Files'', +\fIACM Trans. Database Syst.\fP, vol. 4, no.3, pp. 315-344, Sept. 1979. +.IP [Wal84] 4m +Rich Wales, +``Discussion of "dbm" data base system'', \fIUSENET newsgroup unix.wizards\fP, +Jan. 1984. +.IP [Tor87] 4m +Chris Torek, +``Re: dbm.a and ndbm.a archives'', \fIUSENET newsgroup comp.unix\fP, +1987. +.IP [Mar79] 4m +G. N. Martin, +``Spiral Storage: Incrementally Augmentable Hash Addressed Storage'', +\fITechnical Report #27\fP, University of Varwick, Coventry, U.K., 1979. +.IP [Enb88] 4m +R. J. Enbody and H. C. Du, +``Dynamic Hashing Schemes'',\fIACM Computing Surveys\fP, +vol. 20, no. 2, pp. 85-113, June 1988. diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 new file mode 100644 index 00000000000..7e5c1764042 --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 @@ -0,0 +1,290 @@ +.\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $ +.TH SDBM 3 "1 March 1990" +.SH NAME +sdbm, sdbm_open, sdbm_prep, sdbm_close, sdbm_fetch, sdbm_store, sdbm_delete, sdbm_firstkey, sdbm_nextkey, sdbm_hash, sdbm_rdonly, sdbm_error, sdbm_clearerr, sdbm_dirfno, sdbm_pagfno \- data base subroutines +.SH SYNOPSIS +.nf +.ft B +#include +.sp +typedef struct { + char *dptr; + int dsize; +} datum; +.sp +datum nullitem = { NULL, 0 }; +.sp +\s-1DBM\s0 *sdbm_open(char *file, int flags, int mode) +.sp +\s-1DBM\s0 *sdbm_prep(char *dirname, char *pagname, int flags, int mode) +.sp +void sdbm_close(\s-1DBM\s0 *db) +.sp +datum sdbm_fetch(\s-1DBM\s0 *db, key) +.sp +int sdbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags) +.sp +int sdbm_delete(\s-1DBM\s0 *db, datum key) +.sp +datum sdbm_firstkey(\s-1DBM\s0 *db) +.sp +datum sdbm_nextkey(\s-1DBM\s0 *db) +.sp +long sdbm_hash(char *string, int len) +.sp +int sdbm_rdonly(\s-1DBM\s0 *db) +int sdbm_error(\s-1DBM\s0 *db) +sdbm_clearerr(\s-1DBM\s0 *db) +int sdbm_dirfno(\s-1DBM\s0 *db) +int sdbm_pagfno(\s-1DBM\s0 *db) +.ft R +.fi +.SH DESCRIPTION +.IX "database library" sdbm "" "\fLsdbm\fR" +.IX sdbm_open "" "\fLsdbm_open\fR \(em open \fLsdbm\fR database" +.IX sdbm_prep "" "\fLsdbm_prep\fR \(em prepare \fLsdbm\fR database" +.IX sdbm_close "" "\fLsdbm_close\fR \(em close \fLsdbm\fR routine" +.IX sdbm_fetch "" "\fLsdbm_fetch\fR \(em fetch \fLsdbm\fR database data" +.IX sdbm_store "" "\fLsdbm_store\fR \(em add data to \fLsdbm\fR database" +.IX sdbm_delete "" "\fLsdbm_delete\fR \(em remove data from \fLsdbm\fR database" +.IX sdbm_firstkey "" "\fLsdbm_firstkey\fR \(em access \fLsdbm\fR database" +.IX sdbm_nextkey "" "\fLsdbm_nextkey\fR \(em access \fLsdbm\fR database" +.IX sdbm_hash "" "\fLsdbm_hash\fR \(em string hash for \fLsdbm\fR database" +.IX sdbm_rdonly "" "\fLsdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode" +.IX sdbm_error "" "\fLsdbm_error\fR \(em return \fLsdbm\fR database error condition" +.IX sdbm_clearerr "" "\fLsdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition" +.IX sdbm_dirfno "" "\fLsdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor" +.IX sdbm_pagfno "" "\fLsdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor" +.IX "database functions \(em \fLsdbm\fR" sdbm_open "" \fLsdbm_open\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_prep "" \fLsdbm_prep\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_close "" \fLsdbm_close\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_fetch "" \fLsdbm_fetch\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_store "" \fLsdbm_store\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_delete "" \fLsdbm_delete\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_firstkey "" \fLsdbm_firstkey\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_nextkey "" \fLsdbm_nextkey\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_rdonly "" \fLsdbm_rdonly\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_error "" \fLsdbm_error\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_clearerr "" \fLsdbm_clearerr\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_dirfno "" \fLsdbm_dirfno\fP +.IX "database functions \(em \fLsdbm\fR" sdbm_pagfno "" \fLsdbm_pagfno\fP +.LP +This package allows an application to maintain a mapping of pairs +in disk files. This is not to be considered a real database system, but is +still useful in many simple applications built around fast retrieval of a data +value from a key. This implementation uses an external hashing scheme, +called Dynamic Hashing, as described by Per-Aake Larson in BIT 18 (1978) pp. +184-201. Retrieval of any item usually requires a single disk access. +The application interface is compatible with the +.IR ndbm (3) +library. +.LP +An +.B sdbm +database is kept in two files usually given the extensions +.B \.dir +and +.BR \.pag . +The +.B \.dir +file contains a bitmap representing a forest of binary hash trees, the leaves +of which indicate data pages in the +.B \.pag +file. +.LP +The application interface uses the +.B datum +structure to describe both +.I keys +and +.IR value s. +A +.B datum +specifies a byte sequence of +.I dsize +size pointed to by +.IR dptr . +If you use +.SM ASCII +strings as +.IR key s +or +.IR value s, +then you must decide whether or not to include the terminating +.SM NUL +byte which sometimes defines strings. Including it will require larger +database files, but it will be possible to get sensible output from a +.IR strings (1) +command applied to the data file. +.LP +In order to allow a process using this package to manipulate multiple +databases, the applications interface always requires a +.IR handle , +a +.BR "DBM *" , +to identify the database to be manipulated. Such a handle can be obtained +from the only routines that do not require it, namely +.BR sdbm_open (\|) +or +.BR sdbm_prep (\|). +Either of these will open or create the two necessary files. The +difference is that the latter allows explicitly naming the bitmap and data +files whereas +.BR sdbm_open (\|) +will take a base file name and call +.BR sdbm_prep (\|) +with the default extensions. +The +.I flags +and +.I mode +parameters are the same as for +.BR open (2). +.LP +To free the resources occupied while a database handle is active, call +.BR sdbm_close (\|). +.LP +Given a handle, one can retrieve data associated with a key by using the +.BR sdbm_fetch (\|) +routine, and associate data with a key by using the +.BR sdbm_store (\|) +routine. +.LP +The values of the +.I flags +parameter for +.BR sdbm_store (\|) +can be either +.BR \s-1DBM_INSERT\s0 , +which will not change an existing entry with the same key, or +.BR \s-1DBM_REPLACE\s0 , +which will replace an existing entry with the same key. +Keys are unique within the database. +.LP +To delete a key and its associated value use the +.BR sdbm_delete (\|) +routine. +.LP +To retrieve every key in the database, use a loop like: +.sp +.nf +.ft B +for (key = sdbm_firstkey(db); key.dptr != NULL; key = sdbm_nextkey(db)) + ; +.ft R +.fi +.LP +The order of retrieval is unspecified. +.LP +If you determine that the performance of the database is inadequate or +you notice clustering or other effects that may be due to the hashing +algorithm used by this package, you can override it by supplying your +own +.BR sdbm_hash (\|) +routine. Doing so will make the database unintelligable to any other +applications that do not use your specialized hash function. +.sp +.LP +The following macros are defined in the header file: +.IP +.BR sdbm_rdonly (\|) +returns true if the database has been opened read\-only. +.IP +.BR sdbm_error (\|) +returns true if an I/O error has occurred. +.IP +.BR sdbm_clearerr (\|) +allows you to clear the error flag if you think you know what the error +was and insist on ignoring it. +.IP +.BR sdbm_dirfno (\|) +returns the file descriptor associated with the bitmap file. +.IP +.BR sdbm_pagfno (\|) +returns the file descriptor associated with the data file. +.SH SEE ALSO +.IR open (2). +.SH DIAGNOSTICS +Functions that return a +.B "DBM *" +handle will use +.SM NULL +to indicate an error. +Functions that return an +.B int +will use \-1 to indicate an error. The normal return value in that case is 0. +Functions that return a +.B datum +will return +.B nullitem +to indicate an error. +.LP +As a special case of +.BR sdbm_store (\|), +if it is called with the +.B \s-1DBM_INSERT\s0 +flag and the key already exists in the database, the return value will be 1. +.LP +In general, if a function parameter is invalid, +.B errno +will be set to +.BR \s-1EINVAL\s0 . +If a write operation is requested on a read-only database, +.B errno +will be set to +.BR \s-1ENOPERM\s0 . +If a memory allocation (using +.IR malloc (3)) +failed, +.B errno +will be set to +.BR \s-1ENOMEM\s0 . +For I/O operation failures +.B errno +will contain the value set by the relevant failed system call, either +.IR read (2), +.IR write (2), +or +.IR lseek (2). +.SH AUTHOR +.IP "Ozan S. Yigit" (oz@nexus.yorku.ca) +.SH BUGS +The sum of key and value data sizes must not exceed +.B \s-1PAIRMAX\s0 +(1008 bytes). +.LP +The sum of the key and value data sizes where several keys hash to the +same value must fit within one bitmap page. +.LP +The +.B \.pag +file will contain holes, so its apparent size is larger than its contents. +When copied through the filesystem the holes will be filled. +.LP +The contents of +.B datum +values returned are in volatile storage. If you want to retain the values +pointed to, you must copy them immediately before another call to this package. +.LP +The only safe way for multiple processes to (read and) update a database at +the same time, is to implement a private locking scheme outside this package +and open and close the database between lock acquisitions. It is safe for +multiple processes to concurrently access a database read-only. +.SH APPLICATIONS PORTABILITY +For complete source code compatibility with the Berkeley Unix +.IR ndbm (3) +library, the +.B sdbm.h +header file should be installed in +.BR /usr/include/ndbm.h . +.LP +The +.B nullitem +data item, and the +.BR sdbm_prep (\|), +.BR sdbm_hash (\|), +.BR sdbm_rdonly (\|), +.BR sdbm_dirfno (\|), +and +.BR sdbm_pagfno (\|) +functions are unique to this package. diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c new file mode 100644 index 00000000000..637fbe98a1b --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c @@ -0,0 +1,492 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + * + * core routines + */ + +#include "INTERN.h" +#include "config.h" +#include "sdbm.h" +#include "tune.h" +#include "pair.h" + +#ifdef I_FCNTL +# include +#endif +#ifdef I_SYS_FILE +# include +#endif + +#ifdef I_STRING +# include +#else +# include +#endif + +/* + * externals + */ +#ifndef WIN32 +#ifndef sun +extern int errno; +#endif + +extern Malloc_t malloc proto((MEM_SIZE)); +extern Free_t free proto((Malloc_t)); +extern Off_t lseek(int, Off_t, int); +#endif + +/* + * forward + */ +static int getdbit proto((DBM *, long)); +static int setdbit proto((DBM *, long)); +static int getpage proto((DBM *, long)); +static datum getnext proto((DBM *)); +static int makroom proto((DBM *, long, int)); + +/* + * useful macros + */ +#define bad(x) ((x).dptr == NULL || (x).dsize < 0) +#define exhash(item) sdbm_hash((item).dptr, (item).dsize) +#define ioerr(db) ((db)->flags |= DBM_IOERR) + +#define OFF_PAG(off) (long) (off) * PBLKSIZ +#define OFF_DIR(off) (long) (off) * DBLKSIZ + +static long masks[] = { + 000000000000, 000000000001, 000000000003, 000000000007, + 000000000017, 000000000037, 000000000077, 000000000177, + 000000000377, 000000000777, 000000001777, 000000003777, + 000000007777, 000000017777, 000000037777, 000000077777, + 000000177777, 000000377777, 000000777777, 000001777777, + 000003777777, 000007777777, 000017777777, 000037777777, + 000077777777, 000177777777, 000377777777, 000777777777, + 001777777777, 003777777777, 007777777777, 017777777777 +}; + +DBM * +sdbm_open(register char *file, register int flags, register int mode) +{ + register DBM *db; + register char *dirname; + register char *pagname; + register int n; + + if (file == NULL || !*file) + return errno = EINVAL, (DBM *) NULL; +/* + * need space for two seperate filenames + */ + n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2; + + if ((dirname = (char *) malloc((unsigned) n)) == NULL) + return errno = ENOMEM, (DBM *) NULL; +/* + * build the file names + */ + dirname = strcat(strcpy(dirname, file), DIRFEXT); + pagname = strcpy(dirname + strlen(dirname) + 1, file); + pagname = strcat(pagname, PAGFEXT); + + db = sdbm_prep(dirname, pagname, flags, mode); + free((char *) dirname); + return db; +} + +DBM * +sdbm_prep(char *dirname, char *pagname, int flags, int mode) +{ + register DBM *db; + struct stat dstat; + + if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) + return errno = ENOMEM, (DBM *) NULL; + + db->flags = 0; + db->hmask = 0; + db->blkptr = 0; + db->keyptr = 0; +/* + * adjust user flags so that WRONLY becomes RDWR, + * as required by this package. Also set our internal + * flag for RDONLY if needed. + */ + if (flags & O_WRONLY) + flags = (flags & ~O_WRONLY) | O_RDWR; + + else if ((flags & 03) == O_RDONLY) + db->flags = DBM_RDONLY; +/* + * open the files in sequence, and stat the dirfile. + * If we fail anywhere, undo everything, return NULL. + */ +#if defined(OS2) || defined(MSDOS) || defined(WIN32) + flags |= O_BINARY; +# endif + if ((db->pagf = open(pagname, flags, mode)) > -1) { + if ((db->dirf = open(dirname, flags, mode)) > -1) { +/* + * need the dirfile size to establish max bit number. + */ + if (fstat(db->dirf, &dstat) == 0) { +/* + * zero size: either a fresh database, or one with a single, + * unsplit data page: dirpage is all zeros. + */ + db->dirbno = (!dstat.st_size) ? 0 : -1; + db->pagbno = -1; + db->maxbno = dstat.st_size * BYTESIZ; + + (void) memset(db->pagbuf, 0, PBLKSIZ); + (void) memset(db->dirbuf, 0, DBLKSIZ); + /* + * success + */ + return db; + } + (void) close(db->dirf); + } + (void) close(db->pagf); + } + free((char *) db); + return (DBM *) NULL; +} + +void +sdbm_close(register DBM *db) +{ + if (db == NULL) + errno = EINVAL; + else { + (void) close(db->dirf); + (void) close(db->pagf); + free((char *) db); + } +} + +datum +sdbm_fetch(register DBM *db, datum key) +{ + if (db == NULL || bad(key)) + return errno = EINVAL, nullitem; + + if (getpage(db, exhash(key))) + return getpair(db->pagbuf, key); + + return ioerr(db), nullitem; +} + +int +sdbm_delete(register DBM *db, datum key) +{ + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; + + if (getpage(db, exhash(key))) { + if (!delpair(db->pagbuf, key)) + return -1; +/* + * update the page file + */ + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; + + return 0; + } + + return ioerr(db), -1; +} + +int +sdbm_store(register DBM *db, datum key, datum val, int flags) +{ + int need; + register long hash; + + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; + + need = key.dsize + val.dsize; +/* + * is the pair too big (or too small) for this database ?? + */ + if (need < 0 || need > PAIRMAX) + return errno = EINVAL, -1; + + if (getpage(db, (hash = exhash(key)))) { +/* + * if we need to replace, delete the key/data pair + * first. If it is not there, ignore. + */ + if (flags == DBM_REPLACE) + (void) delpair(db->pagbuf, key); +#ifdef SEEDUPS + else if (duppair(db->pagbuf, key)) + return 1; +#endif +/* + * if we do not have enough room, we have to split. + */ + if (!fitpair(db->pagbuf, need)) + if (!makroom(db, hash, need)) + return ioerr(db), -1; +/* + * we have enough room or split is successful. insert the key, + * and update the page file. + */ + (void) putpair(db->pagbuf, key, val); + + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; + /* + * success + */ + return 0; + } + + return ioerr(db), -1; +} + +/* + * makroom - make room by splitting the overfull page + * this routine will attempt to make room for SPLTMAX times before + * giving up. + */ +static int +makroom(register DBM *db, long int hash, int need) +{ + long newp; + char twin[PBLKSIZ]; + char *pag = db->pagbuf; + char *New = twin; + register int smax = SPLTMAX; + + do { +/* + * split the current page + */ + (void) splpage(pag, New, db->hmask + 1); +/* + * address of the new page + */ + newp = (hash & db->hmask) | (db->hmask + 1); + +/* + * write delay, read avoidence/cache shuffle: + * select the page for incoming pair: if key is to go to the new page, + * write out the previous one, and copy the new one over, thus making + * it the current page. If not, simply write the new page, and we are + * still looking at the page of interest. current page is not updated + * here, as sdbm_store will do so, after it inserts the incoming pair. + */ + if (hash & (db->hmask + 1)) { + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + db->pagbno = newp; + (void) memcpy(pag, New, PBLKSIZ); + } + else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 + || write(db->pagf, New, PBLKSIZ) < 0) + return 0; + + if (!setdbit(db, db->curbit)) + return 0; +/* + * see if we have enough room now + */ + if (fitpair(pag, need)) + return 1; +/* + * try again... update curbit and hmask as getpage would have + * done. because of our update of the current page, we do not + * need to read in anything. BUT we have to write the current + * [deferred] page out, as the window of failure is too great. + */ + db->curbit = 2 * db->curbit + + ((hash & (db->hmask + 1)) ? 2 : 1); + db->hmask |= db->hmask + 1; + + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + + } while (--smax); +/* + * if we are here, this is real bad news. After SPLTMAX splits, + * we still cannot fit the key. say goodnight. + */ +#ifdef BADMESS + (void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); +#endif + return 0; + +} + +/* + * the following two routines will break if + * deletions aren't taken into account. (ndbm bug) + */ +datum +sdbm_firstkey(register DBM *db) +{ + if (db == NULL) + return errno = EINVAL, nullitem; +/* + * start at page 0 + */ + if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), nullitem; + db->pagbno = 0; + db->blkptr = 0; + db->keyptr = 0; + + return getnext(db); +} + +datum +sdbm_nextkey(register DBM *db) +{ + if (db == NULL) + return errno = EINVAL, nullitem; + return getnext(db); +} + +/* + * all important binary trie traversal + */ +static int +getpage(register DBM *db, register long int hash) +{ + register int hbit; + register long dbit; + register long pagb; + + dbit = 0; + hbit = 0; + while (dbit < db->maxbno && getdbit(db, dbit)) + dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); + + debug(("dbit: %d...", dbit)); + + db->curbit = dbit; + db->hmask = masks[hbit]; + + pagb = hash & db->hmask; +/* + * see if the block we need is already in memory. + * note: this lookaside cache has about 10% hit rate. + */ + if (pagb != db->pagbno) { +/* + * note: here, we assume a "hole" is read as 0s. + * if not, must zero pagbuf first. + */ + if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + if (!chkpage(db->pagbuf)) + return 0; + db->pagbno = pagb; + + debug(("pag read: %d\n", pagb)); + } + return 1; +} + +static int +getdbit(register DBM *db, register long int dbit) +{ + register long c; + register long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } + + return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); +} + +static int +setdbit(register DBM *db, register long int dbit) +{ + register long c; + register long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } + + db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); + + if (dbit >= db->maxbno) + db->maxbno += DBLKSIZ * BYTESIZ; + + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + + return 1; +} + +/* + * getnext - get the next key in the page, and if done with + * the page, try the next page in sequence + */ +static datum +getnext(register DBM *db) +{ + datum key; + + for (;;) { + db->keyptr++; + key = getnkey(db->pagbuf, db->keyptr); + if (key.dptr != NULL) + return key; +/* + * we either run out, or there is nothing on this page.. + * try the next one... If we lost our position on the + * file, we will have to seek. + */ + db->keyptr = 0; + if (db->pagbno != db->blkptr++) + if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) + break; + db->pagbno = db->blkptr; + if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) + break; + if (!chkpage(db->pagbuf)) + break; + } + + return ioerr(db), nullitem; +} + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h new file mode 100644 index 00000000000..84d5f75468c --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h @@ -0,0 +1,290 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + */ +#define DBLKSIZ 4096 +#define PBLKSIZ 1024 +#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ +#define SPLTMAX 10 /* maximum allowed splits */ + /* for a single insertion */ +#ifdef VMS +#define DIRFEXT ".sdbm_dir" +#else +#define DIRFEXT ".dir" +#endif +#define PAGFEXT ".pag" + +typedef struct { + int dirf; /* directory file descriptor */ + int pagf; /* page file descriptor */ + int flags; /* status/error flags, see below */ + long maxbno; /* size of dirfile in bits */ + long curbit; /* current bit number */ + long hmask; /* current hash mask */ + long blkptr; /* current block for nextkey */ + int keyptr; /* current key for nextkey */ + long blkno; /* current page to read/write */ + long pagbno; /* current page in pagbuf */ + char pagbuf[PBLKSIZ]; /* page file block buffer */ + long dirbno; /* current block in dirbuf */ + char dirbuf[DBLKSIZ]; /* directory file block buffer */ +} DBM; + +#define DBM_RDONLY 0x1 /* data base open read-only */ +#define DBM_IOERR 0x2 /* data base I/O error */ + +/* + * utility macros + */ +#define sdbm_rdonly(db) ((db)->flags & DBM_RDONLY) +#define sdbm_error(db) ((db)->flags & DBM_IOERR) + +#define sdbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ + +#define sdbm_dirfno(db) ((db)->dirf) +#define sdbm_pagfno(db) ((db)->pagf) + +typedef struct { + char *dptr; + int dsize; +} datum; + +EXTCONST datum nullitem +#ifdef DOINIT + = {0, 0} +#endif + ; + +#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE) +#define proto(p) p +#else +#define proto(p) () +#endif + +/* + * flags to sdbm_store + */ +#define DBM_INSERT 0 +#define DBM_REPLACE 1 + +/* + * ndbm interface + */ +extern DBM *sdbm_open proto((char *, int, int)); +extern void sdbm_close proto((DBM *)); +extern datum sdbm_fetch proto((DBM *, datum)); +extern int sdbm_delete proto((DBM *, datum)); +extern int sdbm_store proto((DBM *, datum, datum, int)); +extern datum sdbm_firstkey proto((DBM *)); +extern datum sdbm_nextkey proto((DBM *)); + +/* + * other + */ +extern DBM *sdbm_prep proto((char *, char *, int, int)); +extern long sdbm_hash proto((char *, int)); + +#ifndef SDBM_ONLY +#define dbm_open sdbm_open +#define dbm_close sdbm_close +#define dbm_fetch sdbm_fetch +#define dbm_store sdbm_store +#define dbm_delete sdbm_delete +#define dbm_firstkey sdbm_firstkey +#define dbm_nextkey sdbm_nextkey +#define dbm_error sdbm_error +#define dbm_clearerr sdbm_clearerr +#endif + +/* Most of the following is stolen from perl.h. */ +#ifndef H_PERL /* Include guard */ + +/* + * The following contortions are brought to you on behalf of all the + * standards, semi-standards, de facto standards, not-so-de-facto standards + * of the world, as well as all the other botches anyone ever thought of. + * The basic theory is that if we work hard enough here, the rest of the + * code can be a lot prettier. Well, so much for theory. Sorry, Henry... + */ + +#include +#ifdef HAS_SOCKET +# ifdef I_NET_ERRNO +# include +# endif +#endif + +#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) +# define STANDARD_C 1 +#endif + +#include +#include +#include + +#if defined(I_UNISTD) +#include +#endif + +#ifdef VMS +# include +# include +#endif + +#ifdef I_SYS_PARAM +# if !defined(MSDOS) && !defined(WIN32) && !defined(VMS) +# ifdef PARAM_NEEDS_TYPES +# include +# endif +# include +# endif +#endif + +#ifndef _TYPES_ /* If types.h defines this it's easy. */ +# ifndef major /* Does everyone's types.h define this? */ +# include +# endif +#endif + +#include + +#ifndef SEEK_SET +# ifdef L_SET +# define SEEK_SET L_SET +# else +# define SEEK_SET 0 /* Wild guess. */ +# endif +#endif + +/* Use all the "standard" definitions? */ +#if defined(STANDARD_C) && defined(I_STDLIB) +# include +#endif /* STANDARD_C */ + +#define MEM_SIZE Size_t + +/* This comes after so we don't try to change the standard + * library prototypes; we'll use our own instead. */ + +#if defined(MYMALLOC) && (defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC)) + +# ifdef HIDEMYMALLOC +# define malloc Mymalloc +# define calloc Mycalloc +# define realloc Myremalloc +# define free Myfree +# endif +# ifdef EMBEDMYMALLOC +# define malloc Perl_malloc +# define calloc Perl_calloc +# define realloc Perl_realloc +# define free Perl_free +# endif + + Malloc_t malloc proto((MEM_SIZE nbytes)); + Malloc_t calloc proto((MEM_SIZE elements, MEM_SIZE size)); + Malloc_t realloc proto((Malloc_t where, MEM_SIZE nbytes)); + Free_t free proto((Malloc_t where)); + +#endif /* MYMALLOC && (HIDEMYMALLOC || EMBEDMYMALLOC) */ + +#ifdef I_STRING +#include +#else +#include +#endif + +#ifdef I_MEMORY +#include +#endif + +#ifdef __cplusplus +#define HAS_MEMCPY +#endif + +#ifdef HAS_MEMCPY +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memcpy + extern char * memcpy proto((char*, char*, int)); +# endif +# endif +#else +# ifndef memcpy +# ifdef HAS_BCOPY +# define memcpy(d,s,l) bcopy(s,d,l) +# else +# define memcpy(d,s,l) my_bcopy(s,d,l) +# endif +# endif +#endif /* HAS_MEMCPY */ + +#ifdef HAS_MEMSET +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memset + extern char *memset proto((char*, int, int)); +# endif +# endif +# define memzero(d,l) memset(d,0,l) +#else +# ifndef memzero +# ifdef HAS_BZERO +# define memzero(d,l) bzero(d,l) +# else +# define memzero(d,l) my_bzero(d,l) +# endif +# endif +#endif /* HAS_MEMSET */ + +#if defined(mips) && defined(ultrix) && !defined(__STDC__) +# undef HAS_MEMCMP +#endif + +#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memcmp + extern int memcmp proto((char*, char*, int)); +# endif +# endif +# ifdef BUGGY_MSC + # pragma function(memcmp) +# endif +#else +# ifndef memcmp + /* maybe we should have included the full embedding header... */ +# ifdef NO_EMBED +# define memcmp my_memcmp +# else +# define memcmp Perl_my_memcmp +# endif +#ifndef __cplusplus + extern int memcmp proto((char*, char*, int)); +#endif +# endif +#endif /* HAS_MEMCMP */ + +#ifndef HAS_BCMP +# ifndef bcmp +# define bcmp(s1,s2,l) memcmp(s1,s2,l) +# endif +#endif /* !HAS_BCMP */ + +#ifdef HAS_MEMCMP +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + +#ifdef I_NETINET_IN +# ifdef VMS +# include +# else +# include +# endif +#endif + +#endif /* Include guard */ + diff --git a/contrib/perl5/ext/SDBM_File/sdbm/tune.h b/contrib/perl5/ext/SDBM_File/sdbm/tune.h new file mode 100644 index 00000000000..b95c8c8634a --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/tune.h @@ -0,0 +1,23 @@ +/* + * sdbm - ndbm work-alike hashed database library + * tuning and portability constructs [not nearly enough] + * author: oz@nexus.yorku.ca + */ + +#define BYTESIZ 8 + +/* + * important tuning parms (hah) + */ + +#define SEEDUPS /* always detect duplicates */ +#define BADMESS /* generate a message for worst case: + cannot make room after SPLTMAX splits */ +/* + * misc + */ +#ifdef DEBUG +#define debug(x) printf x +#else +#define debug(x) +#endif diff --git a/contrib/perl5/ext/SDBM_File/sdbm/util.c b/contrib/perl5/ext/SDBM_File/sdbm/util.c new file mode 100644 index 00000000000..16bd4ac9a5c --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/sdbm/util.c @@ -0,0 +1,47 @@ +#include +#ifdef SDBM +#include "sdbm.h" +#else +#include "ndbm.h" +#endif + +void +oops(register char *s1, register char *s2) +{ + extern int errno, sys_nerr; + extern char *sys_errlist[]; + extern char *progname; + + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, s1, s2); + if (errno > 0 && errno < sys_nerr) + fprintf(stderr, " (%s)", sys_errlist[errno]); + fprintf(stderr, "\n"); + exit(1); +} + +int +okpage(char *pag) +{ + register unsigned n; + register off; + register short *ino = (short *) pag; + + if ((n = ino[0]) > PBLKSIZ / sizeof(short)) + return 0; + + if (!n) + return 1; + + off = PBLKSIZ; + for (ino++; n; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } + + return 1; +} diff --git a/contrib/perl5/ext/SDBM_File/typemap b/contrib/perl5/ext/SDBM_File/typemap new file mode 100644 index 00000000000..317a8f3886c --- /dev/null +++ b/contrib/perl5/ext/SDBM_File/typemap @@ -0,0 +1,27 @@ +# +#################################### DBM SECTION +# + +datum T_DATUM +gdatum T_GDATUM +NDBM_File T_PTROBJ +GDBM_File T_PTROBJ +SDBM_File T_PTROBJ +ODBM_File T_PTROBJ +DB_File T_PTROBJ +DBZ_File T_PTROBJ +FATALFUNC T_OPAQUEPTR + +INPUT +T_DATUM + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); +T_PTROBJ + sv_setref_pv($arg, dbtype, (void*)$var); diff --git a/contrib/perl5/ext/Socket/Makefile.PL b/contrib/perl5/ext/Socket/Makefile.PL new file mode 100644 index 00000000000..7b9469a728e --- /dev/null +++ b/contrib/perl5/ext/Socket/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Socket', + VERSION_FROM => 'Socket.pm', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? +); diff --git a/contrib/perl5/ext/Socket/Socket.pm b/contrib/perl5/ext/Socket/Socket.pm new file mode 100644 index 00000000000..5a4870f4afa --- /dev/null +++ b/contrib/perl5/ext/Socket/Socket.pm @@ -0,0 +1,307 @@ +package Socket; + +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +$VERSION = "1.7"; + +=head1 NAME + +Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C socket.h defines and structure manipulators + +=head1 SYNOPSIS + + use Socket; + + $proto = getprotobyname('udp'); + socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto); + $iaddr = gethostbyname('hishost.com'); + $port = getservbyname('time', 'udp'); + $sin = sockaddr_in($port, $iaddr); + send(Socket_Handle, 0, 0, $sin); + + $proto = getprotobyname('tcp'); + socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto); + $port = getservbyname('smtp', 'tcp'); + $sin = sockaddr_in($port,inet_aton("127.1")); + $sin = sockaddr_in(7,inet_aton("localhost")); + $sin = sockaddr_in(7,INADDR_LOOPBACK); + connect(Socket_Handle,$sin); + + ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle)); + $peer_host = gethostbyaddr($iaddr, AF_INET); + $peer_addr = inet_ntoa($iaddr); + + $proto = getprotobyname('tcp'); + socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto); + unlink('/tmp/usock'); + $sun = sockaddr_un('/tmp/usock'); + connect(Socket_Handle,$sun); + +=head1 DESCRIPTION + +This module is just a translation of the C F file. +Unlike the old mechanism of requiring a translated F +file, this uses the B program (see the Perl source distribution) +and your native C compiler. This means that it has a +far more likely chance of getting the numbers right. This includes +all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc. + +Also, some common socket "newline" constants are provided: the +constants C, C, and C, as well as C<$CR>, C<$LF>, and +C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>. If you do +not want to use the literal characters in your programs, then use +the constants provided here. They are not exported by default, but can +be imported individually, and with the C<:crlf> export tag: + + use Socket qw(:DEFAULT :crlf); + +In addition, some structure manipulation functions are available: + +=over + +=item inet_aton HOSTNAME + +Takes a string giving the name of a host, and translates that +to the 4-byte string (structure). Takes arguments of both +the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name +cannot be resolved, returns undef. For multi-homed hosts (hosts +with more than one address), the first address found is returned. + +=item inet_ntoa IP_ADDRESS + +Takes a four byte ip address (as returned by inet_aton()) +and translates it into a string of the form 'd.d.d.d' +where the 'd's are numbers less than 256 (the normal +readable four dotted number notation for internet addresses). + +=item INADDR_ANY + +Note: does not return a number, but a packed string. + +Returns the 4-byte wildcard ip address which specifies any +of the hosts ip addresses. (A particular machine can have +more than one ip address, each address corresponding to +a particular network interface. This wildcard address +allows you to bind to all of them simultaneously.) +Normally equivalent to inet_aton('0.0.0.0'). + +=item INADDR_BROADCAST + +Note: does not return a number, but a packed string. + +Returns the 4-byte 'this-lan' ip broadcast address. +This can be useful for some protocols to solicit information +from all servers on the same LAN cable. +Normally equivalent to inet_aton('255.255.255.255'). + +=item INADDR_LOOPBACK + +Note - does not return a number. + +Returns the 4-byte loopback address. Normally equivalent +to inet_aton('localhost'). + +=item INADDR_NONE + +Note - does not return a number. + +Returns the 4-byte 'invalid' ip address. Normally equivalent +to inet_aton('255.255.255.255'). + +=item sockaddr_in PORT, ADDRESS + +=item sockaddr_in SOCKADDR_IN + +In an array context, unpacks its SOCKADDR_IN argument and returns an array +consisting of (PORT, ADDRESS). In a scalar context, packs its (PORT, +ADDRESS) arguments as a SOCKADDR_IN and returns it. If this is confusing, +use pack_sockaddr_in() and unpack_sockaddr_in() explicitly. + +=item pack_sockaddr_in PORT, IP_ADDRESS + +Takes two arguments, a port number and a 4 byte IP_ADDRESS (as returned by +inet_aton()). Returns the sockaddr_in structure with those arguments +packed in with AF_INET filled in. For internet domain sockets, this +structure is normally what you need for the arguments in bind(), +connect(), and send(), and is also returned by getpeername(), +getsockname() and recv(). + +=item unpack_sockaddr_in SOCKADDR_IN + +Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and +returns an array of two elements: the port and the 4-byte ip-address. +Will croak if the structure does not have AF_INET in the right place. + +=item sockaddr_un PATHNAME + +=item sockaddr_un SOCKADDR_UN + +In an array context, unpacks its SOCKADDR_UN argument and returns an array +consisting of (PATHNAME). In a scalar context, packs its PATHNAME +arguments as a SOCKADDR_UN and returns it. If this is confusing, use +pack_sockaddr_un() and unpack_sockaddr_un() explicitly. +These are only supported if your system has EFE. + +=item pack_sockaddr_un PATH + +Takes one argument, a pathname. Returns the sockaddr_un structure with +that path packed in with AF_UNIX filled in. For unix domain sockets, this +structure is normally what you need for the arguments in bind(), +connect(), and send(), and is also returned by getpeername(), +getsockname() and recv(). + +=item unpack_sockaddr_un SOCKADDR_UN + +Takes a sockaddr_un structure (as returned by pack_sockaddr_un()) +and returns the pathname. Will croak if the structure does not +have AF_UNIX in the right place. + +=back + +=cut + +use Carp; + +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw( + inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in + pack_sockaddr_un unpack_sockaddr_un + sockaddr_in sockaddr_un + INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE + AF_802 + AF_APPLETALK + AF_CCITT + AF_CHAOS + AF_DATAKIT + AF_DECnet + AF_DLI + AF_ECMA + AF_GOSIP + AF_HYLINK + AF_IMPLINK + AF_INET + AF_LAT + AF_MAX + AF_NBS + AF_NIT + AF_NS + AF_OSI + AF_OSINET + AF_PUP + AF_SNA + AF_UNIX + AF_UNSPEC + AF_X25 + MSG_DONTROUTE + MSG_MAXIOVLEN + MSG_OOB + MSG_PEEK + PF_802 + PF_APPLETALK + PF_CCITT + PF_CHAOS + PF_DATAKIT + PF_DECnet + PF_DLI + PF_ECMA + PF_GOSIP + PF_HYLINK + PF_IMPLINK + PF_INET + PF_LAT + PF_MAX + PF_NBS + PF_NIT + PF_NS + PF_OSI + PF_OSINET + PF_PUP + PF_SNA + PF_UNIX + PF_UNSPEC + PF_X25 + SOCK_DGRAM + SOCK_RAW + SOCK_RDM + SOCK_SEQPACKET + SOCK_STREAM + SOL_SOCKET + SOMAXCONN + SO_ACCEPTCONN + SO_BROADCAST + SO_DEBUG + SO_DONTLINGER + SO_DONTROUTE + SO_ERROR + SO_KEEPALIVE + SO_LINGER + SO_OOBINLINE + SO_RCVBUF + SO_RCVLOWAT + SO_RCVTIMEO + SO_REUSEADDR + SO_SNDBUF + SO_SNDLOWAT + SO_SNDTIMEO + SO_TYPE + SO_USELOOPBACK +); + +@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF); + +%EXPORT_TAGS = ( + crlf => [qw(CR LF CRLF $CR $LF $CRLF)], + all => [@EXPORT, @EXPORT_OK], +); + +BEGIN { + sub CR () {"\015"} + sub LF () {"\012"} + sub CRLF () {"\015\012"} +} + +*CR = \CR(); +*LF = \LF(); +*CRLF = \CRLF(); + +sub sockaddr_in { + if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die + my($af, $port, @quad) = @_; + carp "6-ARG sockaddr_in call is deprecated" if $^W; + pack_sockaddr_in($port, inet_aton(join('.', @quad))); + } elsif (wantarray) { + croak "usage: (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1; + unpack_sockaddr_in(@_); + } else { + croak "usage: sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2; + pack_sockaddr_in(@_); + } +} + +sub sockaddr_un { + if (wantarray) { + croak "usage: (filename) = sockaddr_un(sun_sv)" unless @_ == 1; + unpack_sockaddr_un(@_); + } else { + croak "usage: sun_sv = sockaddr_un(filename)" unless @_ == 1; + pack_sockaddr_un(@_); + } +} + + +sub AUTOLOAD { + my($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + my ($pack,$file,$line) = caller; + croak "Your vendor has not defined Socket macro $constname, used"; + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +bootstrap Socket $VERSION; + +1; diff --git a/contrib/perl5/ext/Socket/Socket.xs b/contrib/perl5/ext/Socket/Socket.xs new file mode 100644 index 00000000000..de0217bdb4d --- /dev/null +++ b/contrib/perl5/ext/Socket/Socket.xs @@ -0,0 +1,890 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifndef VMS +# ifdef I_SYS_TYPES +# include +# endif +#include +#ifdef MPE +# define PF_INET AF_INET +# define PF_UNIX AF_UNIX +# define SOCK_RAW 3 +#endif +#ifdef I_SYS_UN +#include +#endif +# ifdef I_NETINET_IN +# include +# endif +#include +#ifdef I_ARPA_INET +# include +#endif +#else +#include "sockadapt.h" +#endif + +#ifndef AF_NBS +#undef PF_NBS +#endif + +#ifndef AF_X25 +#undef PF_X25 +#endif + +#ifndef INADDR_NONE +#define INADDR_NONE 0xffffffff +#endif /* INADDR_NONE */ +#ifndef INADDR_BROADCAST +#define INADDR_BROADCAST 0xffffffff +#endif /* INADDR_BROADCAST */ +#ifndef INADDR_LOOPBACK +#define INADDR_LOOPBACK 0x7F000001 +#endif /* INADDR_LOOPBACK */ + +#ifndef HAS_INET_ATON + +/* + * Check whether "cp" is a valid ascii representation + * of an Internet address and convert to a binary address. + * Returns 1 if the address is valid, 0 if not. + * This replaces inet_addr, the return value from which + * cannot distinguish between failure and a local broadcast address. + */ +static int +my_inet_aton(register const char *cp, struct in_addr *addr) +{ + register U32 val; + register int base; + register char c; + int nparts; + const char *s; + unsigned int parts[4]; + register unsigned int *pp = parts; + + if (!cp) + return 0; + for (;;) { + /* + * Collect number up to ``.''. + * Values are specified as for C: + * 0x=hex, 0=octal, other=decimal. + */ + val = 0; base = 10; + if (*cp == '0') { + if (*++cp == 'x' || *cp == 'X') + base = 16, cp++; + else + base = 8; + } + while ((c = *cp) != '\0') { + if (isDIGIT(c)) { + val = (val * base) + (c - '0'); + cp++; + continue; + } + if (base == 16 && (s=strchr(PL_hexdigit,c))) { + val = (val << 4) + + ((s - PL_hexdigit) & 15); + cp++; + continue; + } + break; + } + if (*cp == '.') { + /* + * Internet format: + * a.b.c.d + * a.b.c (with c treated as 16-bits) + * a.b (with b treated as 24 bits) + */ + if (pp >= parts + 3 || val > 0xff) + return 0; + *pp++ = val, cp++; + } else + break; + } + /* + * Check for trailing characters. + */ + if (*cp && !isSPACE(*cp)) + return 0; + /* + * Concoct the address according to + * the number of parts specified. + */ + nparts = pp - parts + 1; /* force to an int for switch() */ + switch (nparts) { + + case 1: /* a -- 32 bits */ + break; + + case 2: /* a.b -- 8.24 bits */ + if (val > 0xffffff) + return 0; + val |= parts[0] << 24; + break; + + case 3: /* a.b.c -- 8.8.16 bits */ + if (val > 0xffff) + return 0; + val |= (parts[0] << 24) | (parts[1] << 16); + break; + + case 4: /* a.b.c.d -- 8.8.8.8 bits */ + if (val > 0xff) + return 0; + val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8); + break; + } + addr->s_addr = htonl(val); + return 1; +} + +#undef inet_aton +#define inet_aton my_inet_aton + +#endif /* ! HAS_INET_ATON */ + + +static int +not_here(char *s) +{ + croak("Socket::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(char *name, int arg) +{ + errno = 0; + switch (*name) { + case 'A': + if (strEQ(name, "AF_802")) +#ifdef AF_802 + return AF_802; +#else + goto not_there; +#endif + if (strEQ(name, "AF_APPLETALK")) +#ifdef AF_APPLETALK + return AF_APPLETALK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_CCITT")) +#ifdef AF_CCITT + return AF_CCITT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_CHAOS")) +#ifdef AF_CHAOS + return AF_CHAOS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DATAKIT")) +#ifdef AF_DATAKIT + return AF_DATAKIT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DECnet")) +#ifdef AF_DECnet + return AF_DECnet; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DLI")) +#ifdef AF_DLI + return AF_DLI; +#else + goto not_there; +#endif + if (strEQ(name, "AF_ECMA")) +#ifdef AF_ECMA + return AF_ECMA; +#else + goto not_there; +#endif + if (strEQ(name, "AF_GOSIP")) +#ifdef AF_GOSIP + return AF_GOSIP; +#else + goto not_there; +#endif + if (strEQ(name, "AF_HYLINK")) +#ifdef AF_HYLINK + return AF_HYLINK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_IMPLINK")) +#ifdef AF_IMPLINK + return AF_IMPLINK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_INET")) +#ifdef AF_INET + return AF_INET; +#else + goto not_there; +#endif + if (strEQ(name, "AF_LAT")) +#ifdef AF_LAT + return AF_LAT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_MAX")) +#ifdef AF_MAX + return AF_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NBS")) +#ifdef AF_NBS + return AF_NBS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NIT")) +#ifdef AF_NIT + return AF_NIT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NS")) +#ifdef AF_NS + return AF_NS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_OSI")) +#ifdef AF_OSI + return AF_OSI; +#else + goto not_there; +#endif + if (strEQ(name, "AF_OSINET")) +#ifdef AF_OSINET + return AF_OSINET; +#else + goto not_there; +#endif + if (strEQ(name, "AF_PUP")) +#ifdef AF_PUP + return AF_PUP; +#else + goto not_there; +#endif + if (strEQ(name, "AF_SNA")) +#ifdef AF_SNA + return AF_SNA; +#else + goto not_there; +#endif + if (strEQ(name, "AF_UNIX")) +#ifdef AF_UNIX + return AF_UNIX; +#else + goto not_there; +#endif + if (strEQ(name, "AF_UNSPEC")) +#ifdef AF_UNSPEC + return AF_UNSPEC; +#else + goto not_there; +#endif + if (strEQ(name, "AF_X25")) +#ifdef AF_X25 + return AF_X25; +#else + goto not_there; +#endif + break; + case 'B': + break; + case 'C': + break; + case 'D': + break; + case 'E': + break; + case 'F': + break; + case 'G': + break; + case 'H': + break; + case 'I': + break; + case 'J': + break; + case 'K': + break; + case 'L': + break; + case 'M': + if (strEQ(name, "MSG_CTRUNC")) +#if defined(MSG_CTRUNC) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_CTRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_DONTROUTE")) +#if defined(MSG_DONTROUTE) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_DONTROUTE; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_MAXIOVLEN")) +#ifdef MSG_MAXIOVLEN + return MSG_MAXIOVLEN; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_OOB")) +#if defined(MSG_OOB) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_OOB; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_PEEK")) +#if defined(MSG_PEEK) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_PEEK; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_PROXY")) +#if defined(MSG_PROXY) || defined(HAS_GNULIBC) /* XXX it's an enum */ + return MSG_PROXY; +#else + goto not_there; +#endif + break; + case 'N': + break; + case 'O': + break; + case 'P': + if (strEQ(name, "PF_802")) +#ifdef PF_802 + return PF_802; +#else + goto not_there; +#endif + if (strEQ(name, "PF_APPLETALK")) +#ifdef PF_APPLETALK + return PF_APPLETALK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_CCITT")) +#ifdef PF_CCITT + return PF_CCITT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_CHAOS")) +#ifdef PF_CHAOS + return PF_CHAOS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DATAKIT")) +#ifdef PF_DATAKIT + return PF_DATAKIT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DECnet")) +#ifdef PF_DECnet + return PF_DECnet; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DLI")) +#ifdef PF_DLI + return PF_DLI; +#else + goto not_there; +#endif + if (strEQ(name, "PF_ECMA")) +#ifdef PF_ECMA + return PF_ECMA; +#else + goto not_there; +#endif + if (strEQ(name, "PF_GOSIP")) +#ifdef PF_GOSIP + return PF_GOSIP; +#else + goto not_there; +#endif + if (strEQ(name, "PF_HYLINK")) +#ifdef PF_HYLINK + return PF_HYLINK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_IMPLINK")) +#ifdef PF_IMPLINK + return PF_IMPLINK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_INET")) +#ifdef PF_INET + return PF_INET; +#else + goto not_there; +#endif + if (strEQ(name, "PF_LAT")) +#ifdef PF_LAT + return PF_LAT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_MAX")) +#ifdef PF_MAX + return PF_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NBS")) +#ifdef PF_NBS + return PF_NBS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NIT")) +#ifdef PF_NIT + return PF_NIT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NS")) +#ifdef PF_NS + return PF_NS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_OSI")) +#ifdef PF_OSI + return PF_OSI; +#else + goto not_there; +#endif + if (strEQ(name, "PF_OSINET")) +#ifdef PF_OSINET + return PF_OSINET; +#else + goto not_there; +#endif + if (strEQ(name, "PF_PUP")) +#ifdef PF_PUP + return PF_PUP; +#else + goto not_there; +#endif + if (strEQ(name, "PF_SNA")) +#ifdef PF_SNA + return PF_SNA; +#else + goto not_there; +#endif + if (strEQ(name, "PF_UNIX")) +#ifdef PF_UNIX + return PF_UNIX; +#else + goto not_there; +#endif + if (strEQ(name, "PF_UNSPEC")) +#ifdef PF_UNSPEC + return PF_UNSPEC; +#else + goto not_there; +#endif + if (strEQ(name, "PF_X25")) +#ifdef PF_X25 + return PF_X25; +#else + goto not_there; +#endif + break; + case 'Q': + break; + case 'R': + break; + case 'S': + if (strEQ(name, "SOCK_DGRAM")) +#ifdef SOCK_DGRAM + return SOCK_DGRAM; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_RAW")) +#ifdef SOCK_RAW + return SOCK_RAW; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_RDM")) +#ifdef SOCK_RDM + return SOCK_RDM; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_SEQPACKET")) +#ifdef SOCK_SEQPACKET + return SOCK_SEQPACKET; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_STREAM")) +#ifdef SOCK_STREAM + return SOCK_STREAM; +#else + goto not_there; +#endif + if (strEQ(name, "SOL_SOCKET")) +#ifdef SOL_SOCKET + return SOL_SOCKET; +#else + goto not_there; +#endif + if (strEQ(name, "SOMAXCONN")) +#ifdef SOMAXCONN + return SOMAXCONN; +#else + goto not_there; +#endif + if (strEQ(name, "SO_ACCEPTCONN")) +#ifdef SO_ACCEPTCONN + return SO_ACCEPTCONN; +#else + goto not_there; +#endif + if (strEQ(name, "SO_BROADCAST")) +#ifdef SO_BROADCAST + return SO_BROADCAST; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DEBUG")) +#ifdef SO_DEBUG + return SO_DEBUG; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DONTLINGER")) +#ifdef SO_DONTLINGER + return SO_DONTLINGER; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DONTROUTE")) +#ifdef SO_DONTROUTE + return SO_DONTROUTE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_ERROR")) +#ifdef SO_ERROR + return SO_ERROR; +#else + goto not_there; +#endif + if (strEQ(name, "SO_KEEPALIVE")) +#ifdef SO_KEEPALIVE + return SO_KEEPALIVE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_LINGER")) +#ifdef SO_LINGER + return SO_LINGER; +#else + goto not_there; +#endif + if (strEQ(name, "SO_OOBINLINE")) +#ifdef SO_OOBINLINE + return SO_OOBINLINE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVBUF")) +#ifdef SO_RCVBUF + return SO_RCVBUF; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVLOWAT")) +#ifdef SO_RCVLOWAT + return SO_RCVLOWAT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVTIMEO")) +#ifdef SO_RCVTIMEO + return SO_RCVTIMEO; +#else + goto not_there; +#endif + if (strEQ(name, "SO_REUSEADDR")) +#ifdef SO_REUSEADDR + return SO_REUSEADDR; +#else + goto not_there; +#endif + if (strEQ(name, "SO_REUSEPORT")) +#ifdef SO_REUSEPORT + return SO_REUSEPORT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDBUF")) +#ifdef SO_SNDBUF + return SO_SNDBUF; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDLOWAT")) +#ifdef SO_SNDLOWAT + return SO_SNDLOWAT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDTIMEO")) +#ifdef SO_SNDTIMEO + return SO_SNDTIMEO; +#else + goto not_there; +#endif + if (strEQ(name, "SO_TYPE")) +#ifdef SO_TYPE + return SO_TYPE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_USELOOPBACK")) +#ifdef SO_USELOOPBACK + return SO_USELOOPBACK; +#else + goto not_there; +#endif + break; + case 'T': + break; + case 'U': + break; + case 'V': + break; + case 'W': + break; + case 'X': + break; + case 'Y': + break; + case 'Z': + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + + +MODULE = Socket PACKAGE = Socket + +double +constant(name,arg) + char * name + int arg + + +void +inet_aton(host) + char * host + CODE: + { + struct in_addr ip_address; + struct hostent * phe; + int ok = inet_aton(host, &ip_address); + + if (!ok && (phe = gethostbyname(host))) { + Copy( phe->h_addr, &ip_address, phe->h_length, char ); + ok = 1; + } + + ST(0) = sv_newmortal(); + if (ok) { + sv_setpvn( ST(0), (char *)&ip_address, sizeof ip_address ); + } + } + +void +inet_ntoa(ip_address_sv) + SV * ip_address_sv + CODE: + { + STRLEN addrlen; + struct in_addr addr; + char * addr_str; + char * ip_address = SvPV(ip_address_sv,addrlen); + if (addrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::inet_ntoa", + addrlen, sizeof(addr)); + } + + Copy( ip_address, &addr, sizeof addr, char ); + addr_str = inet_ntoa(addr); + + ST(0) = sv_2mortal(newSVpv(addr_str, strlen(addr_str))); + } + +void +pack_sockaddr_un(pathname) + char * pathname + CODE: + { +#ifdef I_SYS_UN + struct sockaddr_un sun_ad; /* fear using sun */ + STRLEN len; + Zero( &sun_ad, sizeof sun_ad, char ); + sun_ad.sun_family = AF_UNIX; + len = strlen(pathname); + if (len > sizeof(sun_ad.sun_path)) + len = sizeof(sun_ad.sun_path); + Copy( pathname, sun_ad.sun_path, len, char ); + ST(0) = sv_2mortal(newSVpv((char *)&sun_ad, sizeof sun_ad)); +#else + ST(0) = (SV *) not_here("pack_sockaddr_un"); +#endif + + } + +void +unpack_sockaddr_un(sun_sv) + SV * sun_sv + CODE: + { +#ifdef I_SYS_UN + struct sockaddr_un addr; + STRLEN sockaddrlen; + char * sun_ad = SvPV(sun_sv,sockaddrlen); + char * e; + + if (sockaddrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_sockaddr_un", + sockaddrlen, sizeof(addr)); + } + + Copy( sun_ad, &addr, sizeof addr, char ); + + if ( addr.sun_family != AF_UNIX ) { + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_un", + addr.sun_family, + AF_UNIX); + } + e = addr.sun_path; + while (*e && e < addr.sun_path + sizeof addr.sun_path) + ++e; + ST(0) = sv_2mortal(newSVpv(addr.sun_path, e - addr.sun_path)); +#else + ST(0) = (SV *) not_here("unpack_sockaddr_un"); +#endif + } + +void +pack_sockaddr_in(port,ip_address) + unsigned short port + char * ip_address + CODE: + { + struct sockaddr_in sin; + + Zero( &sin, sizeof sin, char ); + sin.sin_family = AF_INET; + sin.sin_port = htons(port); + Copy( ip_address, &sin.sin_addr, sizeof sin.sin_addr, char ); + + ST(0) = sv_2mortal(newSVpv((char *)&sin, sizeof sin)); + } + +void +unpack_sockaddr_in(sin_sv) + SV * sin_sv + PPCODE: + { + STRLEN sockaddrlen; + struct sockaddr_in addr; + unsigned short port; + struct in_addr ip_address; + char * sin = SvPV(sin_sv,sockaddrlen); + if (sockaddrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_sockaddr_in", + sockaddrlen, sizeof(addr)); + } + Copy( sin, &addr,sizeof addr, char ); + if ( addr.sin_family != AF_INET ) { + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_in", + addr.sin_family, + AF_INET); + } + port = ntohs(addr.sin_port); + ip_address = addr.sin_addr; + + EXTEND(SP, 2); + PUSHs(sv_2mortal(newSViv((IV) port))); + PUSHs(sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address))); + } + +void +INADDR_ANY() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_ANY); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address )); + } + +void +INADDR_LOOPBACK() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_LOOPBACK); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + } + +void +INADDR_NONE() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_NONE); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + } + +void +INADDR_BROADCAST() + CODE: + { + struct in_addr ip_address; + ip_address.s_addr = htonl(INADDR_BROADCAST); + ST(0) = sv_2mortal(newSVpv((char *)&ip_address,sizeof ip_address)); + } diff --git a/contrib/perl5/ext/Thread/Makefile.PL b/contrib/perl5/ext/Thread/Makefile.PL new file mode 100644 index 00000000000..e252d4e6c38 --- /dev/null +++ b/contrib/perl5/ext/Thread/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Thread', + VERSION_FROM => 'Thread.pm', + MAN3PODS => ' ' + ); + diff --git a/contrib/perl5/ext/Thread/Notes b/contrib/perl5/ext/Thread/Notes new file mode 100644 index 00000000000..1505877ee9d --- /dev/null +++ b/contrib/perl5/ext/Thread/Notes @@ -0,0 +1,13 @@ +Should cvcache be per CV (keyed by thread) or per thread (keyed by CV)? + +Maybe ought to protect all SVs by a mutex for SvREFCNT_{dec,inc}, +upgrades and so on. Then use SvMUTEX instead of CvMUTEX for CVs. +On the other hand, people shouldn't expect concurrent operations +on non-lexicals to be safe anyway. + +Probably don't need to bother keeping track of CvOWNER on clones. + +Either @_ needs to be made lexical or other arrangments need to be +made so that some globs (or just *_) are per-thread. + +tokenbuf and buf probably ought to be global protected by a global lock. diff --git a/contrib/perl5/ext/Thread/README b/contrib/perl5/ext/Thread/README new file mode 100644 index 00000000000..a6b22fb4ae6 --- /dev/null +++ b/contrib/perl5/ext/Thread/README @@ -0,0 +1,20 @@ +See the README.threads in the main perl 5.004_xx development +distribution (x >= 50) for details of how to build and use this. +If all else fails, read on. + +If your version of patch can't create a file from scratch, then you'll +need to create an empty thread.h manually first. Perl itself will need +to be built with -DUSE_THREADS yet. If you're using MIT pthreads or +another threads package that needs pthread_init() to be called, then +add -DNEED_PTHREAD_INIT. If you're using a threads library that only +follows one of the old POSIX drafts, then you'll probably need to add +-DOLD_PTHREADS_API. I haven't tested -DOLD_PTHREADS_API properly yet +and I think you may still have to tweak a couple of the mutex calls +to follow the old API. + +This extension is copyright Malcolm Beattie 1995-1997 and is freely +distributable under your choice of the GNU Public License or the +Artistic License (see the main perl distribution). + +Malcolm Beattie +mbeattie@sable.ox.ac.uk diff --git a/contrib/perl5/ext/Thread/Thread.pm b/contrib/perl5/ext/Thread/Thread.pm new file mode 100644 index 00000000000..c8bca0db713 --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread.pm @@ -0,0 +1,185 @@ +package Thread; +require Exporter; +require DynaLoader; +use vars qw($VERSION @ISA @EXPORT); + +$VERSION = "1.0"; + +@ISA = qw(Exporter DynaLoader); +@EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async); + +=head1 NAME + +Thread - multithreading + +=head1 SYNOPSIS + + use Thread; + + my $t = new Thread \&start_sub, @start_args; + + $t->join; + + my $tid = Thread->self->tid; + + my $tlist = Thread->list; + + lock($scalar); + + use Thread 'async'; + + use Thread 'eval'; + +=head1 DESCRIPTION + +The C module provides multithreading support for perl. + +=head1 FUNCTIONS + +=over 8 + +=item new \&start_sub + +=item new \&start_sub, LIST + +C starts a new thread of execution in the referenced subroutine. The +optional list is passed as parameters to the subroutine. Execution +continues in both the subroutine and the code after the C call. + +C returns a thread object representing the newly created +thread. + +=item lock VARIABLE + +C places a lock on a variable until the lock goes out of scope. If +the variable is locked by another thread, the C call will block until +it's available. C is recursive, so multiple calls to C are +safe--the variable will remain locked until the outermost lock on the +variable goes out of scope. + +Locks on variables only affect C calls--they do I affect normal +access to a variable. (Locks on subs are different, and covered in a bit) +If you really, I want locks to block access, then go ahead and tie +them to something and manage this yourself. This is done on purpose. While +managing access to variables is a good thing, perl doesn't force you out of +its living room... + +If a container object, such as a hash or array, is locked, all the elements +of that container are not locked. For example, if a thread does a C, any other thread doing a C won't block. + +You may also C a sub, using C. Any calls to that sub from +another thread will block until the lock is released. This behaviour is not +equvalent to C in the sub. C +serializes access to a subroutine, but allows different threads +non-simultaneous access. C, on the other hand, will not allow +I other thread access for the duration of the lock. + +Finally, C will traverse up references exactly I level. +C is equivalent to C, while C is not. + +=item async BLOCK; + +C creates a thread to execute the block immediately following +it. This block is treated as an anonymous sub, and so must have a +semi-colon after the closing brace. Like C, C returns a +thread object. + +=item Thread->self + +The Cself> function returns a thread object that represents +the thread making the Cself> call. + +=item Thread->list + +Clist> returns a list of thread objects for all running and +finished but un-Ced threads. + +=item cond_wait VARIABLE + +The C function takes a B variable as a parameter, +unlocks the variable, and blocks until another thread does a C +or C for that same locked variable. The variable that +C blocked on is relocked after the C is satisfied. +If there are multiple threads Cing on the same variable, all but +one will reblock waiting to reaquire the lock on the variable. (So if +you're only using C for synchronization, give up the lock as +soon as possible) + +=item cond_signal VARIABLE + +The C function takes a locked variable as a parameter and +unblocks one thread that's Cing on that variable. If more than +one thread is blocked in a C on that variable, only one (and +which one is indeterminate) will be unblocked. + +If there are no threads blocked in a C on the variable, the +signal is discarded. + +=item cond_broadcast VARIABLE + +The C function works similarly to C. +C, though, will unblock B the threads that are blocked +in a C on the locked variable, rather than only one. + +=back + +=head1 METHODS + +=over 8 + +=item join + +C waits for a thread to end and returns any values the thread exited +with. C will block until the thread has ended, though it won't block +if the thread has already terminated. + +If the thread being Ced Cd, the error it died with will be +returned at this time. If you don't want the thread performing the C +to die as well, you should either wrap the C in an C or use the +C thread method instead of C. + +=item eval + +The C method wraps an C around a C, and so waits for a +thread to exit, passing along any values the thread might have returned. +Errors, of course, get placed into C<$@>. + +=item tid + +The C method returns the tid of a thread. The tid is a monotonically +increasing integer assigned when a thread is created. The main thread of a +program will have a tid of zero, while subsequent threads will have tids +assigned starting with one. + +=head1 LIMITATIONS + +The sequence number used to assign tids is a simple integer, and no +checking is done to make sure the tid isn't currently in use. If a program +creates more than 2^32 - 1 threads in a single run, threads may be assigned +duplicate tids. This limitation may be lifted in a future version of Perl. + +=head1 SEE ALSO + +L, L, L, L. + +=cut + +# +# Methods +# + +# +# Exported functions +# +sub async (&) { + return new Thread $_[0]; +} + +sub eval { + return eval { shift->join; }; +} + +bootstrap Thread; + +1; diff --git a/contrib/perl5/ext/Thread/Thread.xs b/contrib/perl5/ext/Thread/Thread.xs new file mode 100644 index 00000000000..48f8aa03fc7 --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread.xs @@ -0,0 +1,641 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* Magic signature for Thread's mg_private is "Th" */ +#define Thread_MAGIC_SIGNATURE 0x5468 + +#ifdef __cplusplus +#ifdef I_UNISTD +#include +#endif +#endif +#include + +static int sig_pipe[2]; + +#ifndef THREAD_RET_TYPE +#define THREAD_RET_TYPE void * +#define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) +#endif + +static void +remove_thread(struct perl_thread *t) +{ +#ifdef USE_THREADS + DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), + "%p: remove_thread %p\n", thr, t))); + MUTEX_LOCK(&PL_threads_mutex); + MUTEX_DESTROY(&t->mutex); + PL_nthreads--; + t->prev->next = t->next; + t->next->prev = t->prev; + COND_BROADCAST(&PL_nthreads_cond); + MUTEX_UNLOCK(&PL_threads_mutex); +#endif +} + +static THREAD_RET_TYPE +threadstart(void *arg) +{ +#ifdef USE_THREADS +#ifdef FAKE_THREADS + Thread savethread = thr; + LOGOP myop; + dSP; + I32 oldscope = PL_scopestack_ix; + I32 retval; + AV *av; + int i; + + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + thr, SvPEEK(TOPs))); + thr = (Thread) arg; + savemark = TOPMARK; + thr->prev = thr->prev_run = savethread; + thr->next = savethread->next; + thr->next_run = savethread->next_run; + savethread->next = savethread->next_run = thr; + thr->wait_queue = 0; + thr->private = 0; + + /* Now duplicate most of perl_call_sv but with a few twists */ + PL_op = (OP*)&myop; + Zero(PL_op, 1, LOGOP); + myop.op_flags = OPf_STACKED; + myop.op_next = Nullop; + myop.op_flags |= OPf_KNOW; + myop.op_flags |= OPf_WANT_LIST; + PL_op = pp_entersub(ARGS); + DEBUG_S(if (!PL_op) + PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); + /* + * When this thread is next scheduled, we start in the right + * place. When the thread runs off the end of the sub, perl.c + * handles things, using savemark to figure out how much of the + * stack is the return value for any join. + */ + thr = savethread; /* back to the old thread */ + return 0; +#else + Thread thr = (Thread) arg; + LOGOP myop; + djSP; + I32 oldmark = TOPMARK; + I32 oldscope = PL_scopestack_ix; + I32 retval; + SV *sv; + AV *av = newAV(); + int i, ret; + dJMPENV; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", + thr)); + + /* Don't call *anything* requiring dTHR until after SET_THR() */ + /* + * Wait until our creator releases us. If we didn't do this, then + * it would be potentially possible for out thread to carry on and + * do stuff before our creator fills in our "self" field. For example, + * if we went and created another thread which tried to JOIN with us, + * then we'd be in a mess. + */ + MUTEX_LOCK(&thr->mutex); + MUTEX_UNLOCK(&thr->mutex); + + /* + * It's safe to wait until now to set the thread-specific pointer + * from our pthread_t structure to our struct perl_thread, since + * we're the only thread who can get at it anyway. + */ + SET_THR(thr); + + /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + thr, SvPEEK(TOPs))); + + sv = POPs; + PUTBACK; + perl_call_sv(sv, G_ARRAY|G_EVAL); + SPAGAIN; + retval = SP - (PL_stack_base + oldmark); + SP = PL_stack_base + oldmark + 1; + if (SvCUR(thr->errsv)) { + MUTEX_LOCK(&thr->mutex); + thr->flags |= THRf_DID_DIE; + MUTEX_UNLOCK(&thr->mutex); + av_store(av, 0, &PL_sv_no); + av_store(av, 1, newSVsv(thr->errsv)); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", + thr, SvPV(thr->errsv, PL_na))); + } else { + DEBUG_S(STMT_START { + for (i = 1; i <= retval; i++) { + PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", + thr, i, SvPEEK(SP[i - 1])); + } + } STMT_END); + av_store(av, 0, &PL_sv_yes); + for (i = 1; i <= retval; i++, SP++) + sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP)); + } + + finishoff: +#if 0 + /* removed for debug */ + SvREFCNT_dec(PL_curstack); +#endif + SvREFCNT_dec(thr->cvcache); + SvREFCNT_dec(thr->threadsv); + SvREFCNT_dec(thr->specific); + SvREFCNT_dec(thr->errsv); + SvREFCNT_dec(thr->errhv); + + /*Safefree(cxstack);*/ + while (PL_curstackinfo->si_next) + PL_curstackinfo = PL_curstackinfo->si_next; + while (PL_curstackinfo) { + PERL_SI *p = PL_curstackinfo->si_prev; + SvREFCNT_dec(PL_curstackinfo->si_stack); + Safefree(PL_curstackinfo->si_cxstack); + Safefree(PL_curstackinfo); + PL_curstackinfo = p; + } + Safefree(PL_markstack); + Safefree(PL_scopestack); + Safefree(PL_savestack); + Safefree(PL_retstack); + Safefree(PL_tmps_stack); + Safefree(PL_ofs); + + SvREFCNT_dec(PL_rs); + SvREFCNT_dec(PL_nrs); + SvREFCNT_dec(PL_statname); + Safefree(PL_screamfirst); + Safefree(PL_screamnext); + Safefree(PL_reg_start_tmp); + SvREFCNT_dec(PL_lastscream); + /*SvREFCNT_dec(PL_defoutgv);*/ + + MUTEX_LOCK(&thr->mutex); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: threadstart finishing: state is %u\n", + thr, ThrSTATE(thr))); + switch (ThrSTATE(thr)) { + case THRf_R_JOINABLE: + ThrSETSTATE(thr, THRf_ZOMBIE); + MUTEX_UNLOCK(&thr->mutex); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: R_JOINABLE thread finished\n", thr)); + break; + case THRf_R_JOINED: + ThrSETSTATE(thr, THRf_DEAD); + MUTEX_UNLOCK(&thr->mutex); + remove_thread(thr); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: R_JOINED thread finished\n", thr)); + break; + case THRf_R_DETACHED: + ThrSETSTATE(thr, THRf_DEAD); + MUTEX_UNLOCK(&thr->mutex); + SvREFCNT_dec(av); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: DETACHED thread finished\n", thr)); + remove_thread(thr); /* This might trigger main thread to finish */ + break; + default: + MUTEX_UNLOCK(&thr->mutex); + croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr)); + /* NOTREACHED */ + } + return THREAD_RET_CAST(av); /* Available for anyone to join with */ + /* us unless we're detached, in which */ + /* case noone sees the value anyway. */ +#endif +#else + return THREAD_RET_CAST(NULL); +#endif +} + +static SV * +newthread (SV *startsv, AV *initargs, char *classname) +{ +#ifdef USE_THREADS + dSP; + Thread savethread; + int i; + SV *sv; + int err; +#ifndef THREAD_CREATE + static pthread_attr_t attr; + static int attr_inited = 0; + sigset_t fullmask, oldmask; +#endif + + savethread = thr; + thr = new_struct_thread(thr); + SPAGAIN; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: newthread (%p), tid is %u, preparing stack\n", + savethread, thr, thr->tid)); + /* The following pushes the arg list and startsv onto the *new* stack */ + PUSHMARK(SP); + /* Could easily speed up the following greatly */ + for (i = 0; i <= AvFILL(initargs); i++) + XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); + XPUSHs(SvREFCNT_inc(startsv)); + PUTBACK; +#ifdef THREAD_CREATE + err = THREAD_CREATE(thr, threadstart); +#else + /* On your marks... */ + MUTEX_LOCK(&thr->mutex); + /* Get set... */ + sigfillset(&fullmask); + if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) + croak("panic: sigprocmask"); + err = 0; + if (!attr_inited) { + attr_inited = 1; +#ifdef OLD_PTHREADS_API + err = pthread_attr_create(&attr); +#else + err = pthread_attr_init(&attr); +#endif +#ifdef OLD_PTHREADS_API +#ifdef VMS +/* This is available with the old pthreads API, but only with */ +/* DecThreads (VMS and Digital Unix) */ + if (err == 0) + err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE); +#endif +#else + if (err == 0) + err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE); +#endif + } + if (err == 0) +#ifdef OLD_PTHREADS_API + err = pthread_create(&thr->self, attr, threadstart, (void*) thr); +#else + err = pthread_create(&thr->self, &attr, threadstart, (void*) thr); +#endif + /* Go */ + MUTEX_UNLOCK(&thr->mutex); +#endif + if (err) { + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: create of %p failed %d\n", + savethread, thr, err)); + /* Thread creation failed--clean up */ + SvREFCNT_dec(thr->cvcache); + remove_thread(thr); + MUTEX_DESTROY(&thr->mutex); + for (i = 0; i <= AvFILL(initargs); i++) + SvREFCNT_dec(*av_fetch(initargs, i, FALSE)); + SvREFCNT_dec(startsv); + return NULL; + } +#ifdef THREAD_POST_CREATE + THREAD_POST_CREATE(thr); +#else + if (sigprocmask(SIG_SETMASK, &oldmask, 0)) + croak("panic: sigprocmask"); +#endif + sv = newSViv(thr->tid); + sv_magic(sv, thr->oursv, '~', 0, 0); + SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; + return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); +#else + croak("No threads in this perl"); + return &PL_sv_undef; +#endif +} + +static Signal_t handle_thread_signal _((int sig)); + +static Signal_t +handle_thread_signal(int sig) +{ + unsigned char c = (unsigned char) sig; + /* + * We're not really allowed to call fprintf in a signal handler + * so don't be surprised if this isn't robust while debugging + * with -DL. + */ + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "handle_thread_signal: got signal %d\n", sig);); + write(sig_pipe[1], &c, 1); +} + +MODULE = Thread PACKAGE = Thread +PROTOTYPES: DISABLE + +void +new(classname, startsv, ...) + char * classname + SV * startsv + AV * av = av_make(items - 2, &ST(2)); + PPCODE: + XPUSHs(sv_2mortal(newthread(startsv, av, classname))); + +void +join(t) + Thread t + AV * av = NO_INIT + int i = NO_INIT + PPCODE: +#ifdef USE_THREADS + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", + thr, t, ThrSTATE(t));); + MUTEX_LOCK(&t->mutex); + switch (ThrSTATE(t)) { + case THRf_R_JOINABLE: + case THRf_R_JOINED: + ThrSETSTATE(t, THRf_R_JOINED); + MUTEX_UNLOCK(&t->mutex); + break; + case THRf_ZOMBIE: + ThrSETSTATE(t, THRf_DEAD); + MUTEX_UNLOCK(&t->mutex); + remove_thread(t); + break; + default: + MUTEX_UNLOCK(&t->mutex); + croak("can't join with thread"); + /* NOTREACHED */ + } + JOIN(t, &av); + + if (SvTRUE(*av_fetch(av, 0, FALSE))) { + /* Could easily speed up the following if necessary */ + for (i = 1; i <= AvFILL(av); i++) + XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); + } else { + char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p: join propagating die message: %s\n", + thr, mess)); + croak(mess); + } +#endif + +void +detach(t) + Thread t + CODE: +#ifdef USE_THREADS + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", + thr, t, ThrSTATE(t));); + MUTEX_LOCK(&t->mutex); + switch (ThrSTATE(t)) { + case THRf_R_JOINABLE: + ThrSETSTATE(t, THRf_R_DETACHED); + /* fall through */ + case THRf_R_DETACHED: + DETACH(t); + MUTEX_UNLOCK(&t->mutex); + break; + case THRf_ZOMBIE: + ThrSETSTATE(t, THRf_DEAD); + DETACH(t); + MUTEX_UNLOCK(&t->mutex); + remove_thread(t); + break; + default: + MUTEX_UNLOCK(&t->mutex); + croak("can't detach thread"); + /* NOTREACHED */ + } +#endif + +void +equal(t1, t2) + Thread t1 + Thread t2 + PPCODE: + PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); + +void +flags(t) + Thread t + PPCODE: +#ifdef USE_THREADS + PUSHs(sv_2mortal(newSViv(t->flags))); +#endif + +void +self(classname) + char * classname + PREINIT: + SV *sv; + PPCODE: +#ifdef USE_THREADS + sv = newSViv(thr->tid); + sv_magic(sv, thr->oursv, '~', 0, 0); + SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; + PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), + gv_stashpv(classname, TRUE)))); +#endif + +U32 +tid(t) + Thread t + CODE: +#ifdef USE_THREADS + MUTEX_LOCK(&t->mutex); + RETVAL = t->tid; + MUTEX_UNLOCK(&t->mutex); +#else + RETVAL = 0; +#endif + OUTPUT: + RETVAL + +void +DESTROY(t) + SV * t + PPCODE: + PUSHs(&PL_sv_yes); + +void +yield() + CODE: +{ +#ifdef USE_THREADS + YIELD; +#endif +} + +void +cond_wait(sv) + SV * sv + MAGIC * mg = NO_INIT +CODE: +#ifdef USE_THREADS + if (SvROK(sv)) + sv = SvRV(sv); + + mg = condpair_magic(sv); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) != thr) { + MUTEX_UNLOCK(MgMUTEXP(mg)); + croak("cond_wait for lock that we don't own\n"); + } + MgOWNER(mg) = 0; + COND_WAIT(MgCONDP(mg), MgMUTEXP(mg)); + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + MUTEX_UNLOCK(MgMUTEXP(mg)); +#endif + +void +cond_signal(sv) + SV * sv + MAGIC * mg = NO_INIT +CODE: +#ifdef USE_THREADS + if (SvROK(sv)) + sv = SvRV(sv); + + mg = condpair_magic(sv); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) != thr) { + MUTEX_UNLOCK(MgMUTEXP(mg)); + croak("cond_signal for lock that we don't own\n"); + } + COND_SIGNAL(MgCONDP(mg)); + MUTEX_UNLOCK(MgMUTEXP(mg)); +#endif + +void +cond_broadcast(sv) + SV * sv + MAGIC * mg = NO_INIT +CODE: +#ifdef USE_THREADS + if (SvROK(sv)) + sv = SvRV(sv); + + mg = condpair_magic(sv); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", + thr, sv)); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) != thr) { + MUTEX_UNLOCK(MgMUTEXP(mg)); + croak("cond_broadcast for lock that we don't own\n"); + } + COND_BROADCAST(MgCONDP(mg)); + MUTEX_UNLOCK(MgMUTEXP(mg)); +#endif + +void +list(classname) + char * classname + PREINIT: + Thread t; + AV * av; + SV ** svp; + int n = 0; + PPCODE: +#ifdef USE_THREADS + av = newAV(); + /* + * Iterate until we have enough dynamic storage for all threads. + * We mustn't do any allocation while holding threads_mutex though. + */ + MUTEX_LOCK(&PL_threads_mutex); + do { + n = PL_nthreads; + MUTEX_UNLOCK(&PL_threads_mutex); + if (AvFILL(av) < n - 1) { + int i = AvFILL(av); + for (i = AvFILL(av); i < n - 1; i++) { + SV *sv = newSViv(0); /* fill in tid later */ + sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */ + av_push(av, sv_bless(newRV_noinc(sv), + gv_stashpv(classname, TRUE))); + + } + } + MUTEX_LOCK(&PL_threads_mutex); + } while (n < PL_nthreads); + n = PL_nthreads; /* Get the final correct value */ + + /* + * At this point, there's enough room to fill in av. + * Note that we are holding threads_mutex so the list + * won't change out from under us but all the remaining + * processing is "fast" (no blocking, malloc etc.) + */ + t = thr; + svp = AvARRAY(av); + do { + SV *sv = (SV*)SvRV(*svp); + sv_setiv(sv, t->tid); + SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv); + SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED; + SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; + t = t->next; + svp++; + } while (t != thr); + /* */ + MUTEX_UNLOCK(&PL_threads_mutex); + /* Truncate any unneeded slots in av */ + av_fill(av, n - 1); + /* Finally, push all the new objects onto the stack and drop av */ + EXTEND(SP, n); + for (svp = AvARRAY(av); n > 0; n--, svp++) + PUSHs(*svp); + (void)sv_2mortal((SV*)av); +#endif + + +MODULE = Thread PACKAGE = Thread::Signal + +void +kill_sighandler_thread() + PPCODE: + write(sig_pipe[1], "\0", 1); + PUSHs(&PL_sv_yes); + +void +init_thread_signals() + PPCODE: + PL_sighandlerp = handle_thread_signal; + if (pipe(sig_pipe) == -1) + XSRETURN_UNDEF; + PUSHs(&PL_sv_yes); + +void +await_signal() + PREINIT: + unsigned char c; + SSize_t ret; + CODE: + do { + ret = read(sig_pipe[0], &c, 1); + } while (ret == -1 && errno == EINTR); + if (ret == -1) + croak("panic: await_signal"); + ST(0) = sv_newmortal(); + if (ret) + sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "await_signal returning %s\n", SvPEEK(ST(0)));); + +MODULE = Thread PACKAGE = Thread::Specific + +void +data(classname = "Thread::Specific") + char * classname + PPCODE: +#ifdef USE_THREADS + if (AvFILL(thr->specific) == -1) { + GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); + av_store(thr->specific, 0, newRV((SV*)GvHV(gv))); + } + XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE))); +#endif diff --git a/contrib/perl5/ext/Thread/Thread/Queue.pm b/contrib/perl5/ext/Thread/Thread/Queue.pm new file mode 100644 index 00000000000..6d5f82be344 --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread/Queue.pm @@ -0,0 +1,99 @@ +package Thread::Queue; +use Thread qw(cond_wait cond_broadcast); + +=head1 NAME + +Thread::Queue - thread-safe queues + +=head1 SYNOPSIS + + use Thread::Queue; + my $q = new Thread::Queue; + $q->enqueue("foo", "bar"); + my $foo = $q->dequeue; # The "bar" is still in the queue. + my $foo = $q->dequeue_nb; # returns "bar", or undef if the queue was + # empty + my $left = $q->pending; # returns the number of items still in the queue + +=head1 DESCRIPTION + +A queue, as implemented by C is a thread-safe data structure +much like a list. Any number of threads can safely add elements to the end +of the list, or remove elements from the head of the list. (Queues don't +permit adding or removing elements from the middle of the list) + +=head1 FUNCTIONS AND METHODS + +=over 8 + +=item new + +The C function creates a new empty queue. + +=item enqueue LIST + +The C method adds a list of scalars on to the end of the queue. +The queue will grow as needed to accomodate the list. + +=item dequeue + +The C method removes a scalar from the head of the queue and +returns it. If the queue is currently empty, C will block the +thread until another thread Cs a scalar. + +=item dequeue_nb + +The C method, like the C method, removes a scalar from +the head of the queue and returns it. Unlike C, though, +C won't block if the queue is empty, instead returning +C. + +=item pending + +The C method returns the number of items still in the queue. (If +there can be multiple readers on the queue it's best to lock the queue +before checking to make sure that it stays in a consistent state) + +=back + +=head1 SEE ALSO + +L + +=cut + +sub new { + my $class = shift; + return bless [@_], $class; +} + +sub dequeue { + use attrs qw(locked method); + my $q = shift; + cond_wait $q until @$q; + return shift @$q; +} + +sub dequeue_nb { + use attrs qw(locked method); + my $q = shift; + if (@$q) { + return shift @$q; + } else { + return undef; + } +} + +sub enqueue { + use attrs qw(locked method); + my $q = shift; + push(@$q, @_) and cond_broadcast $q; +} + +sub pending { + use attrs qw(locked method); + my $q = shift; + return scalar(@$q); +} + +1; diff --git a/contrib/perl5/ext/Thread/Thread/Semaphore.pm b/contrib/perl5/ext/Thread/Thread/Semaphore.pm new file mode 100644 index 00000000000..915808cbed7 --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread/Semaphore.pm @@ -0,0 +1,87 @@ +package Thread::Semaphore; +use Thread qw(cond_wait cond_broadcast); + +=head1 NAME + +Thread::Semaphore - thread-safe semaphores + +=head1 SYNOPSIS + + use Thread::Semaphore; + my $s = new Thread::Semaphore; + $s->up; # Also known as the semaphore V -operation. + # The guarded section is here + $s->down; # Also known as the semaphore P -operation. + + # The default semaphore value is 1. + my $s = new Thread::Semaphore($initial_value); + $s->up($up_value); + $s->down($up_value); + +=head1 DESCRIPTION + +Semaphores provide a mechanism to regulate access to resources. Semaphores, +unlike locks, aren't tied to particular scalars, and so may be used to +control access to anything you care to use them for. + +Semaphores don't limit their values to zero or one, so they can be used to +control access to some resource that may have more than one of. (For +example, filehandles) Increment and decrement amounts aren't fixed at one +either, so threads can reserve or return multiple resources at once. + +=head1 FUNCTIONS AND METHODS + +=over 8 + +=item new + +=item new NUMBER + +C creates a new semaphore, and initializes its count to the passed +number. If no number is passed, the semaphore's count is set to one. + +=item down + +=item down NUMBER + +The C method decreases the semaphore's count by the specified number, +or one if no number has been specified. If the semaphore's count would drop +below zero, this method will block until such time that the semaphore's +count is equal to or larger than the amount you're Cing the +semaphore's count by. + +=item up + +=item up NUMBER + +The C method increases the semaphore's count by the number specified, +or one if no number's been specified. This will unblock any thread blocked +trying to C the semaphore if the C raises the semaphore count +above what the Cs are trying to decrement it by. + +=back + +=cut + +sub new { + my $class = shift; + my $val = @_ ? shift : 1; + bless \$val, $class; +} + +sub down { + use attrs qw(locked method); + my $s = shift; + my $inc = @_ ? shift : 1; + cond_wait $s until $$s >= $inc; + $$s -= $inc; +} + +sub up { + use attrs qw(locked method); + my $s = shift; + my $inc = @_ ? shift : 1; + ($$s += $inc) > 0 and cond_broadcast $s; +} + +1; diff --git a/contrib/perl5/ext/Thread/Thread/Signal.pm b/contrib/perl5/ext/Thread/Thread/Signal.pm new file mode 100644 index 00000000000..f5f03db8a82 --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread/Signal.pm @@ -0,0 +1,50 @@ +package Thread::Signal; +use Thread qw(async); + +=head1 NAME + +Thread::Signal - Start a thread which runs signal handlers reliably + +=head1 SYNOPSIS + + use Thread::Signal; + + $SIG{HUP} = \&some_handler; + +=head1 DESCRIPTION + +The C module starts up a special signal handler thread. +All signals to the process are delivered to it and it runs the +associated C<$SIG{FOO}> handlers for them. Without this module, +signals arriving at inopportune moments (such as when perl's internals +are in the middle of updating critical structures) cause the perl +code of the handler to be run unsafely which can cause memory corruption +or worse. + +=head1 BUGS + +This module changes the semantics of signal handling slightly in that +the signal handler is run separately from the main thread (and in +parallel with it). This means that tricks such as calling C from +a signal handler behave differently (and, in particular, can't be +used to exit directly from a system call). + +=cut + +if (!init_thread_signals()) { + require Carp; + Carp::croak("init_thread_signals failed: $!"); +} + +async { + my $sig; + while ($sig = await_signal()) { + &$sig(); + } +}; + +END { + kill_sighandler_thread(); +} + +1; diff --git a/contrib/perl5/ext/Thread/Thread/Specific.pm b/contrib/perl5/ext/Thread/Thread/Specific.pm new file mode 100644 index 00000000000..9c8a66a9e6a --- /dev/null +++ b/contrib/perl5/ext/Thread/Thread/Specific.pm @@ -0,0 +1,29 @@ +package Thread::Specific; + +=head1 NAME + +Thread::Specific - thread-specific keys + +=head1 SYNOPSIS + + use Thread::Specific; + my $k = key_create Thread::Specific; + +=head1 DESCRIPTION + +C returns a unique thread-specific key. + +=cut + +sub import { + use attrs qw(locked method); + require fields; + fields->import(@_); +} + +sub key_create { + use attrs qw(locked method); + return ++$FIELDS{__MAX__}; +} + +1; diff --git a/contrib/perl5/ext/Thread/create.t b/contrib/perl5/ext/Thread/create.t new file mode 100644 index 00000000000..7d6d189e929 --- /dev/null +++ b/contrib/perl5/ext/Thread/create.t @@ -0,0 +1,17 @@ +use Thread; +sub start_here { + my $i; + print "In start_here with args: @_\n"; + for ($i = 1; $i <= 5; $i++) { + print "start_here: $i\n"; + sleep 1; + } +} + +print "Starting new thread now\n"; +$t = new Thread \&start_here, qw(foo bar baz); +print "Started thread $t\n"; +for ($count = 1; $count <= 5; $count++) { + print "main: $count\n"; + sleep 1; +} diff --git a/contrib/perl5/ext/Thread/die.t b/contrib/perl5/ext/Thread/die.t new file mode 100644 index 00000000000..623940579ff --- /dev/null +++ b/contrib/perl5/ext/Thread/die.t @@ -0,0 +1,16 @@ +use Thread 'async'; + +$t = async { + print "here\n"; + die "success"; + print "shouldn't get here\n"; +}; + +sleep 1; +print "joining...\n"; +eval { @r = $t->join; }; +if ($@) { + print "thread died with message: $@"; +} else { + print "thread failed to die successfully\n"; +} diff --git a/contrib/perl5/ext/Thread/die2.t b/contrib/perl5/ext/Thread/die2.t new file mode 100644 index 00000000000..f6b695520f9 --- /dev/null +++ b/contrib/perl5/ext/Thread/die2.t @@ -0,0 +1,16 @@ +use Thread 'async'; + +$t = async { + sleep 1; + print "here\n"; + die "success if preceded by 'thread died...'"; + print "shouldn't get here\n"; +}; + +print "joining...\n"; +@r = eval { $t->join; }; +if ($@) { + print "thread died with message: $@"; +} else { + print "thread failed to die successfully\n"; +} diff --git a/contrib/perl5/ext/Thread/io.t b/contrib/perl5/ext/Thread/io.t new file mode 100644 index 00000000000..6012008ef57 --- /dev/null +++ b/contrib/perl5/ext/Thread/io.t @@ -0,0 +1,39 @@ +use Thread; + +sub counter { +$count = 10; +while ($count--) { + sleep 1; + print "ping $count\n"; +} +} + +sub reader { + my $line; + while ($line = ) { + print "reader: $line"; + } + print "End of input in reader\n"; + return 0; +} + +print <<'EOT'; +This test starts up a thread to read and echo whatever is typed on +the keyboard/stdin, line by line, while the main thread counts down +to zero. The test stays running until both the main thread has +finished counting down and the I/O thread has seen end-of-file on +the terminal/stdin. +EOT + +$r = new Thread \&counter; + +&reader; + +__END__ + + +$count = 10; +while ($count--) { + sleep 1; + print "ping $count\n"; +} diff --git a/contrib/perl5/ext/Thread/join.t b/contrib/perl5/ext/Thread/join.t new file mode 100644 index 00000000000..cba2c1cf567 --- /dev/null +++ b/contrib/perl5/ext/Thread/join.t @@ -0,0 +1,11 @@ +use Thread; +sub foo { + print "In foo with args: @_\n"; + return (7, 8, 9); +} + +print "Starting thread\n"; +$t = new Thread \&foo, qw(foo bar baz); +print "Joining with $t\n"; +@results = $t->join(); +print "Joining returned ", scalar(@results), " values: @results\n"; diff --git a/contrib/perl5/ext/Thread/join2.t b/contrib/perl5/ext/Thread/join2.t new file mode 100644 index 00000000000..99b43a54dc5 --- /dev/null +++ b/contrib/perl5/ext/Thread/join2.t @@ -0,0 +1,12 @@ +use Thread; +sub foo { + print "In foo with args: @_\n"; + return (7, 8, 9); +} + +print "Starting thread\n"; +$t = new Thread \&foo, qw(foo bar baz); +sleep 2; +print "Joining with $t\n"; +@results = $t->join(); +print "Joining returned @results\n"; diff --git a/contrib/perl5/ext/Thread/list.t b/contrib/perl5/ext/Thread/list.t new file mode 100644 index 00000000000..f13f4b266a4 --- /dev/null +++ b/contrib/perl5/ext/Thread/list.t @@ -0,0 +1,30 @@ +use Thread qw(async); +use Thread::Semaphore; + +my $sem = Thread::Semaphore->new(0); + +$nthreads = 4; + +for (my $i = 0; $i < $nthreads; $i++) { + async { + my $tid = Thread->self->tid; + print "thread $tid started...\n"; + $sem->down; + print "thread $tid finishing\n"; + }; +} + +print "main: started $nthreads threads\n"; +sleep 2; + +my @list = Thread->list; +printf "main: Thread->list returned %d threads\n", scalar(@list); + +foreach my $t (@list) { + print "inspecting thread $t...\n"; + print "...deref is $$t\n"; + print "...flags = ", $t->flags, "\n"; + print "...tid = ", $t->tid, "\n"; +} +print "main thread telling workers to finish off...\n"; +$sem->up($nthreads); diff --git a/contrib/perl5/ext/Thread/lock.t b/contrib/perl5/ext/Thread/lock.t new file mode 100644 index 00000000000..fefb1298797 --- /dev/null +++ b/contrib/perl5/ext/Thread/lock.t @@ -0,0 +1,27 @@ +use Thread; + +$level = 0; + +sub worker +{ + my $num = shift; + my $i; + print "thread $num starting\n"; + for ($i = 1; $i <= 20; $i++) { + print "thread $num iteration $i\n"; + select(undef, undef, undef, rand(10)/100); + { + lock($lock); + warn "thread $num saw non-zero level = $level\n" if $level; + $level++; + print "thread $num has lock\n"; + select(undef, undef, undef, rand(10)/100); + $level--; + } + print "thread $num released lock\n"; + } +} + +for ($t = 1; $t <= 5; $t++) { + new Thread \&worker, $t; +} diff --git a/contrib/perl5/ext/Thread/queue.t b/contrib/perl5/ext/Thread/queue.t new file mode 100644 index 00000000000..4672ba6ee74 --- /dev/null +++ b/contrib/perl5/ext/Thread/queue.t @@ -0,0 +1,36 @@ +use Thread; +use Thread::Queue; + +$q = new Thread::Queue; + +sub reader { + my $tid = Thread->self->tid; + my $i = 0; + while (1) { + $i++; + print "reader (tid $tid): waiting for element $i...\n"; + my $el = $q->dequeue; + print "reader (tid $tid): dequeued element $i: value $el\n"; + select(undef, undef, undef, rand(2)); + if ($el == -1) { + # end marker + print "reader (tid $tid) returning\n"; + return; + } + } +} + +my $nthreads = 3; + +for (my $i = 0; $i < $nthreads; $i++) { + Thread->new(\&reader, $i); +} + +for (my $i = 1; $i <= 10; $i++) { + my $el = int(rand(100)); + select(undef, undef, undef, rand(2)); + print "writer: enqueuing value $el\n"; + $q->enqueue($el); +} + +$q->enqueue((-1) x $nthreads); # one end marker for each thread diff --git a/contrib/perl5/ext/Thread/specific.t b/contrib/perl5/ext/Thread/specific.t new file mode 100644 index 00000000000..da130b1d64c --- /dev/null +++ b/contrib/perl5/ext/Thread/specific.t @@ -0,0 +1,17 @@ +use Thread; + +use Thread::Specific qw(foo); + +sub count { + my $tid = Thread->self->tid; + my Thread::Specific $tsd = Thread::Specific::data; + for (my $i = 0; $i < 5; $i++) { + $tsd->{foo} = $i; + print "thread $tid count: $tsd->{foo}\n"; + select(undef, undef, undef, rand(2)); + } +}; + +for(my $t = 0; $t < 5; $t++) { + new Thread \&count; +} diff --git a/contrib/perl5/ext/Thread/sync.t b/contrib/perl5/ext/Thread/sync.t new file mode 100644 index 00000000000..9c2e5897da5 --- /dev/null +++ b/contrib/perl5/ext/Thread/sync.t @@ -0,0 +1,61 @@ +use Thread; + +$level = 0; + +sub single_file { + use attrs 'locked'; + my $arg = shift; + $level++; + print "Level $level for $arg\n"; + print "(something is wrong)\n" if $level < 0 || $level > 1; + sleep 1; + $level--; + print "Back to level $level\n"; +} + +sub start_bar { + my $i; + print "start bar\n"; + for $i (1..3) { + print "bar $i\n"; + single_file("bar $i"); + sleep 1 if rand > 0.5; + } + print "end bar\n"; + return 1; +} + +sub start_foo { + my $i; + print "start foo\n"; + for $i (1..3) { + print "foo $i\n"; + single_file("foo $i"); + sleep 1 if rand > 0.5; + } + print "end foo\n"; + return 1; +} + +sub start_baz { + my $i; + print "start baz\n"; + for $i (1..3) { + print "baz $i\n"; + single_file("baz $i"); + sleep 1 if rand > 0.5; + } + print "end baz\n"; + return 1; +} + +$| = 1; +srand($$^$^T); + +$foo = new Thread \&start_foo; +$bar = new Thread \&start_bar; +$baz = new Thread \&start_baz; +$foo->join(); +$bar->join(); +$baz->join(); +print "main: threads finished, exiting\n"; diff --git a/contrib/perl5/ext/Thread/sync2.t b/contrib/perl5/ext/Thread/sync2.t new file mode 100644 index 00000000000..0901da46a0a --- /dev/null +++ b/contrib/perl5/ext/Thread/sync2.t @@ -0,0 +1,69 @@ +use Thread; + +$global = undef; + +sub single_file { + use attrs 'locked'; + my $who = shift; + my $i; + + print "Uh oh: $who entered while locked by $global\n" if $global; + $global = $who; + print "["; + for ($i = 0; $i < int(10 * rand); $i++) { + print $who; + select(undef, undef, undef, 0.1); + } + print "]"; + $global = undef; +} + +sub start_a { + my ($i, $j); + for ($j = 0; $j < 10; $j++) { + single_file("A"); + for ($i = 0; $i < int(10 * rand); $i++) { + print "a"; + select(undef, undef, undef, 0.1); + } + } +} + +sub start_b { + my ($i, $j); + for ($j = 0; $j < 10; $j++) { + single_file("B"); + for ($i = 0; $i < int(10 * rand); $i++) { + print "b"; + select(undef, undef, undef, 0.1); + } + } +} + +sub start_c { + my ($i, $j); + for ($j = 0; $j < 10; $j++) { + single_file("C"); + for ($i = 0; $i < int(10 * rand); $i++) { + print "c"; + select(undef, undef, undef, 0.1); + } + } +} + +$| = 1; +srand($$^$^T); + +print <<'EOT'; +Each pair of square brackets [...] should contain a repeated sequence of +a unique upper case letter. Lower case letters may appear randomly both +in and out of the brackets. +EOT +$foo = new Thread \&start_a; +$bar = new Thread \&start_b; +$baz = new Thread \&start_c; +print "\nmain: joining...\n"; +#$foo->join; +#$bar->join; +#$baz->join; +print "\ndone\n"; diff --git a/contrib/perl5/ext/Thread/typemap b/contrib/perl5/ext/Thread/typemap new file mode 100644 index 00000000000..21eb6c32409 --- /dev/null +++ b/contrib/perl5/ext/Thread/typemap @@ -0,0 +1,24 @@ +Thread T_XSCPTR + +INPUT +T_XSCPTR + STMT_START { + MAGIC *mg; + SV *sv = ($arg); + + if (!sv_isobject(sv)) + croak(\"$var is not an object\"); + sv = (SV*)SvRV(sv); + if (!SvRMAGICAL(sv) || !(mg = mg_find(sv, '~')) + || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) + croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); + $var = ($type) SvPVX(mg->mg_obj); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + \"XSUB ${func_name}: %p\\n\", $var);) + } STMT_END +T_IVREF + if (SvROK($arg)) + $var = ($type) SvIV((SV*)SvRV($arg)); + else + croak(\"$var is not a reference\") + diff --git a/contrib/perl5/ext/Thread/unsync.t b/contrib/perl5/ext/Thread/unsync.t new file mode 100644 index 00000000000..f0a51efe1f7 --- /dev/null +++ b/contrib/perl5/ext/Thread/unsync.t @@ -0,0 +1,37 @@ +use Thread; + +$| = 1; + +if (@ARGV) { + srand($ARGV[0]); +} else { + my $seed = $$ ^ $^T; + print "Randomising to $seed\n"; + srand($seed); +} + +sub whoami { + my ($depth, $a, $b, $c) = @_; + my $i; + print "whoami ($depth): $a $b $c\n"; + sleep 1; + whoami($depth - 1, $a, $b, $c) if $depth > 0; +} + +sub start_foo { + my $r = 3 + int(10 * rand); + print "start_foo: r is $r\n"; + whoami($r, "start_foo", "foo1", "foo2"); + print "start_foo: finished\n"; +} + +sub start_bar { + my $r = 3 + int(10 * rand); + print "start_bar: r is $r\n"; + whoami($r, "start_bar", "bar1", "bar2"); + print "start_bar: finished\n"; +} + +$foo = new Thread \&start_foo; +$bar = new Thread \&start_bar; +print "main: exiting\n"; diff --git a/contrib/perl5/ext/Thread/unsync2.t b/contrib/perl5/ext/Thread/unsync2.t new file mode 100644 index 00000000000..fb955ac31e1 --- /dev/null +++ b/contrib/perl5/ext/Thread/unsync2.t @@ -0,0 +1,36 @@ +use Thread; + +$| = 1; + +srand($$^$^T); + +sub printargs { + my $thread = shift; + my $arg; + my $i; + while ($arg = shift) { + my $delay = int(rand(500)); + $i++; + print "$thread arg $i is $arg\n"; + 1 while $delay--; + } +} + +sub start_thread { + my $thread = shift; + my $count = 10; + while ($count--) { + my(@args) = ($thread) x int(rand(10)); + print "$thread $count calling printargs @args\n"; + printargs($thread, @args); + } +} + +new Thread (\&start_thread, "A"); +new Thread (\&start_thread, "B"); +#new Thread (\&start_thread, "C"); +#new Thread (\&start_thread, "D"); +#new Thread (\&start_thread, "E"); +#new Thread (\&start_thread, "F"); + +print "main: exiting\n"; diff --git a/contrib/perl5/ext/Thread/unsync3.t b/contrib/perl5/ext/Thread/unsync3.t new file mode 100644 index 00000000000..e03e9c8af10 --- /dev/null +++ b/contrib/perl5/ext/Thread/unsync3.t @@ -0,0 +1,50 @@ +use Thread; + +$| = 1; + +srand($$^$^T); + +sub whoami { + my $thread = shift; + print $thread; +} + +sub uppercase { + my $count = 100; + while ($count--) { + my $i = int(rand(1000)); + 1 while $i--; + print "A"; + $i = int(rand(1000)); + 1 while $i--; + whoami("B"); + } +} + +sub lowercase { + my $count = 100; + while ($count--) { + my $i = int(rand(1000)); + 1 while $i--; + print "x"; + $i = int(rand(1000)); + 1 while $i--; + whoami("y"); + } +} + +sub numbers { + my $count = 100; + while ($count--) { + my $i = int(rand(1000)); + 1 while $i--; + print 1; + $i = int(rand(1000)); + 1 while $i--; + whoami(2); + } +} + +new Thread \&numbers; +new Thread \&uppercase; +new Thread \&lowercase; diff --git a/contrib/perl5/ext/Thread/unsync4.t b/contrib/perl5/ext/Thread/unsync4.t new file mode 100644 index 00000000000..494ad2be920 --- /dev/null +++ b/contrib/perl5/ext/Thread/unsync4.t @@ -0,0 +1,38 @@ +use Thread; + +$| = 1; + +srand($$^$^T); + +sub printargs { + my(@copyargs) = @_; + my $thread = shift @copyargs; + my $arg; + my $i; + while ($arg = shift @copyargs) { + my $delay = int(rand(500)); + $i++; + print "$thread arg $i is $arg\n"; + 1 while $delay--; + } +} + +sub start_thread { + my(@threadargs) = @_; + my $thread = $threadargs[0]; + my $count = 10; + while ($count--) { + my(@args) = ($thread) x int(rand(10)); + print "$thread $count calling printargs @args\n"; + printargs($thread, @args); + } +} + +new Thread (\&start_thread, "A"); +new Thread (\&start_thread, "B"); +new Thread (\&start_thread, "C"); +new Thread (\&start_thread, "D"); +new Thread (\&start_thread, "E"); +new Thread (\&start_thread, "F"); + +print "main: exiting\n"; diff --git a/contrib/perl5/ext/attrs/Makefile.PL b/contrib/perl5/ext/attrs/Makefile.PL new file mode 100644 index 00000000000..c4217576154 --- /dev/null +++ b/contrib/perl5/ext/attrs/Makefile.PL @@ -0,0 +1,7 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'attrs', + VERSION_FROM => 'attrs.pm', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes' +); diff --git a/contrib/perl5/ext/attrs/attrs.pm b/contrib/perl5/ext/attrs/attrs.pm new file mode 100644 index 00000000000..fe2bf356e4f --- /dev/null +++ b/contrib/perl5/ext/attrs/attrs.pm @@ -0,0 +1,55 @@ +package attrs; +require DynaLoader; +use vars '@ISA'; +@ISA = 'DynaLoader'; + +use vars qw($VERSION); +$VERSION = "1.0"; + +=head1 NAME + +attrs - set/get attributes of a subroutine + +=head1 SYNOPSIS + + sub foo { + use attrs qw(locked method); + ... + } + + @a = attrs::get(\&foo); + +=head1 DESCRIPTION + +This module lets you set and get attributes for subroutines. +Setting attributes takes place at compile time; trying to set +invalid attribute names causes a compile-time error. Calling +C on a subroutine reference or name returns its list +of attribute names. Notice that C is not exported. +Valid attributes are as follows. + +=over + +=item method + +Indicates that the invoking subroutine is a method. + +=item locked + +Setting this attribute is only meaningful when the subroutine or +method is to be called by multiple threads. When set on a method +subroutine (i.e. one marked with the B attribute above), +perl ensures that any invocation of it implicitly locks its first +argument before execution. When set on a non-method subroutine, +perl ensures that a lock is taken on the subroutine itself before +execution. The semantics of the lock are exactly those of one +explicitly taken with the C operator immediately after the +subroutine is entered. + +=back + +=cut + +bootstrap attrs $VERSION; + +1; diff --git a/contrib/perl5/ext/attrs/attrs.xs b/contrib/perl5/ext/attrs/attrs.xs new file mode 100644 index 00000000000..da952d5a3f1 --- /dev/null +++ b/contrib/perl5/ext/attrs/attrs.xs @@ -0,0 +1,59 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static cv_flags_t +get_flag(char *attr) +{ + if (strnEQ(attr, "method", 6)) + return CVf_METHOD; + else if (strnEQ(attr, "locked", 6)) + return CVf_LOCKED; + else + return 0; +} + +MODULE = attrs PACKAGE = attrs + +void +import(Class, ...) +char * Class + ALIAS: + unimport = 1 + PREINIT: + int i; + CV *cv; + PPCODE: + if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv))) + croak("can't set attributes outside a subroutine scope"); + for (i = 1; i < items; i++) { + char *attr = SvPV(ST(i), PL_na); + cv_flags_t flag = get_flag(attr); + if (!flag) + croak("invalid attribute name %s", attr); + if (ix) + CvFLAGS(cv) &= ~flag; + else + CvFLAGS(cv) |= flag; + } + +void +get(sub) +SV * sub + PPCODE: + if (SvROK(sub)) { + sub = SvRV(sub); + if (SvTYPE(sub) != SVt_PVCV) + sub = Nullsv; + } + else { + char *name = SvPV(sub, PL_na); + sub = (SV*)perl_get_cv(name, FALSE); + } + if (!sub) + croak("invalid subroutine reference or name"); + if (CvFLAGS(sub) & CVf_METHOD) + XPUSHs(sv_2mortal(newSVpv("method", 0))); + if (CvFLAGS(sub) & CVf_LOCKED) + XPUSHs(sv_2mortal(newSVpv("locked", 0))); + diff --git a/contrib/perl5/ext/re/Makefile.PL b/contrib/perl5/ext/re/Makefile.PL new file mode 100644 index 00000000000..9ed83d17c84 --- /dev/null +++ b/contrib/perl5/ext/re/Makefile.PL @@ -0,0 +1,41 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 're', + VERSION_FROM => 're.pm', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', + OBJECT => 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)', + DEFINE => '-DPERL_EXT_RE_BUILD', + clean => { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' }, +); + +sub MY::postamble { + if ($^O eq 'VMS') { + return <<'VMS_EOF'; +re_comp.c : [--]regcomp.c + - $(RM_F) $(MMS$TARGET_NAME) + $(CP) [--]regcomp.c $(MMS$TARGET_NAME) + +re_comp$(OBJ_EXT) : re_comp.c + +re_exec.c : [--]regexec.c + - $(RM_F) $(MMS$TARGET_NAME) + $(CP) [--]regexec.c $(MMS$TARGET_NAME) + +re_exec$(OBJ_EXT) : re_exec.c + + +VMS_EOF + } else { + return <<'EOF'; +re_comp.c: ../../regcomp.c + -$(RM_F) $@ + $(CP) ../../regcomp.c $@ + +re_exec.c: ../../regexec.c + -$(RM_F) $@ + $(CP) ../../regexec.c $@ + +EOF + } +} diff --git a/contrib/perl5/ext/re/hints/mpeix.pl b/contrib/perl5/ext/re/hints/mpeix.pl new file mode 100644 index 00000000000..d1fbb91f8fd --- /dev/null +++ b/contrib/perl5/ext/re/hints/mpeix.pl @@ -0,0 +1,3 @@ +# Fall back to -O optimization to avoid known gcc 2.8.0 -O2 problems on MPE/iX. +# Mark Bixby +$self->{OPTIMIZE} = '-O'; diff --git a/contrib/perl5/ext/re/re.pm b/contrib/perl5/ext/re/re.pm new file mode 100644 index 00000000000..7cea77dd42b --- /dev/null +++ b/contrib/perl5/ext/re/re.pm @@ -0,0 +1,131 @@ +package re; + +$VERSION = 0.02; + +=head1 NAME + +re - Perl pragma to alter regular expression behaviour + +=head1 SYNOPSIS + + use re 'taint'; + ($x) = ($^X =~ /^(.*)$/s); # $x is tainted here + + $pat = '(?{ $foo = 1 })'; + use re 'eval'; + /foo${pat}bar/; # won't fail (when not under -T switch) + + { + no re 'taint'; # the default + ($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here + + no re 'eval'; # the default + /foo${pat}bar/; # disallowed (with or without -T switch) + } + + use re 'debug'; # NOT lexically scoped (as others are) + /^(.*)$/s; # output debugging info during + # compile and run time + + use re 'debugcolor'; # same as 'debug', but with colored output + ... + +(We use $^X in these examples because it's tainted by default.) + +=head1 DESCRIPTION + +When C is in effect, and a tainted string is the target +of a regex, the regex memories (or values returned by the m// operator +in list context) are tainted. This feature is useful when regex operations +on tainted data aren't meant to extract safe substrings, but to perform +other transformations. + +When C is in effect, a regex is allowed to contain +C<(?{ ... })> zero-width assertions even if regular expression contains +variable interpolation. That is normally disallowed, since it is a +potential security risk. Note that this pragma is ignored when the regular +expression is obtained from tainted data, i.e. evaluation is always +disallowed with tainted regular expresssions. See L. + +For the purpose of this pragma, interpolation of precompiled regular +expressions (i.e., the result of C) is I considered variable +interpolation. Thus: + + /foo${pat}bar/ + +I allowed if $pat is a precompiled regular expression, even +if $pat contains C<(?{ ... })> assertions. + +When C is in effect, perl emits debugging messages when +compiling and using regular expressions. The output is the same as that +obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the +B<-Dr> switch. It may be quite voluminous depending on the complexity +of the match. Using C instead of C enables a +form of output that can be used to get a colorful display on terminals +that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a +comma-separated list of C properties to use for highlighting +strings on/off, pre-point part on/off. +See L for additional info. + +The directive C is I, as the +other directives are. It has both compile-time and run-time effects. + +See L. + +=cut + +my %bitmask = ( +taint => 0x00100000, +eval => 0x00200000, +); + +sub setcolor { + eval { # Ignore errors + require Term::Cap; + + my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. + my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later + my @props = split /,/, $props; + + + $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props; + }; + + not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4 + or not defined $ENV{PERL_RE_TC} + or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'"; +} + +sub bits { + my $on = shift; + my $bits = 0; + unless(@_) { + require Carp; + Carp::carp("Useless use of \"re\" pragma"); + } + foreach my $s (@_){ + if ($s eq 'debug' or $s eq 'debugcolor') { + setcolor() if $s eq 'debugcolor'; + require DynaLoader; + @ISA = ('DynaLoader'); + bootstrap re; + install() if $on; + uninstall() unless $on; + next; + } + $bits |= $bitmask{$s} || 0; + } + $bits; +} + +sub import { + shift; + $^H |= bits(1,@_); +} + +sub unimport { + shift; + $^H &= ~ bits(0,@_); +} + +1; diff --git a/contrib/perl5/ext/re/re.xs b/contrib/perl5/ext/re/re.xs new file mode 100644 index 00000000000..7230d626dc2 --- /dev/null +++ b/contrib/perl5/ext/re/re.xs @@ -0,0 +1,46 @@ +/* We need access to debugger hooks */ +#ifndef DEBUGGING +# define DEBUGGING +#endif + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +extern regexp* my_regcomp _((char* exp, char* xend, PMOP* pm)); +extern I32 my_regexec _((regexp* prog, char* stringarg, char* strend, + char* strbeg, I32 minend, SV* screamer, + void* data, U32 flags)); + +static int oldfl; + +#define R_DB 512 + +static void +deinstall(void) +{ + dTHR; + PL_regexecp = ®exec_flags; + PL_regcompp = &pregcomp; + if (!oldfl) + PL_debug &= ~R_DB; +} + +static void +install(void) +{ + dTHR; + PL_colorset = 0; /* Allow reinspection of ENV. */ + PL_regexecp = &my_regexec; + PL_regcompp = &my_regcomp; + oldfl = PL_debug & R_DB; + PL_debug |= R_DB; +} + +MODULE = re PACKAGE = re + +void +install() + +void +deinstall() diff --git a/contrib/perl5/ext/util/make_ext b/contrib/perl5/ext/util/make_ext new file mode 100644 index 00000000000..54caf7dfd8d --- /dev/null +++ b/contrib/perl5/ext/util/make_ext @@ -0,0 +1,141 @@ +#!/bin/sh + +# This script acts as a simple interface for building extensions. +# It primarily used by the perl Makefile: +# +# d_dummy $(dynamic_ext): miniperl preplibrary FORCE +# @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) +# +# It may be deleted in a later release of perl so try to +# avoid using it for other purposes. + +target=$1; shift +extspec=$1; shift +makecmd=$1; shift # Should be something like MAKE=make +passthru="$*" # allow extra macro=value to be passed through +echo "" + +# Previously, $make was taken from config.sh. However, the user might +# instead be running a possibly incompatible make. This might happen if +# the user types "gmake" instead of a plain "make", for example. The +# correct current value of MAKE will come through from the main perl +# makefile as MAKE=/whatever/make in $makecmd. We'll be cautious in +# case third party users of this script (are there any?) don't have the +# MAKE=$(MAKE) argument, which was added after 5.004_03. +case "$makecmd" in +MAKE=*) + eval $makecmd + ;; +*) echo 'ext/util/make_ext: WARNING: Please include MAKE=$(MAKE)' + echo ' in your call to make_ext. See ext/util/make_ext for details.' + exit 1 + ;; +esac + + +case $CONFIG in +'') + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh generated by Configure"; exit 1 + fi + . $TOP/config.sh + ;; +esac + +if test "X$extspec" = X; then + echo "make_ext: no extension specified" + exit 1; +fi + +# The Perl Makefile.SH will expand all extensions to +# lib/auto/X/X.a (or lib/auto/X/Y/Y.a if nested) +# A user wishing to run make_ext might use +# X (or X/Y or X::Y if nested) + +# canonise into X/Y form (pname) +case "$extspec" in +lib*) # Remove lib/auto prefix and /*.* suffix + pname=`echo "$extspec" | sed -e 's:^lib/auto/::' -e 's:/[^/]*\.[^/]*$::' ` ;; +ext*) # Remove ext/ prefix and /pm_to_blib suffix + pname=`echo "$extspec" | sed -e 's:^ext/::' -e 's:/pm_to_blib$::' ` ;; +*::*) # Convert :: to / + pname=`echo "$extspec" | sed -e 's/::/\//g' ` ;; +*) pname="$extspec" ;; +esac +# echo "Converted $extspec to $pname" + +mname=`echo "$pname" | sed -e 's!/!::!g'` +depth=`echo "$pname" | sed -e 's![^/][^/]*!..!g'` +makefile=Makefile +makeargs='' +makeopts='' + +if test ! -d "ext/$pname"; then + echo " Skipping $extspec (directory does not exist)" + exit 0 # not an error ? +fi + + +echo " Making $mname ($target)" + +cd ext/$pname + +# check link type and do any preliminaries +case "$target" in + # convert 'static' or 'dynamic' into 'all LINKTYPE=XXX' +static) makeargs="LINKTYPE=static CCCDLFLAGS=" + target=all + ;; +dynamic) makeargs="LINKTYPE=dynamic"; + target=all + ;; + +nonxs) makeargs=""; + target=all + ;; + +*clean) # If Makefile has been moved to Makefile.old by a make clean + # then use Makefile.old for realclean rather than rebuild it + if test ! -f $makefile -a -f Makefile.old; then + makefile=Makefile.old + makeopts="-f $makefile" + echo "Note: Using Makefile.old" + fi + ;; + +*) # for the time being we are strict about what make_ext is used for + echo "make_ext: unknown make target '$target'"; exit 1 + ;; +'') echo "make_ext: no make target specified (eg static or dynamic)"; exit 1 + ;; +esac + +if test ! -f $makefile ; then + test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL INSTALLDIRS=perl $passthru +fi +if test ! -f $makefile ; then + if test -f Makefile.SH; then + echo "Warning: Writing $makefile from old-style Makefile.SH!" + sh Makefile.SH + else + echo "Warning: No Makefile!" + fi +fi + +case "$target" in +clean) ;; +realclean) ;; +*) # Give makefile an opportunity to rewrite itself. + # reassure users that life goes on... + $MAKE config $passthru || echo "$MAKE config failed, continuing anyway..." + ;; +esac + +$MAKE $makeopts $target $makeargs $passthru || exit + +exit $? diff --git a/contrib/perl5/ext/util/mkbootstrap b/contrib/perl5/ext/util/mkbootstrap new file mode 100644 index 00000000000..6c3a7e10edb --- /dev/null +++ b/contrib/perl5/ext/util/mkbootstrap @@ -0,0 +1,5 @@ +#!../../miniperl -w -I../../lib + +use ExtUtils::MakeMaker; +&mkbootstrap(join(" ",@ARGV)); +exit; diff --git a/contrib/perl5/fakethr.h b/contrib/perl5/fakethr.h new file mode 100644 index 00000000000..098fefea9ec --- /dev/null +++ b/contrib/perl5/fakethr.h @@ -0,0 +1,56 @@ +typedef int perl_mutex; +typedef int perl_key; + +typedef struct perl_thread *perl_os_thread; +/* With fake threads, thr is global(ish) so we don't need dTHR */ +#define dTHR extern int errno + +struct perl_wait_queue { + struct perl_thread * thread; + struct perl_wait_queue * next; +}; +typedef struct perl_wait_queue *perl_cond; + +/* Ask thread.h to include our per-thread extras */ +#define HAVE_THREAD_INTERN +struct thread_intern { + perl_os_thread next_run, prev_run; /* Linked list of runnable threads */ + perl_cond wait_queue; /* Wait queue that we are waiting on */ + IV private; /* Holds data across time slices */ + I32 savemark; /* Holds MARK for thread join values */ +}; + +#define init_thread_intern(t) \ + STMT_START { \ + t->self = (t); \ + (t)->i.next_run = (t)->i.prev_run = (t); \ + (t)->i.wait_queue = 0; \ + (t)->i.private = 0; \ + } STMT_END + +/* + * Note that SCHEDULE() is only callable from pp code (which + * must be expecting to be restarted). We'll have to do + * something a bit different for XS code. + */ + +#define SCHEDULE() return schedule(), PL_op + +#define MUTEX_LOCK(m) +#define MUTEX_UNLOCK(m) +#define MUTEX_INIT(m) +#define MUTEX_DESTROY(m) +#define COND_INIT(c) perl_cond_init(c) +#define COND_SIGNAL(c) perl_cond_signal(c) +#define COND_BROADCAST(c) perl_cond_broadcast(c) +#define COND_WAIT(c, m) \ + STMT_START { \ + perl_cond_wait(c); \ + SCHEDULE(); \ + } STMT_END +#define COND_DESTROY(c) + +#define THREAD_CREATE(t, f) f((t)) +#define THREAD_POST_CREATE(t) NOOP + +#define YIELD NOOP diff --git a/contrib/perl5/form.h b/contrib/perl5/form.h new file mode 100644 index 00000000000..5e74c613fad --- /dev/null +++ b/contrib/perl5/form.h @@ -0,0 +1,26 @@ +/* form.h + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +#define FF_END 0 +#define FF_LINEMARK 1 +#define FF_LITERAL 2 +#define FF_SKIP 3 +#define FF_FETCH 4 +#define FF_CHECKNL 5 +#define FF_CHECKCHOP 6 +#define FF_SPACE 7 +#define FF_HALFSPACE 8 +#define FF_ITEM 9 +#define FF_CHOP 10 +#define FF_LINEGLOB 11 +#define FF_DECIMAL 12 +#define FF_NEWLINE 13 +#define FF_BLANK 14 +#define FF_MORE 15 + diff --git a/contrib/perl5/global.sym b/contrib/perl5/global.sym new file mode 100644 index 00000000000..f3c73fedf14 --- /dev/null +++ b/contrib/perl5/global.sym @@ -0,0 +1,1071 @@ +# Global symbols that need to be hidden in embedded applications. + +# Variables - should not be here but in perlvars.h + +AMG_names +Error +abs_amg +add_amg +add_ass_amg +additem +atan2_amg +band_amg +block_type +bool__amg +bor_amg +bxor_amg +check +compl_amg +concat_amg +concat_ass_amg +cos_amg +dc +dec_amg +di +div_amg +div_ass_amg +do_binmode +ds +eq_amg +exp_amg +expectterm +fallback_amg +fold +fold_locale +freq +ge_amg +gt_amg +inc_amg +init_thread_intern +io_close +know_next +le_amg +log_amg +lshift_amg +lshift_ass_amg +lt_amg +mod_amg +mod_ass_amg +mult_amg +mult_ass_amg +ncmp_amg +ne_amg +neg_amg +new_struct_thread +new_stackinfo +no_aelem +no_dir_func +no_func +no_helem +no_mem +no_modify +no_myglob +no_security +no_sock_func +no_symref +no_usym +no_wrongref +nointrp +nomem +nomethod_amg +not_amg +numer_amg +op_const_sv +op_desc +op_name +opargs +pow_amg +pow_ass_amg +ppaddr +psig_name +psig_ptr +reall_srchlen +regkind +repeat_amg +repeat_ass_amg +rshift_amg +rshift_ass_amg +runops_debug +runops_standard +saw_return +scmp_amg +seq_amg +sge_amg +sgt_amg +sig_name +sig_num +simple +sin_amg +sle_amg +slt_amg +sne_amg +sqrt_amg +string_amg +subtr_amg +subtr_ass_amg +varies +vivify_defelem +vivify_ref +vtbl_amagic +vtbl_amagicelem +vtbl_arylen +vtbl_bm +vtbl_collxfrm +vtbl_dbline +vtbl_defelem +vtbl_env +vtbl_envelem +vtbl_fm +vtbl_glob +vtbl_isa +vtbl_isaelem +vtbl_mglob +vtbl_mutex +vtbl_nkeys +vtbl_pack +vtbl_packelem +vtbl_pos +vtbl_regexp +vtbl_sig +vtbl_sigelem +vtbl_substr +vtbl_sv +vtbl_taint +vtbl_uvar +vtbl_vec +warn_nl +warn_nosemi +warn_reserved +warn_uninit +watchaddr +watchok +yychar +yycheck +yydebug +yydefred +yydgoto +yyerrflag +yygindex +yylen +yylhs +yylval +yyname +yynerrs +yyrindex +yyrule +yysindex +yytable +yyval + +# Functions + +Gv_AMupdate +amagic_call +append_elem +append_list +apply +assertref +av_clear +av_extend +av_fake +av_fetch +av_fill +av_len +av_make +av_pop +av_push +av_reify +av_shift +av_store +av_undef +av_unshift +avhv_exists_ent +avhv_fetch_ent +avhv_iternext +avhv_iterval +avhv_keys +bind_match +block_end +block_gimme +block_start +boot_core_UNIVERSAL +bset_obj_store +byterun +call_list +cando +cast_ulong +check_uni +checkcomma +ck_aelem +ck_anoncode +ck_bitop +ck_concat +ck_delete +ck_eof +ck_eval +ck_exec +ck_exists +ck_ftst +ck_fun +ck_fun_locale +ck_glob +ck_grep +ck_gvconst +ck_index +ck_lengthconst +ck_lfun +ck_listiob +ck_match +ck_null +ck_repeat +ck_require +ck_retarget +ck_rfun +ck_rvconst +ck_scmp +ck_select +ck_shift +ck_sort +ck_spair +ck_split +ck_subr +ck_svconst +ck_trunc +condpair_magic +convert +croak +cv_ckproto +cv_clone +cv_const_sv +cv_undef +cx_dump +cxinc +deb +deb_growlevel +debop +debprofdump +debstack +debstackptrs +delimcpy +deprecate +die +die_where +do_aexec +do_chomp +do_chop +do_close +do_eof +do_exec +do_execfree +do_ipcctl +do_ipcget +do_join +do_kv +do_msgrcv +do_msgsnd +do_open +do_pipe +do_print +do_readline +do_seek +do_semop +do_shmio +do_sprintf +do_sysseek +do_tell +do_trans +do_vecset +do_vop +dofindlabel +dopoptoeval +dounwind +dowantarray +dump_all +dump_eval +dump_fds +dump_form +dump_gv +dump_mstats +dump_op +dump_packsubs +dump_pm +dump_sub +fbm_compile +fbm_instr +fetch_gv +fetch_io +filter_add +filter_del +filter_read +find_script +find_threadsv +fold_constants +force_ident +force_list +force_next +force_word +form +free_tmps +gen_constant_list +get_op_descs +get_op_names +get_no_modify +get_opargs +get_specialsv_list +gp_free +gp_ref +gv_AVadd +gv_HVadd +gv_IOadd +gv_autoload4 +gv_check +gv_efullname +gv_efullname3 +gv_fetchfile +gv_fetchmeth +gv_fetchmethod +gv_fetchmethod_autoload +gv_fetchpv +gv_fullname +gv_fullname3 +gv_init +gv_stashpv +gv_stashpvn +gv_stashsv +hv_clear +hv_delayfree_ent +hv_delete +hv_delete_ent +hv_exists +hv_exists_ent +hv_fetch +hv_fetch_ent +hv_free_ent +hv_iterinit +hv_iterkey +hv_iterkeysv +hv_iternext +hv_iternextsv +hv_iterval +hv_ksplit +hv_magic +hv_stashpv +hv_store +hv_store_ent +hv_undef +ibcmp +ibcmp_locale +ingroup +init_stacks +instr +intro_my +intuit_more +invert +jmaybe +keyword +leave_scope +lex_end +lex_start +linklist +list +listkids +localize +looks_like_number +magic_clear_all_env +magic_clearenv +magic_clearpack +magic_clearsig +magic_existspack +magic_freeregexp +magic_get +magic_getarylen +magic_getdefelem +magic_getglob +magic_getnkeys +magic_getpack +magic_getpos +magic_getsig +magic_getsubstr +magic_gettaint +magic_getuvar +magic_getvec +magic_len +magic_mutexfree +magic_nextpack +magic_set +magic_set_all_env +magic_setamagic +magic_setarylen +magic_setbm +magic_setcollxfrm +magic_setdbline +magic_setdefelem +magic_setenv +magic_setfm +magic_setglob +magic_setisa +magic_setmglob +magic_setnkeys +magic_setpack +magic_setpos +magic_setsig +magic_setsubstr +magic_settaint +magic_setuvar +magic_setvec +magic_sizepack +magic_wipepack +magicname +malloced_size +markstack_grow +mem_collxfrm +mess +mg_clear +mg_copy +mg_find +mg_free +mg_get +mg_length +mg_magical +mg_set +mg_size +mod +modkids +moreswitches +mstats +my +my_bcopy +my_bzero +my_chsize +my_exit +my_failure_exit +my_htonl +my_lstat +my_memcmp +my_memset +my_ntohl +my_pclose +my_popen +my_setenv +my_stat +my_swap +my_unexec +newANONHASH +newANONLIST +newANONSUB +newASSIGNOP +newAV +newAVREF +newBINOP +newCONDOP +newCONSTSUB +newCVREF +newFORM +newFOROP +newGVOP +newGVREF +newGVgen +newHV +newHVREF +newHVhv +newIO +newLISTOP +newLOGOP +newLOOPEX +newLOOPOP +newNULLLIST +newOP +newPMOP +newPROG +newPVOP +newRANGE +newRV +newRV_noinc +newSLICEOP +newSTATEOP +newSUB +newSV +newSVOP +newSVREF +newSViv +newSVnv +newSVpv +newSVpvf +newSVpvn +newSVrv +newSVsv +newUNOP +newWHILEOP +newXS +newXSUB +nextargv +ninstr +no_fh_allowed +no_op +oopsAV +oopsCV +oopsHV +op_free +package +pad_alloc +pad_allocmy +pad_findmy +pad_free +pad_leavemy +pad_reset +pad_sv +pad_swipe +peep +pidgone +pmflag +pmruntime +pmtrans +pop_return +pop_scope +pp_aassign +pp_abs +pp_accept +pp_add +pp_aelem +pp_aelemfast +pp_alarm +pp_and +pp_andassign +pp_anoncode +pp_anonhash +pp_anonlist +pp_aslice +pp_atan2 +pp_av2arylen +pp_backtick +pp_bind +pp_binmode +pp_bit_and +pp_bit_or +pp_bit_xor +pp_bless +pp_caller +pp_chdir +pp_chmod +pp_chomp +pp_chop +pp_chown +pp_chr +pp_chroot +pp_close +pp_closedir +pp_complement +pp_concat +pp_cond_expr +pp_connect +pp_const +pp_cos +pp_crypt +pp_cswitch +pp_dbmclose +pp_dbmopen +pp_dbstate +pp_defined +pp_delete +pp_die +pp_divide +pp_dofile +pp_dump +pp_each +pp_egrent +pp_ehostent +pp_enetent +pp_enter +pp_entereval +pp_enteriter +pp_enterloop +pp_entersub +pp_entersubr +pp_entertry +pp_enterwrite +pp_eof +pp_eprotoent +pp_epwent +pp_eq +pp_eservent +pp_evalonce +pp_exec +pp_exists +pp_exit +pp_exp +pp_fcntl +pp_fileno +pp_flip +pp_flock +pp_flop +pp_fork +pp_formline +pp_ftatime +pp_ftbinary +pp_ftblk +pp_ftchr +pp_ftctime +pp_ftdir +pp_fteexec +pp_fteowned +pp_fteread +pp_ftewrite +pp_ftfile +pp_ftis +pp_ftlink +pp_ftmtime +pp_ftpipe +pp_ftrexec +pp_ftrowned +pp_ftrread +pp_ftrwrite +pp_ftsgid +pp_ftsize +pp_ftsock +pp_ftsuid +pp_ftsvtx +pp_fttext +pp_fttty +pp_ftzero +pp_ge +pp_gelem +pp_getc +pp_getlogin +pp_getpeername +pp_getpgrp +pp_getppid +pp_getpriority +pp_getsockname +pp_ggrent +pp_ggrgid +pp_ggrnam +pp_ghbyaddr +pp_ghbyname +pp_ghostent +pp_glob +pp_gmtime +pp_gnbyaddr +pp_gnbyname +pp_gnetent +pp_goto +pp_gpbyname +pp_gpbynumber +pp_gprotoent +pp_gpwent +pp_gpwnam +pp_gpwuid +pp_grepstart +pp_grepwhile +pp_gsbyname +pp_gsbyport +pp_gservent +pp_gsockopt +pp_gt +pp_gv +pp_gvsv +pp_helem +pp_hex +pp_hslice +pp_i_add +pp_i_divide +pp_i_eq +pp_i_ge +pp_i_gt +pp_i_le +pp_i_lt +pp_i_modulo +pp_i_multiply +pp_i_ncmp +pp_i_ne +pp_i_negate +pp_i_subtract +pp_index +pp_int +pp_interp +pp_ioctl +pp_iter +pp_join +pp_keys +pp_kill +pp_last +pp_lc +pp_lcfirst +pp_le +pp_leave +pp_leaveeval +pp_leaveloop +pp_leavesub +pp_leavetry +pp_leavewrite +pp_left_shift +pp_length +pp_lineseq +pp_link +pp_list +pp_listen +pp_localtime +pp_lock +pp_log +pp_lslice +pp_lstat +pp_lt +pp_map +pp_mapstart +pp_mapwhile +pp_match +pp_method +pp_mkdir +pp_modulo +pp_msgctl +pp_msgget +pp_msgrcv +pp_msgsnd +pp_multiply +pp_ncmp +pp_ne +pp_negate +pp_next +pp_nextstate +pp_not +pp_nswitch +pp_null +pp_oct +pp_open +pp_open_dir +pp_or +pp_orassign +pp_ord +pp_pack +pp_padany +pp_padav +pp_padhv +pp_padsv +pp_pipe_op +pp_pop +pp_pos +pp_postdec +pp_postinc +pp_pow +pp_predec +pp_preinc +pp_print +pp_prototype +pp_prtf +pp_push +pp_pushmark +pp_pushre +pp_qr +pp_quotemeta +pp_rand +pp_range +pp_rcatline +pp_read +pp_readdir +pp_readline +pp_readlink +pp_recv +pp_redo +pp_ref +pp_refgen +pp_regcmaybe +pp_regcreset +pp_regcomp +pp_rename +pp_repeat +pp_require +pp_reset +pp_return +pp_reverse +pp_rewinddir +pp_right_shift +pp_rindex +pp_rmdir +pp_rv2av +pp_rv2cv +pp_rv2gv +pp_rv2hv +pp_rv2sv +pp_sassign +pp_scalar +pp_schomp +pp_schop +pp_scmp +pp_scope +pp_seek +pp_seekdir +pp_select +pp_semctl +pp_semget +pp_semop +pp_send +pp_seq +pp_setpgrp +pp_setpriority +pp_sge +pp_sgrent +pp_sgt +pp_shift +pp_shmctl +pp_shmget +pp_shmread +pp_shmwrite +pp_shostent +pp_shutdown +pp_sin +pp_sle +pp_sleep +pp_slt +pp_sne +pp_snetent +pp_socket +pp_sockpair +pp_sort +pp_splice +pp_split +pp_sprintf +pp_sprotoent +pp_spwent +pp_sqrt +pp_srand +pp_srefgen +pp_sselect +pp_sservent +pp_ssockopt +pp_stat +pp_stringify +pp_stub +pp_study +pp_subst +pp_substcont +pp_substr +pp_subtract +pp_symlink +pp_syscall +pp_sysopen +pp_sysread +pp_sysseek +pp_system +pp_syswrite +pp_tell +pp_telldir +pp_threadsv +pp_tie +pp_tied +pp_time +pp_tms +pp_trans +pp_truncate +pp_uc +pp_ucfirst +pp_umask +pp_undef +pp_unlink +pp_unpack +pp_unshift +pp_unstack +pp_untie +pp_utime +pp_values +pp_vec +pp_wait +pp_waitpid +pp_wantarray +pp_warn +pp_xor +pregcomp +pregexec +pregfree +prepend_elem +push_return +push_scope +q +ref +refkids +regdump +regexec_flags +regnext +regprop +repeatcpy +rninstr +rsignal +rsignal_restore +rsignal_save +rsignal_state +rxres_free +rxres_restore +rxres_save +safecalloc +safefree +safemalloc +saferealloc +safexcalloc +safexfree +safexmalloc +safexrealloc +same_dirent +save_I16 +save_I32 +save_aelem +save_aptr +save_ary +save_clearsv +save_delete +save_destructor +save_freeop +save_freepv +save_freesv +save_gp +save_hash +save_helem +save_hints +save_hptr +save_int +save_item +save_iv +save_list +save_long +save_nogv +save_op +save_pptr +save_scalar +save_sptr +save_svref +save_threadsv +savepv +savepvn +savestack_grow +sawparens +scalar +scalarkids +scalarseq +scalarvoid +scan_const +scan_formline +scan_heredoc +scan_hex +scan_ident +scan_inputsymbol +scan_num +scan_oct +scan_pat +scan_prefix +scan_str +scan_subst +scan_trans +scan_word +scope +screaminstr +setdefout +setenv_getix +share_hek +sharepvn +sighandler +skipspace +stack_grow +start_subparse +sub_crush_depth +sv_2bool +sv_2cv +sv_2io +sv_2iv +sv_2mortal +sv_2nv +sv_2pv +sv_2uv +sv_add_arena +sv_backoff +sv_bless +sv_catpv +sv_catpv_mg +sv_catpvf +sv_catpvf_mg +sv_catpvn +sv_catpvn_mg +sv_catsv +sv_catsv_mg +sv_chop +sv_clean_all +sv_clean_objs +sv_clear +sv_cmp +sv_cmp_locale +sv_collxfrm +sv_compile_2op +sv_dec +sv_derived_from +sv_dump +sv_eq +sv_free +sv_free_arenas +sv_gets +sv_grow +sv_inc +sv_insert +sv_isa +sv_isobject +sv_iv +sv_len +sv_magic +sv_mortalcopy +sv_newmortal +sv_newref +sv_nv +sv_peek +sv_pvn +sv_pvn_force +sv_ref +sv_reftype +sv_replace +sv_report_used +sv_reset +sv_setiv +sv_setiv_mg +sv_setnv +sv_setnv_mg +sv_setptrobj +sv_setpv +sv_setpv_mg +sv_setpvf +sv_setpvf_mg +sv_setpviv +sv_setpviv_mg +sv_setpvn +sv_setpvn_mg +sv_setref_iv +sv_setref_nv +sv_setref_pv +sv_setref_pvn +sv_setsv +sv_setsv_mg +sv_setuv +sv_setuv_mg +sv_taint +sv_tainted +sv_true +sv_unmagic +sv_unref +sv_untaint +sv_upgrade +sv_usepvn +sv_usepvn_mg +sv_uv +sv_vcatpvfn +sv_vsetpvfn +taint_env +taint_proper +too_few_arguments +too_many_arguments +unlnk +unlock_condpair +unshare_hek +unsharepvn +utilize +wait4pid +warn +watch +whichsig +yydestruct +yyerror +yylex +yyparse +yywarn diff --git a/contrib/perl5/globals.c b/contrib/perl5/globals.c new file mode 100644 index 00000000000..1d8ef9272d2 --- /dev/null +++ b/contrib/perl5/globals.c @@ -0,0 +1,1471 @@ +#include "INTERN.h" +#include "perl.h" + +#ifdef PERL_OBJECT +#undef pp_null +#define pp_null CPerlObj::Perl_pp_null +#undef pp_stub +#define pp_stub CPerlObj::Perl_pp_stub +#undef pp_scalar +#define pp_scalar CPerlObj::Perl_pp_scalar +#undef pp_pushmark +#define pp_pushmark CPerlObj::Perl_pp_pushmark +#undef pp_wantarray +#define pp_wantarray CPerlObj::Perl_pp_wantarray +#undef pp_const +#define pp_const CPerlObj::Perl_pp_const +#undef pp_gvsv +#define pp_gvsv CPerlObj::Perl_pp_gvsv +#undef pp_gv +#define pp_gv CPerlObj::Perl_pp_gv +#undef pp_gelem +#define pp_gelem CPerlObj::Perl_pp_gelem +#undef pp_padsv +#define pp_padsv CPerlObj::Perl_pp_padsv +#undef pp_padav +#define pp_padav CPerlObj::Perl_pp_padav +#undef pp_padhv +#define pp_padhv CPerlObj::Perl_pp_padhv +#undef pp_padany +#define pp_padany CPerlObj::Perl_pp_padany +#undef pp_pushre +#define pp_pushre CPerlObj::Perl_pp_pushre +#undef pp_rv2gv +#define pp_rv2gv CPerlObj::Perl_pp_rv2gv +#undef pp_rv2sv +#define pp_rv2sv CPerlObj::Perl_pp_rv2sv +#undef pp_av2arylen +#define pp_av2arylen CPerlObj::Perl_pp_av2arylen +#undef pp_rv2cv +#define pp_rv2cv CPerlObj::Perl_pp_rv2cv +#undef pp_anoncode +#define pp_anoncode CPerlObj::Perl_pp_anoncode +#undef pp_prototype +#define pp_prototype CPerlObj::Perl_pp_prototype +#undef pp_refgen +#define pp_refgen CPerlObj::Perl_pp_refgen +#undef pp_srefgen +#define pp_srefgen CPerlObj::Perl_pp_srefgen +#undef pp_ref +#define pp_ref CPerlObj::Perl_pp_ref +#undef pp_bless +#define pp_bless CPerlObj::Perl_pp_bless +#undef pp_backtick +#define pp_backtick CPerlObj::Perl_pp_backtick +#undef pp_glob +#define pp_glob CPerlObj::Perl_pp_glob +#undef pp_readline +#define pp_readline CPerlObj::Perl_pp_readline +#undef pp_rcatline +#define pp_rcatline CPerlObj::Perl_pp_rcatline +#undef pp_regcmaybe +#define pp_regcmaybe CPerlObj::Perl_pp_regcmaybe +#undef pp_regcreset +#define pp_regcreset CPerlObj::Perl_pp_regcreset +#undef pp_regcomp +#define pp_regcomp CPerlObj::Perl_pp_regcomp +#undef pp_match +#define pp_match CPerlObj::Perl_pp_match +#undef pp_qr +#define pp_qr CPerlObj::Perl_pp_qr +#undef pp_subst +#define pp_subst CPerlObj::Perl_pp_subst +#undef pp_substcont +#define pp_substcont CPerlObj::Perl_pp_substcont +#undef pp_trans +#define pp_trans CPerlObj::Perl_pp_trans +#undef pp_sassign +#define pp_sassign CPerlObj::Perl_pp_sassign +#undef pp_aassign +#define pp_aassign CPerlObj::Perl_pp_aassign +#undef pp_chop +#define pp_chop CPerlObj::Perl_pp_chop +#undef pp_schop +#define pp_schop CPerlObj::Perl_pp_schop +#undef pp_chomp +#define pp_chomp CPerlObj::Perl_pp_chomp +#undef pp_schomp +#define pp_schomp CPerlObj::Perl_pp_schomp +#undef pp_defined +#define pp_defined CPerlObj::Perl_pp_defined +#undef pp_undef +#define pp_undef CPerlObj::Perl_pp_undef +#undef pp_study +#define pp_study CPerlObj::Perl_pp_study +#undef pp_pos +#define pp_pos CPerlObj::Perl_pp_pos +#undef pp_preinc +#define pp_preinc CPerlObj::Perl_pp_preinc +#undef pp_i_preinc +#define pp_i_preinc CPerlObj::Perl_pp_preinc +#undef pp_predec +#define pp_predec CPerlObj::Perl_pp_predec +#undef pp_i_predec +#define pp_i_predec CPerlObj::Perl_pp_predec +#undef pp_postinc +#define pp_postinc CPerlObj::Perl_pp_postinc +#undef pp_i_postinc +#define pp_i_postinc CPerlObj::Perl_pp_postinc +#undef pp_postdec +#define pp_postdec CPerlObj::Perl_pp_postdec +#undef pp_i_postdec +#define pp_i_postdec CPerlObj::Perl_pp_postdec +#undef pp_pow +#define pp_pow CPerlObj::Perl_pp_pow +#undef pp_multiply +#define pp_multiply CPerlObj::Perl_pp_multiply +#undef pp_i_multiply +#define pp_i_multiply CPerlObj::Perl_pp_i_multiply +#undef pp_divide +#define pp_divide CPerlObj::Perl_pp_divide +#undef pp_i_divide +#define pp_i_divide CPerlObj::Perl_pp_i_divide +#undef pp_modulo +#define pp_modulo CPerlObj::Perl_pp_modulo +#undef pp_i_modulo +#define pp_i_modulo CPerlObj::Perl_pp_i_modulo +#undef pp_repeat +#define pp_repeat CPerlObj::Perl_pp_repeat +#undef pp_add +#define pp_add CPerlObj::Perl_pp_add +#undef pp_i_add +#define pp_i_add CPerlObj::Perl_pp_i_add +#undef pp_subtract +#define pp_subtract CPerlObj::Perl_pp_subtract +#undef pp_i_subtract +#define pp_i_subtract CPerlObj::Perl_pp_i_subtract +#undef pp_concat +#define pp_concat CPerlObj::Perl_pp_concat +#undef pp_stringify +#define pp_stringify CPerlObj::Perl_pp_stringify +#undef pp_left_shift +#define pp_left_shift CPerlObj::Perl_pp_left_shift +#undef pp_right_shift +#define pp_right_shift CPerlObj::Perl_pp_right_shift +#undef pp_lt +#define pp_lt CPerlObj::Perl_pp_lt +#undef pp_i_lt +#define pp_i_lt CPerlObj::Perl_pp_i_lt +#undef pp_gt +#define pp_gt CPerlObj::Perl_pp_gt +#undef pp_i_gt +#define pp_i_gt CPerlObj::Perl_pp_i_gt +#undef pp_le +#define pp_le CPerlObj::Perl_pp_le +#undef pp_i_le +#define pp_i_le CPerlObj::Perl_pp_i_le +#undef pp_ge +#define pp_ge CPerlObj::Perl_pp_ge +#undef pp_i_ge +#define pp_i_ge CPerlObj::Perl_pp_i_ge +#undef pp_eq +#define pp_eq CPerlObj::Perl_pp_eq +#undef pp_i_eq +#define pp_i_eq CPerlObj::Perl_pp_i_eq +#undef pp_ne +#define pp_ne CPerlObj::Perl_pp_ne +#undef pp_i_ne +#define pp_i_ne CPerlObj::Perl_pp_i_ne +#undef pp_ncmp +#define pp_ncmp CPerlObj::Perl_pp_ncmp +#undef pp_i_ncmp +#define pp_i_ncmp CPerlObj::Perl_pp_i_ncmp +#undef pp_slt +#define pp_slt CPerlObj::Perl_pp_slt +#undef pp_sgt +#define pp_sgt CPerlObj::Perl_pp_sgt +#undef pp_sle +#define pp_sle CPerlObj::Perl_pp_sle +#undef pp_sge +#define pp_sge CPerlObj::Perl_pp_sge +#undef pp_seq +#define pp_seq CPerlObj::Perl_pp_seq +#undef pp_sne +#define pp_sne CPerlObj::Perl_pp_sne +#undef pp_scmp +#define pp_scmp CPerlObj::Perl_pp_scmp +#undef pp_bit_and +#define pp_bit_and CPerlObj::Perl_pp_bit_and +#undef pp_bit_xor +#define pp_bit_xor CPerlObj::Perl_pp_bit_xor +#undef pp_bit_or +#define pp_bit_or CPerlObj::Perl_pp_bit_or +#undef pp_negate +#define pp_negate CPerlObj::Perl_pp_negate +#undef pp_i_negate +#define pp_i_negate CPerlObj::Perl_pp_i_negate +#undef pp_not +#define pp_not CPerlObj::Perl_pp_not +#undef pp_complement +#define pp_complement CPerlObj::Perl_pp_complement +#undef pp_atan2 +#define pp_atan2 CPerlObj::Perl_pp_atan2 +#undef pp_sin +#define pp_sin CPerlObj::Perl_pp_sin +#undef pp_cos +#define pp_cos CPerlObj::Perl_pp_cos +#undef pp_rand +#define pp_rand CPerlObj::Perl_pp_rand +#undef pp_srand +#define pp_srand CPerlObj::Perl_pp_srand +#undef pp_exp +#define pp_exp CPerlObj::Perl_pp_exp +#undef pp_log +#define pp_log CPerlObj::Perl_pp_log +#undef pp_sqrt +#define pp_sqrt CPerlObj::Perl_pp_sqrt +#undef pp_int +#define pp_int CPerlObj::Perl_pp_int +#undef pp_hex +#define pp_hex CPerlObj::Perl_pp_hex +#undef pp_oct +#define pp_oct CPerlObj::Perl_pp_oct +#undef pp_abs +#define pp_abs CPerlObj::Perl_pp_abs +#undef pp_length +#define pp_length CPerlObj::Perl_pp_length +#undef pp_substr +#define pp_substr CPerlObj::Perl_pp_substr +#undef pp_vec +#define pp_vec CPerlObj::Perl_pp_vec +#undef pp_index +#define pp_index CPerlObj::Perl_pp_index +#undef pp_rindex +#define pp_rindex CPerlObj::Perl_pp_rindex +#undef pp_sprintf +#define pp_sprintf CPerlObj::Perl_pp_sprintf +#undef pp_formline +#define pp_formline CPerlObj::Perl_pp_formline +#undef pp_ord +#define pp_ord CPerlObj::Perl_pp_ord +#undef pp_chr +#define pp_chr CPerlObj::Perl_pp_chr +#undef pp_crypt +#define pp_crypt CPerlObj::Perl_pp_crypt +#undef pp_ucfirst +#define pp_ucfirst CPerlObj::Perl_pp_ucfirst +#undef pp_lcfirst +#define pp_lcfirst CPerlObj::Perl_pp_lcfirst +#undef pp_uc +#define pp_uc CPerlObj::Perl_pp_uc +#undef pp_lc +#define pp_lc CPerlObj::Perl_pp_lc +#undef pp_quotemeta +#define pp_quotemeta CPerlObj::Perl_pp_quotemeta +#undef pp_rv2av +#define pp_rv2av CPerlObj::Perl_pp_rv2av +#undef pp_aelemfast +#define pp_aelemfast CPerlObj::Perl_pp_aelemfast +#undef pp_aelem +#define pp_aelem CPerlObj::Perl_pp_aelem +#undef pp_aslice +#define pp_aslice CPerlObj::Perl_pp_aslice +#undef pp_each +#define pp_each CPerlObj::Perl_pp_each +#undef pp_values +#define pp_values CPerlObj::Perl_pp_values +#undef pp_keys +#define pp_keys CPerlObj::Perl_pp_keys +#undef pp_delete +#define pp_delete CPerlObj::Perl_pp_delete +#undef pp_exists +#define pp_exists CPerlObj::Perl_pp_exists +#undef pp_rv2hv +#define pp_rv2hv CPerlObj::Perl_pp_rv2hv +#undef pp_helem +#define pp_helem CPerlObj::Perl_pp_helem +#undef pp_hslice +#define pp_hslice CPerlObj::Perl_pp_hslice +#undef pp_unpack +#define pp_unpack CPerlObj::Perl_pp_unpack +#undef pp_pack +#define pp_pack CPerlObj::Perl_pp_pack +#undef pp_split +#define pp_split CPerlObj::Perl_pp_split +#undef pp_join +#define pp_join CPerlObj::Perl_pp_join +#undef pp_list +#define pp_list CPerlObj::Perl_pp_list +#undef pp_lslice +#define pp_lslice CPerlObj::Perl_pp_lslice +#undef pp_anonlist +#define pp_anonlist CPerlObj::Perl_pp_anonlist +#undef pp_anonhash +#define pp_anonhash CPerlObj::Perl_pp_anonhash +#undef pp_splice +#define pp_splice CPerlObj::Perl_pp_splice +#undef pp_push +#define pp_push CPerlObj::Perl_pp_push +#undef pp_pop +#define pp_pop CPerlObj::Perl_pp_pop +#undef pp_shift +#define pp_shift CPerlObj::Perl_pp_shift +#undef pp_unshift +#define pp_unshift CPerlObj::Perl_pp_unshift +#undef pp_sort +#define pp_sort CPerlObj::Perl_pp_sort +#undef pp_reverse +#define pp_reverse CPerlObj::Perl_pp_reverse +#undef pp_grepstart +#define pp_grepstart CPerlObj::Perl_pp_grepstart +#undef pp_grepwhile +#define pp_grepwhile CPerlObj::Perl_pp_grepwhile +#undef pp_mapstart +#define pp_mapstart CPerlObj::Perl_pp_mapstart +#undef pp_mapwhile +#define pp_mapwhile CPerlObj::Perl_pp_mapwhile +#undef pp_range +#define pp_range CPerlObj::Perl_pp_range +#undef pp_flip +#define pp_flip CPerlObj::Perl_pp_flip +#undef pp_flop +#define pp_flop CPerlObj::Perl_pp_flop +#undef pp_and +#define pp_and CPerlObj::Perl_pp_and +#undef pp_or +#define pp_or CPerlObj::Perl_pp_or +#undef pp_xor +#define pp_xor CPerlObj::Perl_pp_xor +#undef pp_cond_expr +#define pp_cond_expr CPerlObj::Perl_pp_cond_expr +#undef pp_andassign +#define pp_andassign CPerlObj::Perl_pp_andassign +#undef pp_orassign +#define pp_orassign CPerlObj::Perl_pp_orassign +#undef pp_method +#define pp_method CPerlObj::Perl_pp_method +#undef pp_entersub +#define pp_entersub CPerlObj::Perl_pp_entersub +#undef pp_leavesub +#define pp_leavesub CPerlObj::Perl_pp_leavesub +#undef pp_caller +#define pp_caller CPerlObj::Perl_pp_caller +#undef pp_warn +#define pp_warn CPerlObj::Perl_pp_warn +#undef pp_die +#define pp_die CPerlObj::Perl_pp_die +#undef pp_reset +#define pp_reset CPerlObj::Perl_pp_reset +#undef pp_lineseq +#define pp_lineseq CPerlObj::Perl_pp_lineseq +#undef pp_nextstate +#define pp_nextstate CPerlObj::Perl_pp_nextstate +#undef pp_dbstate +#define pp_dbstate CPerlObj::Perl_pp_dbstate +#undef pp_unstack +#define pp_unstack CPerlObj::Perl_pp_unstack +#undef pp_enter +#define pp_enter CPerlObj::Perl_pp_enter +#undef pp_leave +#define pp_leave CPerlObj::Perl_pp_leave +#undef pp_scope +#define pp_scope CPerlObj::Perl_pp_scope +#undef pp_enteriter +#define pp_enteriter CPerlObj::Perl_pp_enteriter +#undef pp_iter +#define pp_iter CPerlObj::Perl_pp_iter +#undef pp_enterloop +#define pp_enterloop CPerlObj::Perl_pp_enterloop +#undef pp_leaveloop +#define pp_leaveloop CPerlObj::Perl_pp_leaveloop +#undef pp_return +#define pp_return CPerlObj::Perl_pp_return +#undef pp_last +#define pp_last CPerlObj::Perl_pp_last +#undef pp_next +#define pp_next CPerlObj::Perl_pp_next +#undef pp_redo +#define pp_redo CPerlObj::Perl_pp_redo +#undef pp_dump +#define pp_dump CPerlObj::Perl_pp_dump +#undef pp_goto +#define pp_goto CPerlObj::Perl_pp_goto +#undef pp_exit +#define pp_exit CPerlObj::Perl_pp_exit +#undef pp_open +#define pp_open CPerlObj::Perl_pp_open +#undef pp_close +#define pp_close CPerlObj::Perl_pp_close +#undef pp_pipe_op +#define pp_pipe_op CPerlObj::Perl_pp_pipe_op +#undef pp_fileno +#define pp_fileno CPerlObj::Perl_pp_fileno +#undef pp_umask +#define pp_umask CPerlObj::Perl_pp_umask +#undef pp_binmode +#define pp_binmode CPerlObj::Perl_pp_binmode +#undef pp_tie +#define pp_tie CPerlObj::Perl_pp_tie +#undef pp_untie +#define pp_untie CPerlObj::Perl_pp_untie +#undef pp_tied +#define pp_tied CPerlObj::Perl_pp_tied +#undef pp_dbmopen +#define pp_dbmopen CPerlObj::Perl_pp_dbmopen +#undef pp_dbmclose +#define pp_dbmclose CPerlObj::Perl_pp_dbmclose +#undef pp_sselect +#define pp_sselect CPerlObj::Perl_pp_sselect +#undef pp_select +#define pp_select CPerlObj::Perl_pp_select +#undef pp_getc +#define pp_getc CPerlObj::Perl_pp_getc +#undef pp_read +#define pp_read CPerlObj::Perl_pp_read +#undef pp_enterwrite +#define pp_enterwrite CPerlObj::Perl_pp_enterwrite +#undef pp_leavewrite +#define pp_leavewrite CPerlObj::Perl_pp_leavewrite +#undef pp_prtf +#define pp_prtf CPerlObj::Perl_pp_prtf +#undef pp_print +#define pp_print CPerlObj::Perl_pp_print +#undef pp_sysopen +#define pp_sysopen CPerlObj::Perl_pp_sysopen +#undef pp_sysseek +#define pp_sysseek CPerlObj::Perl_pp_sysseek +#undef pp_sysread +#define pp_sysread CPerlObj::Perl_pp_sysread +#undef pp_syswrite +#define pp_syswrite CPerlObj::Perl_pp_syswrite +#undef pp_send +#define pp_send CPerlObj::Perl_pp_send +#undef pp_recv +#define pp_recv CPerlObj::Perl_pp_recv +#undef pp_eof +#define pp_eof CPerlObj::Perl_pp_eof +#undef pp_tell +#define pp_tell CPerlObj::Perl_pp_tell +#undef pp_seek +#define pp_seek CPerlObj::Perl_pp_seek +#undef pp_truncate +#define pp_truncate CPerlObj::Perl_pp_truncate +#undef pp_fcntl +#define pp_fcntl CPerlObj::Perl_pp_fcntl +#undef pp_ioctl +#define pp_ioctl CPerlObj::Perl_pp_ioctl +#undef pp_flock +#define pp_flock CPerlObj::Perl_pp_flock +#undef pp_socket +#define pp_socket CPerlObj::Perl_pp_socket +#undef pp_sockpair +#define pp_sockpair CPerlObj::Perl_pp_sockpair +#undef pp_bind +#define pp_bind CPerlObj::Perl_pp_bind +#undef pp_connect +#define pp_connect CPerlObj::Perl_pp_connect +#undef pp_listen +#define pp_listen CPerlObj::Perl_pp_listen +#undef pp_accept +#define pp_accept CPerlObj::Perl_pp_accept +#undef pp_shutdown +#define pp_shutdown CPerlObj::Perl_pp_shutdown +#undef pp_gsockopt +#define pp_gsockopt CPerlObj::Perl_pp_gsockopt +#undef pp_ssockopt +#define pp_ssockopt CPerlObj::Perl_pp_ssockopt +#undef pp_getsockname +#define pp_getsockname CPerlObj::Perl_pp_getsockname +#undef pp_getpeername +#define pp_getpeername CPerlObj::Perl_pp_getpeername +#undef pp_lstat +#define pp_lstat CPerlObj::Perl_pp_lstat +#undef pp_stat +#define pp_stat CPerlObj::Perl_pp_stat +#undef pp_ftrread +#define pp_ftrread CPerlObj::Perl_pp_ftrread +#undef pp_ftrwrite +#define pp_ftrwrite CPerlObj::Perl_pp_ftrwrite +#undef pp_ftrexec +#define pp_ftrexec CPerlObj::Perl_pp_ftrexec +#undef pp_fteread +#define pp_fteread CPerlObj::Perl_pp_fteread +#undef pp_ftewrite +#define pp_ftewrite CPerlObj::Perl_pp_ftewrite +#undef pp_fteexec +#define pp_fteexec CPerlObj::Perl_pp_fteexec +#undef pp_ftis +#define pp_ftis CPerlObj::Perl_pp_ftis +#undef pp_fteowned +#define pp_fteowned CPerlObj::Perl_pp_fteowned +#undef pp_ftrowned +#define pp_ftrowned CPerlObj::Perl_pp_ftrowned +#undef pp_ftzero +#define pp_ftzero CPerlObj::Perl_pp_ftzero +#undef pp_ftsize +#define pp_ftsize CPerlObj::Perl_pp_ftsize +#undef pp_ftmtime +#define pp_ftmtime CPerlObj::Perl_pp_ftmtime +#undef pp_ftatime +#define pp_ftatime CPerlObj::Perl_pp_ftatime +#undef pp_ftctime +#define pp_ftctime CPerlObj::Perl_pp_ftctime +#undef pp_ftsock +#define pp_ftsock CPerlObj::Perl_pp_ftsock +#undef pp_ftchr +#define pp_ftchr CPerlObj::Perl_pp_ftchr +#undef pp_ftblk +#define pp_ftblk CPerlObj::Perl_pp_ftblk +#undef pp_ftfile +#define pp_ftfile CPerlObj::Perl_pp_ftfile +#undef pp_ftdir +#define pp_ftdir CPerlObj::Perl_pp_ftdir +#undef pp_ftpipe +#define pp_ftpipe CPerlObj::Perl_pp_ftpipe +#undef pp_ftlink +#define pp_ftlink CPerlObj::Perl_pp_ftlink +#undef pp_ftsuid +#define pp_ftsuid CPerlObj::Perl_pp_ftsuid +#undef pp_ftsgid +#define pp_ftsgid CPerlObj::Perl_pp_ftsgid +#undef pp_ftsvtx +#define pp_ftsvtx CPerlObj::Perl_pp_ftsvtx +#undef pp_fttty +#define pp_fttty CPerlObj::Perl_pp_fttty +#undef pp_fttext +#define pp_fttext CPerlObj::Perl_pp_fttext +#undef pp_ftbinary +#define pp_ftbinary CPerlObj::Perl_pp_ftbinary +#undef pp_chdir +#define pp_chdir CPerlObj::Perl_pp_chdir +#undef pp_chown +#define pp_chown CPerlObj::Perl_pp_chown +#undef pp_chroot +#define pp_chroot CPerlObj::Perl_pp_chroot +#undef pp_unlink +#define pp_unlink CPerlObj::Perl_pp_unlink +#undef pp_chmod +#define pp_chmod CPerlObj::Perl_pp_chmod +#undef pp_utime +#define pp_utime CPerlObj::Perl_pp_utime +#undef pp_rename +#define pp_rename CPerlObj::Perl_pp_rename +#undef pp_link +#define pp_link CPerlObj::Perl_pp_link +#undef pp_symlink +#define pp_symlink CPerlObj::Perl_pp_symlink +#undef pp_readlink +#define pp_readlink CPerlObj::Perl_pp_readlink +#undef pp_mkdir +#define pp_mkdir CPerlObj::Perl_pp_mkdir +#undef pp_rmdir +#define pp_rmdir CPerlObj::Perl_pp_rmdir +#undef pp_open_dir +#define pp_open_dir CPerlObj::Perl_pp_open_dir +#undef pp_readdir +#define pp_readdir CPerlObj::Perl_pp_readdir +#undef pp_telldir +#define pp_telldir CPerlObj::Perl_pp_telldir +#undef pp_seekdir +#define pp_seekdir CPerlObj::Perl_pp_seekdir +#undef pp_rewinddir +#define pp_rewinddir CPerlObj::Perl_pp_rewinddir +#undef pp_closedir +#define pp_closedir CPerlObj::Perl_pp_closedir +#undef pp_fork +#define pp_fork CPerlObj::Perl_pp_fork +#undef pp_wait +#define pp_wait CPerlObj::Perl_pp_wait +#undef pp_waitpid +#define pp_waitpid CPerlObj::Perl_pp_waitpid +#undef pp_system +#define pp_system CPerlObj::Perl_pp_system +#undef pp_exec +#define pp_exec CPerlObj::Perl_pp_exec +#undef pp_kill +#define pp_kill CPerlObj::Perl_pp_kill +#undef pp_getppid +#define pp_getppid CPerlObj::Perl_pp_getppid +#undef pp_getpgrp +#define pp_getpgrp CPerlObj::Perl_pp_getpgrp +#undef pp_setpgrp +#define pp_setpgrp CPerlObj::Perl_pp_setpgrp +#undef pp_getpriority +#define pp_getpriority CPerlObj::Perl_pp_getpriority +#undef pp_setpriority +#define pp_setpriority CPerlObj::Perl_pp_setpriority +#undef pp_time +#define pp_time CPerlObj::Perl_pp_time +#undef pp_tms +#define pp_tms CPerlObj::Perl_pp_tms +#undef pp_localtime +#define pp_localtime CPerlObj::Perl_pp_localtime +#undef pp_gmtime +#define pp_gmtime CPerlObj::Perl_pp_gmtime +#undef pp_alarm +#define pp_alarm CPerlObj::Perl_pp_alarm +#undef pp_sleep +#define pp_sleep CPerlObj::Perl_pp_sleep +#undef pp_shmget +#define pp_shmget CPerlObj::Perl_pp_shmget +#undef pp_shmctl +#define pp_shmctl CPerlObj::Perl_pp_shmctl +#undef pp_shmread +#define pp_shmread CPerlObj::Perl_pp_shmread +#undef pp_shmwrite +#define pp_shmwrite CPerlObj::Perl_pp_shmwrite +#undef pp_msgget +#define pp_msgget CPerlObj::Perl_pp_msgget +#undef pp_msgctl +#define pp_msgctl CPerlObj::Perl_pp_msgctl +#undef pp_msgsnd +#define pp_msgsnd CPerlObj::Perl_pp_msgsnd +#undef pp_msgrcv +#define pp_msgrcv CPerlObj::Perl_pp_msgrcv +#undef pp_semget +#define pp_semget CPerlObj::Perl_pp_semget +#undef pp_semctl +#define pp_semctl CPerlObj::Perl_pp_semctl +#undef pp_semop +#define pp_semop CPerlObj::Perl_pp_semop +#undef pp_require +#define pp_require CPerlObj::Perl_pp_require +#undef pp_dofile +#define pp_dofile CPerlObj::Perl_pp_dofile +#undef pp_entereval +#define pp_entereval CPerlObj::Perl_pp_entereval +#undef pp_leaveeval +#define pp_leaveeval CPerlObj::Perl_pp_leaveeval +#undef pp_entertry +#define pp_entertry CPerlObj::Perl_pp_entertry +#undef pp_leavetry +#define pp_leavetry CPerlObj::Perl_pp_leavetry +#undef pp_ghbyname +#define pp_ghbyname CPerlObj::Perl_pp_ghbyname +#undef pp_ghbyaddr +#define pp_ghbyaddr CPerlObj::Perl_pp_ghbyaddr +#undef pp_ghostent +#define pp_ghostent CPerlObj::Perl_pp_ghostent +#undef pp_gnbyname +#define pp_gnbyname CPerlObj::Perl_pp_gnbyname +#undef pp_gnbyaddr +#define pp_gnbyaddr CPerlObj::Perl_pp_gnbyaddr +#undef pp_gnetent +#define pp_gnetent CPerlObj::Perl_pp_gnetent +#undef pp_gpbyname +#define pp_gpbyname CPerlObj::Perl_pp_gpbyname +#undef pp_gpbynumber +#define pp_gpbynumber CPerlObj::Perl_pp_gpbynumber +#undef pp_gprotoent +#define pp_gprotoent CPerlObj::Perl_pp_gprotoent +#undef pp_gsbyname +#define pp_gsbyname CPerlObj::Perl_pp_gsbyname +#undef pp_gsbyport +#define pp_gsbyport CPerlObj::Perl_pp_gsbyport +#undef pp_gservent +#define pp_gservent CPerlObj::Perl_pp_gservent +#undef pp_shostent +#define pp_shostent CPerlObj::Perl_pp_shostent +#undef pp_snetent +#define pp_snetent CPerlObj::Perl_pp_snetent +#undef pp_sprotoent +#define pp_sprotoent CPerlObj::Perl_pp_sprotoent +#undef pp_sservent +#define pp_sservent CPerlObj::Perl_pp_sservent +#undef pp_ehostent +#define pp_ehostent CPerlObj::Perl_pp_ehostent +#undef pp_enetent +#define pp_enetent CPerlObj::Perl_pp_enetent +#undef pp_eprotoent +#define pp_eprotoent CPerlObj::Perl_pp_eprotoent +#undef pp_eservent +#define pp_eservent CPerlObj::Perl_pp_eservent +#undef pp_gpwnam +#define pp_gpwnam CPerlObj::Perl_pp_gpwnam +#undef pp_gpwuid +#define pp_gpwuid CPerlObj::Perl_pp_gpwuid +#undef pp_gpwent +#define pp_gpwent CPerlObj::Perl_pp_gpwent +#undef pp_spwent +#define pp_spwent CPerlObj::Perl_pp_spwent +#undef pp_epwent +#define pp_epwent CPerlObj::Perl_pp_epwent +#undef pp_ggrnam +#define pp_ggrnam CPerlObj::Perl_pp_ggrnam +#undef pp_ggrgid +#define pp_ggrgid CPerlObj::Perl_pp_ggrgid +#undef pp_ggrent +#define pp_ggrent CPerlObj::Perl_pp_ggrent +#undef pp_sgrent +#define pp_sgrent CPerlObj::Perl_pp_sgrent +#undef pp_egrent +#define pp_egrent CPerlObj::Perl_pp_egrent +#undef pp_getlogin +#define pp_getlogin CPerlObj::Perl_pp_getlogin +#undef pp_syscall +#define pp_syscall CPerlObj::Perl_pp_syscall +#undef pp_lock +#define pp_lock CPerlObj::Perl_pp_lock +#undef pp_threadsv +#define pp_threadsv CPerlObj::Perl_pp_threadsv + +OP * (CPERLscope(*check)[]) _((OP *op)) = { + ck_null, /* null */ + ck_null, /* stub */ + ck_fun, /* scalar */ + ck_null, /* pushmark */ + ck_null, /* wantarray */ + ck_svconst, /* const */ + ck_null, /* gvsv */ + ck_null, /* gv */ + ck_null, /* gelem */ + ck_null, /* padsv */ + ck_null, /* padav */ + ck_null, /* padhv */ + ck_null, /* padany */ + ck_null, /* pushre */ + ck_rvconst, /* rv2gv */ + ck_rvconst, /* rv2sv */ + ck_null, /* av2arylen */ + ck_rvconst, /* rv2cv */ + ck_anoncode, /* anoncode */ + ck_null, /* prototype */ + ck_spair, /* refgen */ + ck_null, /* srefgen */ + ck_fun, /* ref */ + ck_fun, /* bless */ + ck_null, /* backtick */ + ck_glob, /* glob */ + ck_null, /* readline */ + ck_null, /* rcatline */ + ck_fun, /* regcmaybe */ + ck_fun, /* regcreset */ + ck_null, /* regcomp */ + ck_match, /* match */ + ck_match, /* qr */ + ck_null, /* subst */ + ck_null, /* substcont */ + ck_null, /* trans */ + ck_null, /* sassign */ + ck_null, /* aassign */ + ck_spair, /* chop */ + ck_null, /* schop */ + ck_spair, /* chomp */ + ck_null, /* schomp */ + ck_rfun, /* defined */ + ck_lfun, /* undef */ + ck_fun, /* study */ + ck_lfun, /* pos */ + ck_lfun, /* preinc */ + ck_lfun, /* i_preinc */ + ck_lfun, /* predec */ + ck_lfun, /* i_predec */ + ck_lfun, /* postinc */ + ck_lfun, /* i_postinc */ + ck_lfun, /* postdec */ + ck_lfun, /* i_postdec */ + ck_null, /* pow */ + ck_null, /* multiply */ + ck_null, /* i_multiply */ + ck_null, /* divide */ + ck_null, /* i_divide */ + ck_null, /* modulo */ + ck_null, /* i_modulo */ + ck_repeat, /* repeat */ + ck_null, /* add */ + ck_null, /* i_add */ + ck_null, /* subtract */ + ck_null, /* i_subtract */ + ck_concat, /* concat */ + ck_fun, /* stringify */ + ck_bitop, /* left_shift */ + ck_bitop, /* right_shift */ + ck_null, /* lt */ + ck_null, /* i_lt */ + ck_null, /* gt */ + ck_null, /* i_gt */ + ck_null, /* le */ + ck_null, /* i_le */ + ck_null, /* ge */ + ck_null, /* i_ge */ + ck_null, /* eq */ + ck_null, /* i_eq */ + ck_null, /* ne */ + ck_null, /* i_ne */ + ck_null, /* ncmp */ + ck_null, /* i_ncmp */ + ck_scmp, /* slt */ + ck_scmp, /* sgt */ + ck_scmp, /* sle */ + ck_scmp, /* sge */ + ck_null, /* seq */ + ck_null, /* sne */ + ck_scmp, /* scmp */ + ck_bitop, /* bit_and */ + ck_bitop, /* bit_xor */ + ck_bitop, /* bit_or */ + ck_null, /* negate */ + ck_null, /* i_negate */ + ck_null, /* not */ + ck_bitop, /* complement */ + ck_fun, /* atan2 */ + ck_fun, /* sin */ + ck_fun, /* cos */ + ck_fun, /* rand */ + ck_fun, /* srand */ + ck_fun, /* exp */ + ck_fun, /* log */ + ck_fun, /* sqrt */ + ck_fun, /* int */ + ck_fun, /* hex */ + ck_fun, /* oct */ + ck_fun, /* abs */ + ck_lengthconst, /* length */ + ck_fun, /* substr */ + ck_fun, /* vec */ + ck_index, /* index */ + ck_index, /* rindex */ + ck_fun_locale, /* sprintf */ + ck_fun, /* formline */ + ck_fun, /* ord */ + ck_fun, /* chr */ + ck_fun, /* crypt */ + ck_fun_locale, /* ucfirst */ + ck_fun_locale, /* lcfirst */ + ck_fun_locale, /* uc */ + ck_fun_locale, /* lc */ + ck_fun, /* quotemeta */ + ck_rvconst, /* rv2av */ + ck_null, /* aelemfast */ + ck_null, /* aelem */ + ck_null, /* aslice */ + ck_fun, /* each */ + ck_fun, /* values */ + ck_fun, /* keys */ + ck_delete, /* delete */ + ck_exists, /* exists */ + ck_rvconst, /* rv2hv */ + ck_null, /* helem */ + ck_null, /* hslice */ + ck_fun, /* unpack */ + ck_fun, /* pack */ + ck_split, /* split */ + ck_fun, /* join */ + ck_null, /* list */ + ck_null, /* lslice */ + ck_fun, /* anonlist */ + ck_fun, /* anonhash */ + ck_fun, /* splice */ + ck_fun, /* push */ + ck_shift, /* pop */ + ck_shift, /* shift */ + ck_fun, /* unshift */ + ck_sort, /* sort */ + ck_fun, /* reverse */ + ck_grep, /* grepstart */ + ck_null, /* grepwhile */ + ck_grep, /* mapstart */ + ck_null, /* mapwhile */ + ck_null, /* range */ + ck_null, /* flip */ + ck_null, /* flop */ + ck_null, /* and */ + ck_null, /* or */ + ck_null, /* xor */ + ck_null, /* cond_expr */ + ck_null, /* andassign */ + ck_null, /* orassign */ + ck_null, /* method */ + ck_subr, /* entersub */ + ck_null, /* leavesub */ + ck_fun, /* caller */ + ck_fun, /* warn */ + ck_fun, /* die */ + ck_fun, /* reset */ + ck_null, /* lineseq */ + ck_null, /* nextstate */ + ck_null, /* dbstate */ + ck_null, /* unstack */ + ck_null, /* enter */ + ck_null, /* leave */ + ck_null, /* scope */ + ck_null, /* enteriter */ + ck_null, /* iter */ + ck_null, /* enterloop */ + ck_null, /* leaveloop */ + ck_null, /* return */ + ck_null, /* last */ + ck_null, /* next */ + ck_null, /* redo */ + ck_null, /* dump */ + ck_null, /* goto */ + ck_fun, /* exit */ + ck_fun, /* open */ + ck_fun, /* close */ + ck_fun, /* pipe_op */ + ck_fun, /* fileno */ + ck_fun, /* umask */ + ck_fun, /* binmode */ + ck_fun, /* tie */ + ck_fun, /* untie */ + ck_fun, /* tied */ + ck_fun, /* dbmopen */ + ck_fun, /* dbmclose */ + ck_select, /* sselect */ + ck_select, /* select */ + ck_eof, /* getc */ + ck_fun, /* read */ + ck_fun, /* enterwrite */ + ck_null, /* leavewrite */ + ck_listiob, /* prtf */ + ck_listiob, /* print */ + ck_fun, /* sysopen */ + ck_fun, /* sysseek */ + ck_fun, /* sysread */ + ck_fun, /* syswrite */ + ck_fun, /* send */ + ck_fun, /* recv */ + ck_eof, /* eof */ + ck_fun, /* tell */ + ck_fun, /* seek */ + ck_trunc, /* truncate */ + ck_fun, /* fcntl */ + ck_fun, /* ioctl */ + ck_fun, /* flock */ + ck_fun, /* socket */ + ck_fun, /* sockpair */ + ck_fun, /* bind */ + ck_fun, /* connect */ + ck_fun, /* listen */ + ck_fun, /* accept */ + ck_fun, /* shutdown */ + ck_fun, /* gsockopt */ + ck_fun, /* ssockopt */ + ck_fun, /* getsockname */ + ck_fun, /* getpeername */ + ck_ftst, /* lstat */ + ck_ftst, /* stat */ + ck_ftst, /* ftrread */ + ck_ftst, /* ftrwrite */ + ck_ftst, /* ftrexec */ + ck_ftst, /* fteread */ + ck_ftst, /* ftewrite */ + ck_ftst, /* fteexec */ + ck_ftst, /* ftis */ + ck_ftst, /* fteowned */ + ck_ftst, /* ftrowned */ + ck_ftst, /* ftzero */ + ck_ftst, /* ftsize */ + ck_ftst, /* ftmtime */ + ck_ftst, /* ftatime */ + ck_ftst, /* ftctime */ + ck_ftst, /* ftsock */ + ck_ftst, /* ftchr */ + ck_ftst, /* ftblk */ + ck_ftst, /* ftfile */ + ck_ftst, /* ftdir */ + ck_ftst, /* ftpipe */ + ck_ftst, /* ftlink */ + ck_ftst, /* ftsuid */ + ck_ftst, /* ftsgid */ + ck_ftst, /* ftsvtx */ + ck_ftst, /* fttty */ + ck_ftst, /* fttext */ + ck_ftst, /* ftbinary */ + ck_fun, /* chdir */ + ck_fun, /* chown */ + ck_fun, /* chroot */ + ck_fun, /* unlink */ + ck_fun, /* chmod */ + ck_fun, /* utime */ + ck_fun, /* rename */ + ck_fun, /* link */ + ck_fun, /* symlink */ + ck_fun, /* readlink */ + ck_fun, /* mkdir */ + ck_fun, /* rmdir */ + ck_fun, /* open_dir */ + ck_fun, /* readdir */ + ck_fun, /* telldir */ + ck_fun, /* seekdir */ + ck_fun, /* rewinddir */ + ck_fun, /* closedir */ + ck_null, /* fork */ + ck_null, /* wait */ + ck_fun, /* waitpid */ + ck_exec, /* system */ + ck_exec, /* exec */ + ck_fun, /* kill */ + ck_null, /* getppid */ + ck_fun, /* getpgrp */ + ck_fun, /* setpgrp */ + ck_fun, /* getpriority */ + ck_fun, /* setpriority */ + ck_null, /* time */ + ck_null, /* tms */ + ck_fun, /* localtime */ + ck_fun, /* gmtime */ + ck_fun, /* alarm */ + ck_fun, /* sleep */ + ck_fun, /* shmget */ + ck_fun, /* shmctl */ + ck_fun, /* shmread */ + ck_fun, /* shmwrite */ + ck_fun, /* msgget */ + ck_fun, /* msgctl */ + ck_fun, /* msgsnd */ + ck_fun, /* msgrcv */ + ck_fun, /* semget */ + ck_fun, /* semctl */ + ck_fun, /* semop */ + ck_require, /* require */ + ck_fun, /* dofile */ + ck_eval, /* entereval */ + ck_null, /* leaveeval */ + ck_null, /* entertry */ + ck_null, /* leavetry */ + ck_fun, /* ghbyname */ + ck_fun, /* ghbyaddr */ + ck_null, /* ghostent */ + ck_fun, /* gnbyname */ + ck_fun, /* gnbyaddr */ + ck_null, /* gnetent */ + ck_fun, /* gpbyname */ + ck_fun, /* gpbynumber */ + ck_null, /* gprotoent */ + ck_fun, /* gsbyname */ + ck_fun, /* gsbyport */ + ck_null, /* gservent */ + ck_fun, /* shostent */ + ck_fun, /* snetent */ + ck_fun, /* sprotoent */ + ck_fun, /* sservent */ + ck_null, /* ehostent */ + ck_null, /* enetent */ + ck_null, /* eprotoent */ + ck_null, /* eservent */ + ck_fun, /* gpwnam */ + ck_fun, /* gpwuid */ + ck_null, /* gpwent */ + ck_null, /* spwent */ + ck_null, /* epwent */ + ck_fun, /* ggrnam */ + ck_fun, /* ggrgid */ + ck_null, /* ggrent */ + ck_null, /* sgrent */ + ck_null, /* egrent */ + ck_null, /* getlogin */ + ck_fun, /* syscall */ + ck_rfun, /* lock */ + ck_null, /* threadsv */ +}; + +OP * (CPERLscope(*ppaddr)[])(ARGSproto) = { + pp_null, + pp_stub, + pp_scalar, + pp_pushmark, + pp_wantarray, + pp_const, + pp_gvsv, + pp_gv, + pp_gelem, + pp_padsv, + pp_padav, + pp_padhv, + pp_padany, + pp_pushre, + pp_rv2gv, + pp_rv2sv, + pp_av2arylen, + pp_rv2cv, + pp_anoncode, + pp_prototype, + pp_refgen, + pp_srefgen, + pp_ref, + pp_bless, + pp_backtick, + pp_glob, + pp_readline, + pp_rcatline, + pp_regcmaybe, + pp_regcreset, + pp_regcomp, + pp_match, + pp_qr, + pp_subst, + pp_substcont, + pp_trans, + pp_sassign, + pp_aassign, + pp_chop, + pp_schop, + pp_chomp, + pp_schomp, + pp_defined, + pp_undef, + pp_study, + pp_pos, + pp_preinc, + pp_i_preinc, + pp_predec, + pp_i_predec, + pp_postinc, + pp_i_postinc, + pp_postdec, + pp_i_postdec, + pp_pow, + pp_multiply, + pp_i_multiply, + pp_divide, + pp_i_divide, + pp_modulo, + pp_i_modulo, + pp_repeat, + pp_add, + pp_i_add, + pp_subtract, + pp_i_subtract, + pp_concat, + pp_stringify, + pp_left_shift, + pp_right_shift, + pp_lt, + pp_i_lt, + pp_gt, + pp_i_gt, + pp_le, + pp_i_le, + pp_ge, + pp_i_ge, + pp_eq, + pp_i_eq, + pp_ne, + pp_i_ne, + pp_ncmp, + pp_i_ncmp, + pp_slt, + pp_sgt, + pp_sle, + pp_sge, + pp_seq, + pp_sne, + pp_scmp, + pp_bit_and, + pp_bit_xor, + pp_bit_or, + pp_negate, + pp_i_negate, + pp_not, + pp_complement, + pp_atan2, + pp_sin, + pp_cos, + pp_rand, + pp_srand, + pp_exp, + pp_log, + pp_sqrt, + pp_int, + pp_hex, + pp_oct, + pp_abs, + pp_length, + pp_substr, + pp_vec, + pp_index, + pp_rindex, + pp_sprintf, + pp_formline, + pp_ord, + pp_chr, + pp_crypt, + pp_ucfirst, + pp_lcfirst, + pp_uc, + pp_lc, + pp_quotemeta, + pp_rv2av, + pp_aelemfast, + pp_aelem, + pp_aslice, + pp_each, + pp_values, + pp_keys, + pp_delete, + pp_exists, + pp_rv2hv, + pp_helem, + pp_hslice, + pp_unpack, + pp_pack, + pp_split, + pp_join, + pp_list, + pp_lslice, + pp_anonlist, + pp_anonhash, + pp_splice, + pp_push, + pp_pop, + pp_shift, + pp_unshift, + pp_sort, + pp_reverse, + pp_grepstart, + pp_grepwhile, + pp_mapstart, + pp_mapwhile, + pp_range, + pp_flip, + pp_flop, + pp_and, + pp_or, + pp_xor, + pp_cond_expr, + pp_andassign, + pp_orassign, + pp_method, + pp_entersub, + pp_leavesub, + pp_caller, + pp_warn, + pp_die, + pp_reset, + pp_lineseq, + pp_nextstate, + pp_dbstate, + pp_unstack, + pp_enter, + pp_leave, + pp_scope, + pp_enteriter, + pp_iter, + pp_enterloop, + pp_leaveloop, + pp_return, + pp_last, + pp_next, + pp_redo, + pp_dump, + pp_goto, + pp_exit, + pp_open, + pp_close, + pp_pipe_op, + pp_fileno, + pp_umask, + pp_binmode, + pp_tie, + pp_untie, + pp_tied, + pp_dbmopen, + pp_dbmclose, + pp_sselect, + pp_select, + pp_getc, + pp_read, + pp_enterwrite, + pp_leavewrite, + pp_prtf, + pp_print, + pp_sysopen, + pp_sysseek, + pp_sysread, + pp_syswrite, + pp_send, + pp_recv, + pp_eof, + pp_tell, + pp_seek, + pp_truncate, + pp_fcntl, + pp_ioctl, + pp_flock, + pp_socket, + pp_sockpair, + pp_bind, + pp_connect, + pp_listen, + pp_accept, + pp_shutdown, + pp_gsockopt, + pp_ssockopt, + pp_getsockname, + pp_getpeername, + pp_lstat, + pp_stat, + pp_ftrread, + pp_ftrwrite, + pp_ftrexec, + pp_fteread, + pp_ftewrite, + pp_fteexec, + pp_ftis, + pp_fteowned, + pp_ftrowned, + pp_ftzero, + pp_ftsize, + pp_ftmtime, + pp_ftatime, + pp_ftctime, + pp_ftsock, + pp_ftchr, + pp_ftblk, + pp_ftfile, + pp_ftdir, + pp_ftpipe, + pp_ftlink, + pp_ftsuid, + pp_ftsgid, + pp_ftsvtx, + pp_fttty, + pp_fttext, + pp_ftbinary, + pp_chdir, + pp_chown, + pp_chroot, + pp_unlink, + pp_chmod, + pp_utime, + pp_rename, + pp_link, + pp_symlink, + pp_readlink, + pp_mkdir, + pp_rmdir, + pp_open_dir, + pp_readdir, + pp_telldir, + pp_seekdir, + pp_rewinddir, + pp_closedir, + pp_fork, + pp_wait, + pp_waitpid, + pp_system, + pp_exec, + pp_kill, + pp_getppid, + pp_getpgrp, + pp_setpgrp, + pp_getpriority, + pp_setpriority, + pp_time, + pp_tms, + pp_localtime, + pp_gmtime, + pp_alarm, + pp_sleep, + pp_shmget, + pp_shmctl, + pp_shmread, + pp_shmwrite, + pp_msgget, + pp_msgctl, + pp_msgsnd, + pp_msgrcv, + pp_semget, + pp_semctl, + pp_semop, + pp_require, + pp_dofile, + pp_entereval, + pp_leaveeval, + pp_entertry, + pp_leavetry, + pp_ghbyname, + pp_ghbyaddr, + pp_ghostent, + pp_gnbyname, + pp_gnbyaddr, + pp_gnetent, + pp_gpbyname, + pp_gpbynumber, + pp_gprotoent, + pp_gsbyname, + pp_gsbyport, + pp_gservent, + pp_shostent, + pp_snetent, + pp_sprotoent, + pp_sservent, + pp_ehostent, + pp_enetent, + pp_eprotoent, + pp_eservent, + pp_gpwnam, + pp_gpwuid, + pp_gpwent, + pp_spwent, + pp_epwent, + pp_ggrnam, + pp_ggrgid, + pp_ggrent, + pp_sgrent, + pp_egrent, + pp_getlogin, + pp_syscall, + pp_lock, + pp_threadsv, +}; + +int +fprintf(PerlIO *stream, const char *format, ...) +{ + va_list(arglist); + va_start(arglist, format); + return PerlIO_vprintf(stream, format, arglist); +} + +#undef PERLVAR +#define PERLVAR(x, y) +#undef PERLVARI +#define PERLVARI(x, y, z) PL_##x = z; +#undef PERLVARIC +#define PERLVARIC(x, y, z) PL_##x = z; + +CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, + IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) +{ + memset(((char*)this)+sizeof(void*), 0, sizeof(CPerlObj)-sizeof(void*)); + +#include "thrdvar.h" +#include "intrpvar.h" +#include "perlvars.h" + + PL_piMem = ipM; + PL_piENV = ipE; + PL_piStdIO = ipStd; + PL_piLIO = ipLIO; + PL_piDir = ipD; + PL_piSock = ipS; + PL_piProc = ipP; +} + +void* +CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl) +{ + if(pvtbl != NULL) + return pvtbl->Malloc(nSize); + + return NULL; +} + +int& +CPerlObj::ErrorNo(void) +{ + return errno; +} + +void +CPerlObj::Init(void) +{ +} + +#ifdef WIN32 /* XXX why are these needed? */ +bool +do_exec(char *cmd) +{ + return PerlProc_Cmd(cmd); +} + +int +do_aspawn(void *vreally, void **vmark, void **vsp) +{ + return PerlProc_aspawn(vreally, vmark, vsp); +} +#endif /* WIN32 */ + +#endif /* PERL_OBJECT */ diff --git a/contrib/perl5/gv.c b/contrib/perl5/gv.c new file mode 100644 index 00000000000..0d96ffa97c3 --- /dev/null +++ b/contrib/perl5/gv.c @@ -0,0 +1,1448 @@ +/* gv.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure + * of your inquisitiveness, I shall spend all the rest of my days answering + * you. What more do you want to know?' + * 'The names of all the stars, and of all living things, and the whole + * history of Middle-earth and Over-heaven and of the Sundering Seas,' + * laughed Pippin. + */ + +#include "EXTERN.h" +#include "perl.h" + +GV * +gv_AVadd(register GV *gv) +{ + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for array"); + if (!GvAV(gv)) + GvAV(gv) = newAV(); + return gv; +} + +GV * +gv_HVadd(register GV *gv) +{ + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for hash"); + if (!GvHV(gv)) + GvHV(gv) = newHV(); + return gv; +} + +GV * +gv_IOadd(register GV *gv) +{ + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for filehandle"); + if (!GvIOp(gv)) + GvIOp(gv) = newIO(); + return gv; +} + +GV * +gv_fetchfile(char *name) +{ + dTHR; + char smallbuf[256]; + char *tmpbuf; + STRLEN tmplen; + GV *gv; + + tmplen = strlen(name) + 2; + if (tmplen < sizeof smallbuf) + tmpbuf = smallbuf; + else + New(603, tmpbuf, tmplen + 1, char); + tmpbuf[0] = '_'; + tmpbuf[1] = '<'; + strcpy(tmpbuf + 2, name); + gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE); + if (!isGV(gv)) + gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); + if (tmpbuf != smallbuf) + Safefree(tmpbuf); + sv_setpv(GvSV(gv), name); + if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) + GvMULTI_on(gv); + if (PERLDB_LINE) + hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); + return gv; +} + +void +gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) +{ + dTHR; + register GP *gp; + bool doproto = SvTYPE(gv) > SVt_NULL; + char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL; + + sv_upgrade((SV*)gv, SVt_PVGV); + if (SvLEN(gv)) { + if (proto) { + SvPVX(gv) = NULL; + SvLEN(gv) = 0; + SvPOK_off(gv); + } else + Safefree(SvPVX(gv)); + } + Newz(602, gp, 1, GP); + GvGP(gv) = gp_ref(gp); + GvSV(gv) = NEWSV(72,0); + GvLINE(gv) = PL_curcop->cop_line; + GvFILEGV(gv) = PL_curcop->cop_filegv; + GvCVGEN(gv) = 0; + GvEGV(gv) = gv; + sv_magic((SV*)gv, (SV*)gv, '*', name, len); + GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); + GvNAME(gv) = savepvn(name, len); + GvNAMELEN(gv) = len; + if (multi) + GvMULTI_on(gv); + if (doproto) { /* Replicate part of newSUB here. */ + SvIOK_off(gv); + ENTER; + start_subparse(0,0); /* Create CV in compcv. */ + GvCV(gv) = PL_compcv; + LEAVE; + + PL_sub_generation++; + CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv); + CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv; + CvSTASH(GvCV(gv)) = PL_curstash; +#ifdef USE_THREADS + CvOWNER(GvCV(gv)) = 0; + if (!CvMUTEXP(GvCV(gv))) + New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex); + MUTEX_INIT(CvMUTEXP(GvCV(gv))); +#endif /* USE_THREADS */ + if (proto) { + sv_setpv((SV*)GvCV(gv), proto); + Safefree(proto); + } + } +} + +STATIC void +gv_init_sv(GV *gv, I32 sv_type) +{ + switch (sv_type) { + case SVt_PVIO: + (void)GvIOn(gv); + break; + case SVt_PVAV: + (void)GvAVn(gv); + break; + case SVt_PVHV: + (void)GvHVn(gv); + break; + } +} + +GV * +gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level) +{ + AV* av; + GV* topgv; + GV* gv; + GV** gvp; + CV* cv; + + if (!stash) + return 0; + if ((level > 100) || (level < -100)) + croak("Recursive inheritance detected while looking for method '%s' in package '%s'", + name, HvNAME(stash)); + + DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) ); + + gvp = (GV**)hv_fetch(stash, name, len, (level >= 0)); + if (!gvp) + topgv = Nullgv; + else { + topgv = *gvp; + if (SvTYPE(topgv) != SVt_PVGV) + gv_init(topgv, stash, name, len, TRUE); + if (cv = GvCV(topgv)) { + /* If genuine method or valid cache entry, use it */ + if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation) + return topgv; + /* Stale cached entry: junk it */ + SvREFCNT_dec(cv); + GvCV(topgv) = cv = Nullcv; + GvCVGEN(topgv) = 0; + } + else if (GvCVGEN(topgv) == PL_sub_generation) + return 0; /* cache indicates sub doesn't exist */ + } + + gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE); + av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav; + + /* create and re-create @.*::SUPER::ISA on demand */ + if (!av || !SvMAGIC(av)) { + char* packname = HvNAME(stash); + STRLEN packlen = strlen(packname); + + if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) { + HV* basestash; + + packlen -= 7; + basestash = gv_stashpvn(packname, packlen, TRUE); + gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); + if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) { + dTHR; /* just for SvREFCNT_dec */ + gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); + if (!gvp || !(gv = *gvp)) + croak("Cannot create %s::ISA", HvNAME(stash)); + if (SvTYPE(gv) != SVt_PVGV) + gv_init(gv, stash, "ISA", 3, TRUE); + SvREFCNT_dec(GvAV(gv)); + GvAV(gv) = (AV*)SvREFCNT_inc(av); + } + } + } + + if (av) { + SV** svp = AvARRAY(av); + /* NOTE: No support for tied ISA */ + I32 items = AvFILLp(av) + 1; + while (items--) { + SV* sv = *svp++; + HV* basestash = gv_stashsv(sv, FALSE); + if (!basestash) { + if (PL_dowarn) + warn("Can't locate package %s for @%s::ISA", + SvPVX(sv), HvNAME(stash)); + continue; + } + gv = gv_fetchmeth(basestash, name, len, + (level >= 0) ? level + 1 : level - 1); + if (gv) + goto gotcha; + } + } + + /* if at top level, try UNIVERSAL */ + + if (level == 0 || level == -1) { + HV* lastchance; + + if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) { + if (gv = gv_fetchmeth(lastchance, name, len, + (level >= 0) ? level + 1 : level - 1)) { + gotcha: + /* + * Cache method in topgv if: + * 1. topgv has no synonyms (else inheritance crosses wires) + * 2. method isn't a stub (else AUTOLOAD fails spectacularly) + */ + if (topgv && + GvREFCNT(topgv) == 1 && + (cv = GvCV(gv)) && + (CvROOT(cv) || CvXSUB(cv))) + { + if (cv = GvCV(topgv)) + SvREFCNT_dec(cv); + GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv)); + GvCVGEN(topgv) = PL_sub_generation; + } + return gv; + } + else if (topgv && GvREFCNT(topgv) == 1) { + /* cache the fact that the method is not defined */ + GvCVGEN(topgv) = PL_sub_generation; + } + } + } + + return 0; +} + +GV * +gv_fetchmethod(HV *stash, char *name) +{ + return gv_fetchmethod_autoload(stash, name, TRUE); +} + +GV * +gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload) +{ + dTHR; + register char *nend; + char *nsplit = 0; + GV* gv; + + for (nend = name; *nend; nend++) { + if (*nend == '\'') + nsplit = nend; + else if (*nend == ':' && *(nend + 1) == ':') + nsplit = ++nend; + } + if (nsplit) { + char *origname = name; + name = nsplit + 1; + if (*nsplit == ':') + --nsplit; + if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) { + /* ->SUPER::method should really be looked up in original stash */ + SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER", + HvNAME(PL_curcop->cop_stash))); + stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE); + DEBUG_o( deb("Treating %s as %s::%s\n", + origname, HvNAME(stash), name) ); + } + else + stash = gv_stashpvn(origname, nsplit - origname, TRUE); + } + + gv = gv_fetchmeth(stash, name, nend - name, 0); + if (!gv) { + if (strEQ(name,"import")) + gv = (GV*)&PL_sv_yes; + else if (autoload) + gv = gv_autoload4(stash, name, nend - name, TRUE); + } + else if (autoload) { + CV* cv = GvCV(gv); + if (!CvROOT(cv) && !CvXSUB(cv)) { + GV* stubgv; + GV* autogv; + + if (CvANON(cv)) + stubgv = gv; + else { + stubgv = CvGV(cv); + if (GvCV(stubgv) != cv) /* orphaned import */ + stubgv = gv; + } + autogv = gv_autoload4(GvSTASH(stubgv), + GvNAME(stubgv), GvNAMELEN(stubgv), TRUE); + if (autogv) + gv = autogv; + } + } + + return gv; +} + +GV* +gv_autoload4(HV *stash, char *name, STRLEN len, I32 method) +{ + static char autoload[] = "AUTOLOAD"; + static STRLEN autolen = 8; + GV* gv; + CV* cv; + HV* varstash; + GV* vargv; + SV* varsv; + + if (len == autolen && strnEQ(name, autoload, autolen)) + return Nullgv; + if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE))) + return Nullgv; + cv = GvCV(gv); + + /* + * Inheriting AUTOLOAD for non-methods works ... for now. + */ + if (PL_dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash)) + warn( + "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", + HvNAME(stash), (int)len, name); + + /* + * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name. + * The subroutine's original name may not be "AUTOLOAD", so we don't + * use that, but for lack of anything better we will use the sub's + * original package to look up $AUTOLOAD. + */ + varstash = GvSTASH(CvGV(cv)); + vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE); + if (!isGV(vargv)) + gv_init(vargv, varstash, autoload, autolen, FALSE); + varsv = GvSV(vargv); + sv_setpv(varsv, HvNAME(stash)); + sv_catpvn(varsv, "::", 2); + sv_catpvn(varsv, name, len); + SvTAINTED_off(varsv); + return gv; +} + +HV* +gv_stashpv(char *name, I32 create) +{ + return gv_stashpvn(name, strlen(name), create); +} + +HV* +gv_stashpvn(char *name, U32 namelen, I32 create) +{ + char smallbuf[256]; + char *tmpbuf; + HV *stash; + GV *tmpgv; + + if (namelen + 3 < sizeof smallbuf) + tmpbuf = smallbuf; + else + New(606, tmpbuf, namelen + 3, char); + Copy(name,tmpbuf,namelen,char); + tmpbuf[namelen++] = ':'; + tmpbuf[namelen++] = ':'; + tmpbuf[namelen] = '\0'; + tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV); + if (tmpbuf != smallbuf) + Safefree(tmpbuf); + if (!tmpgv) + return 0; + if (!GvHV(tmpgv)) + GvHV(tmpgv) = newHV(); + stash = GvHV(tmpgv); + if (!HvNAME(stash)) + HvNAME(stash) = savepv(name); + return stash; +} + +HV* +gv_stashsv(SV *sv, I32 create) +{ + register char *ptr; + STRLEN len; + ptr = SvPV(sv,len); + return gv_stashpvn(ptr, len, create); +} + + +GV * +gv_fetchpv(char *nambeg, I32 add, I32 sv_type) +{ + dTHR; + register char *name = nambeg; + register GV *gv = 0; + GV**gvp; + I32 len; + register char *namend; + HV *stash = 0; + U32 add_gvflags = 0; + + if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ + name++; + + for (namend = name; *namend; namend++) { + if ((*namend == '\'' && namend[1]) || + (*namend == ':' && namend[1] == ':')) + { + if (!stash) + stash = PL_defstash; + if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */ + return Nullgv; + + len = namend - name; + if (len > 0) { + char smallbuf[256]; + char *tmpbuf; + + if (len + 3 < sizeof smallbuf) + tmpbuf = smallbuf; + else + New(601, tmpbuf, len+3, char); + Copy(name, tmpbuf, len, char); + tmpbuf[len++] = ':'; + tmpbuf[len++] = ':'; + tmpbuf[len] = '\0'; + gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); + gv = gvp ? *gvp : Nullgv; + if (gv && gv != (GV*)&PL_sv_undef) { + if (SvTYPE(gv) != SVt_PVGV) + gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI)); + else + GvMULTI_on(gv); + } + if (tmpbuf != smallbuf) + Safefree(tmpbuf); + if (!gv || gv == (GV*)&PL_sv_undef) + return Nullgv; + + if (!(stash = GvHV(gv))) + stash = GvHV(gv) = newHV(); + + if (!HvNAME(stash)) + HvNAME(stash) = savepvn(nambeg, namend - nambeg); + } + + if (*namend == ':') + namend++; + namend++; + name = namend; + if (!*name) + return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE); + } + } + len = namend - name; + if (!len) + len = 1; + + /* No stash in name, so see how we can default */ + + if (!stash) { + if (isIDFIRST(*name)) { + bool global = FALSE; + + if (isUPPER(*name)) { + if (*name == 'S' && ( + strEQ(name, "SIG") || + strEQ(name, "STDIN") || + strEQ(name, "STDOUT") || + strEQ(name, "STDERR"))) + global = TRUE; + else if (*name == 'I' && strEQ(name, "INC")) + global = TRUE; + else if (*name == 'E' && strEQ(name, "ENV")) + global = TRUE; + else if (*name == 'A' && ( + strEQ(name, "ARGV") || + strEQ(name, "ARGVOUT"))) + global = TRUE; + } + else if (*name == '_' && !name[1]) + global = TRUE; + + if (global) + stash = PL_defstash; + else if ((COP*)PL_curcop == &PL_compiling) { + stash = PL_curstash; + if (add && (PL_hints & HINT_STRICT_VARS) && + sv_type != SVt_PVCV && + sv_type != SVt_PVGV && + sv_type != SVt_PVFM && + sv_type != SVt_PVIO && + !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) ) + { + gvp = (GV**)hv_fetch(stash,name,len,0); + if (!gvp || + *gvp == (GV*)&PL_sv_undef || + SvTYPE(*gvp) != SVt_PVGV) + { + stash = 0; + } + else if (sv_type == SVt_PV && !GvIMPORTED_SV(*gvp) || + sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) || + sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) ) + { + warn("Variable \"%c%s\" is not imported", + sv_type == SVt_PVAV ? '@' : + sv_type == SVt_PVHV ? '%' : '$', + name); + if (GvCVu(*gvp)) + warn("(Did you mean &%s instead?)\n", name); + stash = 0; + } + } + } + else + stash = PL_curcop->cop_stash; + } + else + stash = PL_defstash; + } + + /* By this point we should have a stash and a name */ + + if (!stash) { + if (!add) + return Nullgv; + if (add & ~GV_ADDMULTI) { + char sv_type_char = ((sv_type == SVt_PV) ? '$' + : (sv_type == SVt_PVAV) ? '@' + : (sv_type == SVt_PVHV) ? '%' + : 0); + if (sv_type_char) + warn("Global symbol \"%c%s\" requires explicit package name", + sv_type_char, name); + else + warn("Global symbol \"%s\" requires explicit package name", + name); + } + ++PL_error_count; + stash = PL_curstash ? PL_curstash : PL_defstash; /* avoid core dumps */ + add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV + : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV + : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV + : 0); + } + + if (!SvREFCNT(stash)) /* symbol table under destruction */ + return Nullgv; + + gvp = (GV**)hv_fetch(stash,name,len,add); + if (!gvp || *gvp == (GV*)&PL_sv_undef) + return Nullgv; + gv = *gvp; + if (SvTYPE(gv) == SVt_PVGV) { + if (add) { + GvMULTI_on(gv); + gv_init_sv(gv, sv_type); + } + return gv; + } else if (add & GV_NOINIT) { + return gv; + } + + /* Adding a new symbol */ + + if (add & GV_ADDWARN) + warn("Had to create %s unexpectedly", nambeg); + gv_init(gv, stash, name, len, add & GV_ADDMULTI); + gv_init_sv(gv, sv_type); + GvFLAGS(gv) |= add_gvflags; + + /* set up magic where warranted */ + switch (*name) { + case 'A': + if (strEQ(name, "ARGV")) { + IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; + } + break; + + case 'a': + case 'b': + if (len == 1) + GvMULTI_on(gv); + break; + case 'E': + if (strnEQ(name, "EXPORT", 6)) + GvMULTI_on(gv); + break; + case 'I': + if (strEQ(name, "ISA")) { + AV* av = GvAVn(gv); + GvMULTI_on(gv); + sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); + /* NOTE: No support for tied ISA */ + if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") + && AvFILLp(av) == -1) + { + char *pname; + av_push(av, newSVpv(pname = "NDBM_File",0)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpv(pname = "DB_File",0)); + gv_stashpvn(pname, 7, TRUE); + av_push(av, newSVpv(pname = "GDBM_File",0)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpv(pname = "SDBM_File",0)); + gv_stashpvn(pname, 9, TRUE); + av_push(av, newSVpv(pname = "ODBM_File",0)); + gv_stashpvn(pname, 9, TRUE); + } + } + break; +#ifdef OVERLOAD + case 'O': + if (strEQ(name, "OVERLOAD")) { + HV* hv = GvHVn(gv); + GvMULTI_on(gv); + hv_magic(hv, gv, 'A'); + } + break; +#endif /* OVERLOAD */ + case 'S': + if (strEQ(name, "SIG")) { + HV *hv; + I32 i; + PL_siggv = gv; + GvMULTI_on(PL_siggv); + hv = GvHVn(PL_siggv); + hv_magic(hv, PL_siggv, 'S'); + for(i=1;sig_name[i];i++) { + SV ** init; + init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1); + if(init) + sv_setsv(*init,&PL_sv_undef); + psig_ptr[i] = 0; + psig_name[i] = 0; + } + } + break; + + case '&': + if (len > 1) + break; + PL_ampergv = gv; + PL_sawampersand = TRUE; + goto ro_magicalize; + + case '`': + if (len > 1) + break; + PL_leftgv = gv; + PL_sawampersand = TRUE; + goto ro_magicalize; + + case '\'': + if (len > 1) + break; + PL_rightgv = gv; + PL_sawampersand = TRUE; + goto ro_magicalize; + + case ':': + if (len > 1) + break; + sv_setpv(GvSV(gv),PL_chopset); + goto magicalize; + + case '?': + if (len > 1) + break; +#ifdef COMPLEX_STATUS + sv_upgrade(GvSV(gv), SVt_PVLV); +#endif + goto magicalize; + + case '!': + if (len > 1) + break; + if (sv_type > SVt_PV && PL_curcop != &PL_compiling) { + HV* stash = gv_stashpvn("Errno",5,FALSE); + if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) { + dSP; + PUTBACK; + perl_require_pv("Errno.pm"); + SPAGAIN; + stash = gv_stashpvn("Errno",5,FALSE); + if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) + croak("Can't use %%! because Errno.pm is not available"); + } + } + goto magicalize; + case '#': + case '*': + if (PL_dowarn && len == 1 && sv_type == SVt_PV) + warn("Use of $%s is deprecated", name); + /* FALL THROUGH */ + case '[': + case '^': + case '~': + case '=': + case '-': + case '%': + case '.': + case '(': + case ')': + case '<': + case '>': + case ',': + case '\\': + case '/': + case '|': + case '\001': + case '\004': + case '\005': + case '\006': + case '\010': + case '\011': /* NOT \t in EBCDIC */ + case '\017': + case '\020': + case '\024': + case '\027': + if (len > 1) + break; + goto magicalize; + + case '+': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + case '\023': + ro_magicalize: + SvREADONLY_on(GvSV(gv)); + magicalize: + sv_magic(GvSV(gv), (SV*)gv, 0, name, len); + break; + + case '\014': + if (len > 1) + break; + sv_setpv(GvSV(gv),"\f"); + PL_formfeed = GvSV(gv); + break; + case ';': + if (len > 1) + break; + sv_setpv(GvSV(gv),"\034"); + break; + case ']': + if (len == 1) { + SV *sv = GvSV(gv); + sv_upgrade(sv, SVt_PVNV); + sv_setpv(sv, PL_patchlevel); + (void)sv_2nv(sv); + SvREADONLY_on(sv); + } + break; + } + return gv; +} + +void +gv_fullname3(SV *sv, GV *gv, char *prefix) +{ + HV *hv = GvSTASH(gv); + if (!hv) { + SvOK_off(sv); + return; + } + sv_setpv(sv, prefix ? prefix : ""); + sv_catpv(sv,HvNAME(hv)); + sv_catpvn(sv,"::", 2); + sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); +} + +void +gv_efullname3(SV *sv, GV *gv, char *prefix) +{ + GV *egv = GvEGV(gv); + if (!egv) + egv = gv; + gv_fullname3(sv, egv, prefix); +} + +/* XXX compatibility with versions <= 5.003. */ +void +gv_fullname(SV *sv, GV *gv) +{ + gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : ""); +} + +/* XXX compatibility with versions <= 5.003. */ +void +gv_efullname(SV *sv, GV *gv) +{ + gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : ""); +} + +IO * +newIO(void) +{ + dTHR; + IO *io; + GV *iogv; + + io = (IO*)NEWSV(0,0); + sv_upgrade((SV *)io,SVt_PVIO); + SvREFCNT(io) = 1; + SvOBJECT_on(io); + iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV); + if (!iogv) + iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); + SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); + return io; +} + +void +gv_check(HV *stash) +{ + dTHR; + register HE *entry; + register I32 i; + register GV *gv; + HV *hv; + GV *filegv; + + if (!HvARRAY(stash)) + return; + for (i = 0; i <= (I32) HvMAX(stash); i++) { + for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { + if (HeKEY(entry)[HeKLEN(entry)-1] == ':' && + (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv)) + { + if (hv != PL_defstash) + gv_check(hv); /* nested package */ + } + else if (isALPHA(*HeKEY(entry))) { + gv = (GV*)HeVAL(entry); + if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) + continue; + PL_curcop->cop_line = GvLINE(gv); + filegv = GvFILEGV(gv); + PL_curcop->cop_filegv = filegv; + if (filegv && GvMULTI(filegv)) /* Filename began with slash */ + continue; + warn("Name \"%s::%s\" used only once: possible typo", + HvNAME(stash), GvNAME(gv)); + } + } + } +} + +GV * +newGVgen(char *pack) +{ + return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)PL_gensym++), + TRUE, SVt_PVGV); +} + +/* hopefully this is only called on local symbol table entries */ + +GP* +gp_ref(GP *gp) +{ + gp->gp_refcnt++; + if (gp->gp_cv) { + if (gp->gp_cvgen) { + /* multi-named GPs cannot be used for method cache */ + SvREFCNT_dec(gp->gp_cv); + gp->gp_cv = Nullcv; + gp->gp_cvgen = 0; + } + else { + /* Adding a new name to a subroutine invalidates method cache */ + PL_sub_generation++; + } + } + return gp; +} + +void +gp_free(GV *gv) +{ + GP* gp; + CV* cv; + + if (!gv || !(gp = GvGP(gv))) + return; + if (gp->gp_refcnt == 0) { + warn("Attempt to free unreferenced glob pointers"); + return; + } + if (gp->gp_cv) { + /* Deleting the name of a subroutine invalidates method cache */ + PL_sub_generation++; + } + if (--gp->gp_refcnt > 0) { + if (gp->gp_egv == gv) + gp->gp_egv = 0; + return; + } + + SvREFCNT_dec(gp->gp_sv); + SvREFCNT_dec(gp->gp_av); + SvREFCNT_dec(gp->gp_hv); + SvREFCNT_dec(gp->gp_io); + SvREFCNT_dec(gp->gp_cv); + SvREFCNT_dec(gp->gp_form); + + Safefree(gp); + GvGP(gv) = 0; +} + +#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) +#define MICROPORT +#endif + +#ifdef MICROPORT /* Microport 2.4 hack */ +AV *GvAVn(gv) +register GV *gv; +{ + if (GvGP(gv)->gp_av) + return GvGP(gv)->gp_av; + else + return GvGP(gv_AVadd(gv))->gp_av; +} + +HV *GvHVn(gv) +register GV *gv; +{ + if (GvGP(gv)->gp_hv) + return GvGP(gv)->gp_hv; + else + return GvGP(gv_HVadd(gv))->gp_hv; +} +#endif /* Microport 2.4 hack */ + +#ifdef OVERLOAD +/* Updates and caches the CV's */ + +bool +Gv_AMupdate(HV *stash) +{ + dTHR; + GV** gvp; + HV* hv; + GV* gv; + CV* cv; + MAGIC* mg=mg_find((SV*)stash,'c'); + AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; + AMT amt; + + if (mg && amtp->was_ok_am == PL_amagic_generation + && amtp->was_ok_sub == PL_sub_generation) + return AMT_AMAGIC(amtp); + if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */ + int i; + for (i=1; itable[i]) { + SvREFCNT_dec(amtp->table[i]); + } + } + } + sv_unmagic((SV*)stash, 'c'); + + DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) ); + + amt.was_ok_am = PL_amagic_generation; + amt.was_ok_sub = PL_sub_generation; + amt.fallback = AMGfallNO; + amt.flags = 0; + +#ifdef OVERLOAD_VIA_HASH + gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE); /* A shortcut */ + if (gvp && ((gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv)))) { + int filled=0; + int i; + char *cp; + SV* sv; + SV** svp; + + /* Work with "fallback" key, which we assume to be first in AMG_names */ + + if (( cp = (char *)AMG_names[0] ) && + (svp = (SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) { + if (SvTRUE(sv)) amt.fallback=AMGfallYES; + else if (SvOK(sv)) amt.fallback=AMGfallNEVER; + } + for (i = 1; i < NofAMmeth; i++) { + cv = 0; + cp = (char *)AMG_names[i]; + + svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE); + if (svp && ((sv = *svp) != &PL_sv_undef)) { + switch (SvTYPE(sv)) { + default: + if (!SvROK(sv)) { + if (!SvOK(sv)) break; + gv = gv_fetchmethod(stash, SvPV(sv, PL_na)); + if (gv) cv = GvCV(gv); + break; + } + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) == SVt_PVCV) + break; + /* FALL THROUGH */ + case SVt_PVHV: + case SVt_PVAV: + croak("Not a subroutine reference in overload table"); + return FALSE; + case SVt_PVCV: + cv = (CV*)sv; + break; + case SVt_PVGV: + if (!(cv = GvCVu((GV*)sv))) + cv = sv_2cv(sv, &stash, &gv, TRUE); + break; + } + if (cv) filled=1; + else { + croak("Method for operation %s not found in package %.256s during blessing\n", + cp,HvNAME(stash)); + return FALSE; + } + } +#else + { + int filled = 0; + int i; + const char *cp; + SV* sv = NULL; + SV** svp; + + /* Work with "fallback" key, which we assume to be first in AMG_names */ + + if ( cp = AMG_names[0] ) { + /* Try to find via inheritance. */ + gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */ + if (gv) sv = GvSV(gv); + + if (!gv) goto no_table; + else if (SvTRUE(sv)) amt.fallback=AMGfallYES; + else if (SvOK(sv)) amt.fallback=AMGfallNEVER; + } + + for (i = 1; i < NofAMmeth; i++) { + SV *cookie = sv_2mortal(newSVpvf("(%s", cp = AMG_names[i])); + DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n", + cp, HvNAME(stash)) ); + /* don't fill the cache while looking up! */ + gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1); + cv = 0; + if(gv && (cv = GvCV(gv))) { + if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil") + && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) { + /* GvSV contains the name of the method. */ + GV *ngv; + + DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n", + SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) ); + if (!SvPOK(GvSV(gv)) + || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)), + FALSE))) + { + /* Can be an import stub (created by `can'). */ + if (GvCVGEN(gv)) { + croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'", + (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), + cp, HvNAME(stash)); + } else + croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'", + (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ), + cp, HvNAME(stash)); + } + cv = GvCV(gv = ngv); + } + DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n", + cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))), + GvNAME(CvGV(cv))) ); + filled = 1; + } +#endif + amt.table[i]=(CV*)SvREFCNT_inc(cv); + } + if (filled) { + AMT_AMAGIC_on(&amt); + sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT)); + return TRUE; + } + } + /* Here we have no table: */ + no_table: + AMT_AMAGIC_off(&amt); + sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS)); + return FALSE; +} + +SV* +amagic_call(SV *left, SV *right, int method, int flags) +{ + dTHR; + MAGIC *mg; + CV *cv; + CV **cvp=NULL, **ocvp=NULL; + AMT *amtp, *oamtp; + int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; + int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; + HV* stash; + if (!(AMGf_noleft & flags) && SvAMAGIC(left) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) + && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) + ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table + : (CV **) NULL)) + && ((cv = cvp[off=method+assignshift]) + || (assign && amtp->fallback > AMGfallNEVER && /* fallback to + * usual method */ + (fl = 1, cv = cvp[off=method])))) { + lr = -1; /* Call method for left argument */ + } else { + if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) { + int logic; + + /* look for substituted methods */ + /* In all the covered cases we should be called with assign==0. */ + switch (method) { + case inc_amg: + force_cpy = 1; + if ((cv = cvp[off=add_ass_amg]) + || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) { + right = &PL_sv_yes; lr = -1; assign = 1; + } + break; + case dec_amg: + force_cpy = 1; + if ((cv = cvp[off = subtr_ass_amg]) + || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) { + right = &PL_sv_yes; lr = -1; assign = 1; + } + break; + case bool__amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg])); + break; + case numer_amg: + (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg])); + break; + case string_amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg])); + break; + case not_amg: + (void)((cv = cvp[off=bool__amg]) + || (cv = cvp[off=numer_amg]) + || (cv = cvp[off=string_amg])); + postpr = 1; + break; + case copy_amg: + { + /* + * SV* ref causes confusion with the interpreter variable of + * the same name + */ + SV* tmpRef=SvRV(left); + if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) { + /* + * Just to be extra cautious. Maybe in some + * additional cases sv_setsv is safe, too. + */ + SV* newref = newSVsv(tmpRef); + SvOBJECT_on(newref); + SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef)); + return newref; + } + } + break; + case abs_amg: + if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) + && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) { + SV* nullsv=sv_2mortal(newSViv(0)); + if (off1==lt_amg) { + SV* lessp = amagic_call(left,nullsv, + lt_amg,AMGf_noright); + logic = SvTRUE(lessp); + } else { + SV* lessp = amagic_call(left,nullsv, + ncmp_amg,AMGf_noright); + logic = (SvNV(lessp) < 0); + } + if (logic) { + if (off==subtr_amg) { + right = left; + left = nullsv; + lr = 1; + } + } else { + return left; + } + } + break; + case neg_amg: + if (cv = cvp[off=subtr_amg]) { + right = left; + left = sv_2mortal(newSViv(0)); + lr = 1; + } + break; + default: + goto not_found; + } + if (!cv) goto not_found; + } else if (!(AMGf_noright & flags) && SvAMAGIC(right) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) + && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) + ? (amtp = (AMT*)mg->mg_ptr)->table + : (CV **) NULL)) + && (cv = cvp[off=method])) { /* Method for right + * argument found */ + lr=1; + } else if (((ocvp && oamtp->fallback > AMGfallNEVER + && (cvp=ocvp) && (lr = -1)) + || (cvp && amtp->fallback > AMGfallNEVER && (lr=1))) + && !(flags & AMGf_unary)) { + /* We look for substitution for + * comparison operations and + * concatenation */ + if (method==concat_amg || method==concat_ass_amg + || method==repeat_amg || method==repeat_ass_amg) { + return NULL; /* Delegate operation to string conversion */ + } + off = -1; + switch (method) { + case lt_amg: + case le_amg: + case gt_amg: + case ge_amg: + case eq_amg: + case ne_amg: + postpr = 1; off=ncmp_amg; break; + case slt_amg: + case sle_amg: + case sgt_amg: + case sge_amg: + case seq_amg: + case sne_amg: + postpr = 1; off=scmp_amg; break; + } + if (off != -1) cv = cvp[off]; + if (!cv) { + goto not_found; + } + } else { + not_found: /* No method found, either report or croak */ + if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */ + notfound = 1; lr = -1; + } else if (cvp && (cv=cvp[nomethod_amg])) { + notfound = 1; lr = 1; + } else { + SV *msg; + if (off==-1) off=method; + msg = sv_2mortal(newSVpvf( + "Operation `%s': no method found,%sargument %s%s%s%s", + AMG_names[method + assignshift], + (flags & AMGf_unary ? " " : "\n\tleft "), + SvAMAGIC(left)? + "in overloaded package ": + "has no overloaded magic", + SvAMAGIC(left)? + HvNAME(SvSTASH(SvRV(left))): + "", + SvAMAGIC(right)? + ",\n\tright argument in overloaded package ": + (flags & AMGf_unary + ? "" + : ",\n\tright argument has no overloaded magic"), + SvAMAGIC(right)? + HvNAME(SvSTASH(SvRV(right))): + "")); + if (amtp && amtp->fallback >= AMGfallYES) { + DEBUG_o( deb("%s", SvPVX(msg)) ); + } else { + croak("%_", msg); + } + return NULL; + } + force_cpy = force_cpy || assign; + } + } + if (!notfound) { + DEBUG_o( deb( + "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n", + AMG_names[off], + method+assignshift==off? "" : + " (initially `", + method+assignshift==off? "" : + AMG_names[method+assignshift], + method+assignshift==off? "" : "')", + flags & AMGf_unary? "" : + lr==1 ? " for right argument": " for left argument", + flags & AMGf_unary? " for argument" : "", + HvNAME(stash), + fl? ",\n\tassignment variant used": "") ); + } + /* Since we use shallow copy during assignment, we need + * to dublicate the contents, probably calling user-supplied + * version of copy operator + */ + /* We need to copy in following cases: + * a) Assignment form was called. + * assignshift==1, assign==T, method + 1 == off + * b) Increment or decrement, called directly. + * assignshift==0, assign==0, method + 0 == off + * c) Increment or decrement, translated to assignment add/subtr. + * assignshift==0, assign==T, + * force_cpy == T + * d) Increment or decrement, translated to nomethod. + * assignshift==0, assign==0, + * force_cpy == T + * e) Assignment form translated to nomethod. + * assignshift==1, assign==T, method + 1 != off + * force_cpy == T + */ + /* off is method, method+assignshift, or a result of opcode substitution. + * In the latter case assignshift==0, so only notfound case is important. + */ + if (( (method + assignshift == off) + && (assign || (method == inc_amg) || (method == dec_amg))) + || force_cpy) + RvDEEPCP(left); + { + dSP; + BINOP myop; + SV* res; + bool oldcatch = CATCH_GET; + + CATCH_SET(TRUE); + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; + + PUSHSTACKi(PERLSI_OVERLOAD); + ENTER; + SAVEOP(); + PL_op = (OP *) &myop; + if (PERLDB_SUB && PL_curstash != PL_debstash) + PL_op->op_private |= OPpENTERSUB_DB; + PUTBACK; + pp_pushmark(ARGS); + + EXTEND(SP, notfound + 5); + PUSHs(lr>0? right: left); + PUSHs(lr>0? left: right); + PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no )); + if (notfound) { + PUSHs( sv_2mortal(newSVpv((char *)AMG_names[method + assignshift],0)) ); + } + PUSHs((SV*)cv); + PUTBACK; + + if (PL_op = pp_entersub(ARGS)) + CALLRUNOPS(); + LEAVE; + SPAGAIN; + + res=POPs; + POPSTACK; + CATCH_SET(oldcatch); + + if (postpr) { + int ans; + switch (method) { + case le_amg: + case sle_amg: + ans=SvIV(res)<=0; break; + case lt_amg: + case slt_amg: + ans=SvIV(res)<0; break; + case ge_amg: + case sge_amg: + ans=SvIV(res)>=0; break; + case gt_amg: + case sgt_amg: + ans=SvIV(res)>0; break; + case eq_amg: + case seq_amg: + ans=SvIV(res)==0; break; + case ne_amg: + case sne_amg: + ans=SvIV(res)!=0; break; + case inc_amg: + case dec_amg: + SvSetSV(left,res); return left; + case not_amg: + ans=!SvOK(res); break; + } + return boolSV(ans); + } else if (method==copy_amg) { + if (!SvROK(res)) { + croak("Copy method did not return a reference"); + } + return SvREFCNT_inc(SvRV(res)); + } else { + return res; + } + } +} +#endif /* OVERLOAD */ + diff --git a/contrib/perl5/gv.h b/contrib/perl5/gv.h new file mode 100644 index 00000000000..8d987edbc47 --- /dev/null +++ b/contrib/perl5/gv.h @@ -0,0 +1,137 @@ +/* gv.h + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +struct gp { + SV * gp_sv; /* scalar value */ + U32 gp_refcnt; /* how many globs point to this? */ + struct io * gp_io; /* filehandle value */ + CV * gp_form; /* format value */ + AV * gp_av; /* array value */ + HV * gp_hv; /* hash value */ + GV * gp_egv; /* effective gv, if *glob */ + CV * gp_cv; /* subroutine value */ + U32 gp_cvgen; /* generational validity of cached gv_cv */ + I32 gp_lastexpr; /* used by nothing_in_common() */ + line_t gp_line; /* line first declared at (for -w) */ + GV * gp_filegv; /* file first declared in (for -w) */ +}; + +#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) +#define MICROPORT +#endif + +#define GvXPVGV(gv) ((XPVGV*)SvANY(gv)) + +#define GvGP(gv) (GvXPVGV(gv)->xgv_gp) +#define GvNAME(gv) (GvXPVGV(gv)->xgv_name) +#define GvNAMELEN(gv) (GvXPVGV(gv)->xgv_namelen) +#define GvSTASH(gv) (GvXPVGV(gv)->xgv_stash) +#define GvFLAGS(gv) (GvXPVGV(gv)->xgv_flags) + +#define GvSV(gv) (GvGP(gv)->gp_sv) +#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) +#define GvIO(gv) ((gv) && SvTYPE((SV*)gv) == SVt_PVGV ? GvIOp(gv) : 0) +#define GvIOp(gv) (GvGP(gv)->gp_io) +#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) + +#define GvFORM(gv) (GvGP(gv)->gp_form) +#define GvAV(gv) (GvGP(gv)->gp_av) + +/* This macro is deprecated. Do not use! */ +#define GvREFCNT_inc(gv) ((GV*)SvREFCNT_inc(gv)) /* DO NOT USE */ + +#ifdef MICROPORT /* Microport 2.4 hack */ +AV *GvAVn(); +#else +#define GvAVn(gv) (GvGP(gv)->gp_av ? \ + GvGP(gv)->gp_av : \ + GvGP(gv_AVadd(gv))->gp_av) +#endif +#define GvHV(gv) ((GvGP(gv))->gp_hv) + +#ifdef MICROPORT /* Microport 2.4 hack */ +HV *GvHVn(); +#else +#define GvHVn(gv) (GvGP(gv)->gp_hv ? \ + GvGP(gv)->gp_hv : \ + GvGP(gv_HVadd(gv))->gp_hv) +#endif /* Microport 2.4 hack */ + +#define GvCV(gv) (GvGP(gv)->gp_cv) +#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) +#define GvCVu(gv) (GvGP(gv)->gp_cvgen ? Nullcv : GvGP(gv)->gp_cv) + +#define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr) + +#define GvLINE(gv) (GvGP(gv)->gp_line) +#define GvFILEGV(gv) (GvGP(gv)->gp_filegv) + +#define GvEGV(gv) (GvGP(gv)->gp_egv) +#define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv) +#define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv) + +#define GVf_INTRO 0x01 +#define GVf_MULTI 0x02 +#define GVf_ASSUMECV 0x04 +#define GVf_IMPORTED 0xF0 +#define GVf_IMPORTED_SV 0x10 +#define GVf_IMPORTED_AV 0x20 +#define GVf_IMPORTED_HV 0x40 +#define GVf_IMPORTED_CV 0x80 + +#define GvINTRO(gv) (GvFLAGS(gv) & GVf_INTRO) +#define GvINTRO_on(gv) (GvFLAGS(gv) |= GVf_INTRO) +#define GvINTRO_off(gv) (GvFLAGS(gv) &= ~GVf_INTRO) + +#define GvMULTI(gv) (GvFLAGS(gv) & GVf_MULTI) +#define GvMULTI_on(gv) (GvFLAGS(gv) |= GVf_MULTI) +#define GvMULTI_off(gv) (GvFLAGS(gv) &= ~GVf_MULTI) + +#define GvASSUMECV(gv) (GvFLAGS(gv) & GVf_ASSUMECV) +#define GvASSUMECV_on(gv) (GvFLAGS(gv) |= GVf_ASSUMECV) +#define GvASSUMECV_off(gv) (GvFLAGS(gv) &= ~GVf_ASSUMECV) + +#define GvIMPORTED(gv) (GvFLAGS(gv) & GVf_IMPORTED) +#define GvIMPORTED_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED) +#define GvIMPORTED_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED) + +#define GvIMPORTED_SV(gv) (GvFLAGS(gv) & GVf_IMPORTED_SV) +#define GvIMPORTED_SV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_SV) +#define GvIMPORTED_SV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_SV) + +#define GvIMPORTED_AV(gv) (GvFLAGS(gv) & GVf_IMPORTED_AV) +#define GvIMPORTED_AV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_AV) +#define GvIMPORTED_AV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_AV) + +#define GvIMPORTED_HV(gv) (GvFLAGS(gv) & GVf_IMPORTED_HV) +#define GvIMPORTED_HV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_HV) +#define GvIMPORTED_HV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_HV) + +#define GvIMPORTED_CV(gv) (GvFLAGS(gv) & GVf_IMPORTED_CV) +#define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) +#define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) + +#define Nullgv Null(GV*) + +#define DM_UID 0x003 +#define DM_RUID 0x001 +#define DM_EUID 0x002 +#define DM_GID 0x030 +#define DM_RGID 0x010 +#define DM_EGID 0x020 +#define DM_DELAY 0x100 + +/* + * symbol creation flags, for use in gv_fetchpv() and perl_get_*v() + */ +#define GV_ADD 0x01 /* add, if symbol not already there */ +#define GV_ADDMULTI 0x02 /* add, pretending it has been added already */ +#define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ +#define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ +#define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ diff --git a/contrib/perl5/h2pl/README b/contrib/perl5/h2pl/README new file mode 100644 index 00000000000..5fe8ae7aa33 --- /dev/null +++ b/contrib/perl5/h2pl/README @@ -0,0 +1,71 @@ +[This file of Tom Christiansen's has been edited to change makelib to h2ph +and .h to .ph where appropriate--law.] + +This directory contains files to help you convert the *.ph files generated my +h2ph out of the perl source directory into *.pl files with all the +indirection of the subroutine calls removed. The .ph version will be more +safely portable, because if something isn't defined on the new system, like +&TIOCGETP, then you'll get a fatal run-time error on the system lacking that +function. Using the .pl version means that the subsequent scripts will give +you a 0 $TIOCGETP and God only knows what may then happen. Still, I like the +.pl stuff because they're faster to load. + +FIrst, you need to run h2ph on things like sys/ioctl.h to get stuff +into the perl library directory, often /usr/local/lib/perl. For example, + # h2ph sys/ioctl.h +takes /usr/include/sys/ioctl.h as input and writes (without i/o redirection) +the file /usr/local/lib/perl/sys/ioctl.ph, which looks like this + + eval 'sub TIOCM_RTS {0004;}'; + eval 'sub TIOCM_ST {0010;}'; + eval 'sub TIOCM_SR {0020;}'; + eval 'sub TIOCM_CTS {0040;}'; + eval 'sub TIOCM_CAR {0100;}'; + +and much worse, rather than what Larry's ioctl.pl from the perl source dir has, +which is: + + $TIOCM_RTS = 0004; + $TIOCM_ST = 0010; + $TIOCM_SR = 0020; + $TIOCM_CTS = 0040; + $TIOCM_CAR = 0100; + +[Workaround for fixed bug in makedir/h2ph deleted--law.] + +The more complicated ioctl subs look like this: + + eval 'sub TIOCGSIZE {&TIOCGWINSZ;}'; + eval 'sub TIOCGWINSZ {&_IOR("t", 104, \'struct winsize\');}'; + eval 'sub TIOCSETD {&_IOW("t", 1, \'int\');}'; + eval 'sub TIOCGETP {&_IOR("t", 8,\'struct sgttyb\');}'; + +The _IO[RW] routines use a %sizeof array, which (presumably) +is keyed on the type name with the value being the size in bytes. + +To build %sizeof, try running this in this directory: + + % ./getioctlsizes + +Which will tell you which things the %sizeof array needs +to hold. You can try to build a sizeof.ph file with: + + % ./getioctlsizes | ./mksizes > sizeof.ph + +Note that mksizes hardcodes the #include files for all the types, so it will +probably require customization. Once you have sizeof.ph, install it in the +perl library directory. Run my tcbreak script to see whether you can do +ioctls in perl now. You'll get some kind of fatal run-time error if you +can't. That script should be included in this directory. + +If this works well, now you can try to convert the *.ph files into +*.pl files. Try this: + + foreach file ( sysexits.ph sys/{errno.ph,ioctl.ph} ) + ./mkvars $file > t/$file:r.pl + end + +The last one will be the hardest. If it works, should be able to +run tcbreak2 and have it work the same as tcbreak. + +Good luck. diff --git a/contrib/perl5/h2pl/cbreak.pl b/contrib/perl5/h2pl/cbreak.pl new file mode 100644 index 00000000000..422185eb7b4 --- /dev/null +++ b/contrib/perl5/h2pl/cbreak.pl @@ -0,0 +1,34 @@ +$sgttyb_t = 'C4 S'; + +sub cbreak { + &set_cbreak(1); +} + +sub cooked { + &set_cbreak(0); +} + +sub set_cbreak { + local($on) = @_; + + require 'sizeof.ph'; + require 'sys/ioctl.ph'; + + ioctl(STDIN,&TIOCGETP,$sgttyb) + || die "Can't ioctl TIOCGETP: $!"; + + @ary = unpack($sgttyb_t,$sgttyb); + if ($on) { + $ary[4] |= &CBREAK; + $ary[4] &= ~&ECHO; + } else { + $ary[4] &= ~&CBREAK; + $ary[4] |= &ECHO; + } + $sgttyb = pack($sgttyb_t,@ary); + ioctl(STDIN,&TIOCSETP,$sgttyb) + || die "Can't ioctl TIOCSETP: $!"; + +} + +1; diff --git a/contrib/perl5/h2pl/cbreak2.pl b/contrib/perl5/h2pl/cbreak2.pl new file mode 100644 index 00000000000..8ac55a34975 --- /dev/null +++ b/contrib/perl5/h2pl/cbreak2.pl @@ -0,0 +1,33 @@ +$sgttyb_t = 'C4 S'; + +sub cbreak { + &set_cbreak(1); +} + +sub cooked { + &set_cbreak(0); +} + +sub set_cbreak { + local($on) = @_; + + require 'sys/ioctl.pl'; + + ioctl(STDIN,$TIOCGETP,$sgttyb) + || die "Can't ioctl TIOCGETP: $!"; + + @ary = unpack($sgttyb_t,$sgttyb); + if ($on) { + $ary[4] |= $CBREAK; + $ary[4] &= ~$ECHO; + } else { + $ary[4] &= ~$CBREAK; + $ary[4] |= $ECHO; + } + $sgttyb = pack($sgttyb_t,@ary); + ioctl(STDIN,$TIOCSETP,$sgttyb) + || die "Can't ioctl TIOCSETP: $!"; + +} + +1; diff --git a/contrib/perl5/h2pl/eg/sizeof.ph b/contrib/perl5/h2pl/eg/sizeof.ph new file mode 100644 index 00000000000..285bff18591 --- /dev/null +++ b/contrib/perl5/h2pl/eg/sizeof.ph @@ -0,0 +1,14 @@ +$sizeof{'char'} = 1; +$sizeof{'int'} = 4; +$sizeof{'long'} = 4; +$sizeof{'struct arpreq'} = 36; +$sizeof{'struct ifconf'} = 8; +$sizeof{'struct ifreq'} = 32; +$sizeof{'struct ltchars'} = 6; +$sizeof{'struct pcntl'} = 116; +$sizeof{'struct rtentry'} = 52; +$sizeof{'struct sgttyb'} = 6; +$sizeof{'struct tchars'} = 6; +$sizeof{'struct ttychars'} = 14; +$sizeof{'struct winsize'} = 8; +$sizeof{'struct termios'} = 132; diff --git a/contrib/perl5/h2pl/eg/sys/errno.pl b/contrib/perl5/h2pl/eg/sys/errno.pl new file mode 100644 index 00000000000..d9ba3be190f --- /dev/null +++ b/contrib/perl5/h2pl/eg/sys/errno.pl @@ -0,0 +1,92 @@ +$EPERM = 0x1; +$ENOENT = 0x2; +$ESRCH = 0x3; +$EINTR = 0x4; +$EIO = 0x5; +$ENXIO = 0x6; +$E2BIG = 0x7; +$ENOEXEC = 0x8; +$EBADF = 0x9; +$ECHILD = 0xA; +$EAGAIN = 0xB; +$ENOMEM = 0xC; +$EACCES = 0xD; +$EFAULT = 0xE; +$ENOTBLK = 0xF; +$EBUSY = 0x10; +$EEXIST = 0x11; +$EXDEV = 0x12; +$ENODEV = 0x13; +$ENOTDIR = 0x14; +$EISDIR = 0x15; +$EINVAL = 0x16; +$ENFILE = 0x17; +$EMFILE = 0x18; +$ENOTTY = 0x19; +$ETXTBSY = 0x1A; +$EFBIG = 0x1B; +$ENOSPC = 0x1C; +$ESPIPE = 0x1D; +$EROFS = 0x1E; +$EMLINK = 0x1F; +$EPIPE = 0x20; +$EDOM = 0x21; +$ERANGE = 0x22; +$EWOULDBLOCK = 0x23; +$EINPROGRESS = 0x24; +$EALREADY = 0x25; +$ENOTSOCK = 0x26; +$EDESTADDRREQ = 0x27; +$EMSGSIZE = 0x28; +$EPROTOTYPE = 0x29; +$ENOPROTOOPT = 0x2A; +$EPROTONOSUPPORT = 0x2B; +$ESOCKTNOSUPPORT = 0x2C; +$EOPNOTSUPP = 0x2D; +$EPFNOSUPPORT = 0x2E; +$EAFNOSUPPORT = 0x2F; +$EADDRINUSE = 0x30; +$EADDRNOTAVAIL = 0x31; +$ENETDOWN = 0x32; +$ENETUNREACH = 0x33; +$ENETRESET = 0x34; +$ECONNABORTED = 0x35; +$ECONNRESET = 0x36; +$ENOBUFS = 0x37; +$EISCONN = 0x38; +$ENOTCONN = 0x39; +$ESHUTDOWN = 0x3A; +$ETOOMANYREFS = 0x3B; +$ETIMEDOUT = 0x3C; +$ECONNREFUSED = 0x3D; +$ELOOP = 0x3E; +$ENAMETOOLONG = 0x3F; +$EHOSTDOWN = 0x40; +$EHOSTUNREACH = 0x41; +$ENOTEMPTY = 0x42; +$EPROCLIM = 0x43; +$EUSERS = 0x44; +$EDQUOT = 0x45; +$ESTALE = 0x46; +$EREMOTE = 0x47; +$EDEADLK = 0x48; +$ENOLCK = 0x49; +$MTH_UNDEF_SQRT = 0x12C; +$MTH_OVF_EXP = 0x12D; +$MTH_UNDEF_LOG = 0x12E; +$MTH_NEG_BASE = 0x12F; +$MTH_ZERO_BASE = 0x130; +$MTH_OVF_POW = 0x131; +$MTH_LRG_SIN = 0x132; +$MTH_LRG_COS = 0x133; +$MTH_LRG_TAN = 0x134; +$MTH_LRG_COT = 0x135; +$MTH_OVF_TAN = 0x136; +$MTH_OVF_COT = 0x137; +$MTH_UNDEF_ASIN = 0x138; +$MTH_UNDEF_ACOS = 0x139; +$MTH_UNDEF_ATAN2 = 0x13A; +$MTH_OVF_SINH = 0x13B; +$MTH_OVF_COSH = 0x13C; +$MTH_UNDEF_ZLOG = 0x13D; +$MTH_UNDEF_ZDIV = 0x13E; diff --git a/contrib/perl5/h2pl/eg/sys/ioctl.pl b/contrib/perl5/h2pl/eg/sys/ioctl.pl new file mode 100644 index 00000000000..0b552caa00e --- /dev/null +++ b/contrib/perl5/h2pl/eg/sys/ioctl.pl @@ -0,0 +1,186 @@ +$_IOCTL_ = 0x1; +$TIOCGSIZE = 0x40087468; +$TIOCSSIZE = 0x80087467; +$IOCPARM_MASK = 0x7F; +$IOC_VOID = 0x20000000; +$IOC_OUT = 0x40000000; +$IOC_IN = 0x80000000; +$IOC_INOUT = 0xC0000000; +$TIOCGETD = 0x40047400; +$TIOCSETD = 0x80047401; +$TIOCHPCL = 0x20007402; +$TIOCMODG = 0x40047403; +$TIOCMODS = 0x80047404; +$TIOCM_LE = 0x1; +$TIOCM_DTR = 0x2; +$TIOCM_RTS = 0x4; +$TIOCM_ST = 0x8; +$TIOCM_SR = 0x10; +$TIOCM_CTS = 0x20; +$TIOCM_CAR = 0x40; +$TIOCM_CD = 0x40; +$TIOCM_RNG = 0x80; +$TIOCM_RI = 0x80; +$TIOCM_DSR = 0x100; +$TIOCGETP = 0x40067408; +$TIOCSETP = 0x80067409; +$TIOCSETN = 0x8006740A; +$TIOCEXCL = 0x2000740D; +$TIOCNXCL = 0x2000740E; +$TIOCFLUSH = 0x80047410; +$TIOCSETC = 0x80067411; +$TIOCGETC = 0x40067412; +$TIOCSET = 0x80047413; +$TIOCBIS = 0x80047414; +$TIOCBIC = 0x80047415; +$TIOCGET = 0x40047416; +$TANDEM = 0x1; +$CBREAK = 0x2; +$LCASE = 0x4; +$ECHO = 0x8; +$CRMOD = 0x10; +$RAW = 0x20; +$ODDP = 0x40; +$EVENP = 0x80; +$ANYP = 0xC0; +$NLDELAY = 0x300; +$NL0 = 0x0; +$NL1 = 0x100; +$NL2 = 0x200; +$NL3 = 0x300; +$TBDELAY = 0xC00; +$TAB0 = 0x0; +$TAB1 = 0x400; +$TAB2 = 0x800; +$XTABS = 0xC00; +$CRDELAY = 0x3000; +$CR0 = 0x0; +$CR1 = 0x1000; +$CR2 = 0x2000; +$CR3 = 0x3000; +$VTDELAY = 0x4000; +$FF0 = 0x0; +$FF1 = 0x4000; +$BSDELAY = 0x8000; +$BS0 = 0x0; +$BS1 = 0x8000; +$ALLDELAY = 0xFF00; +$CRTBS = 0x10000; +$PRTERA = 0x20000; +$CRTERA = 0x40000; +$TILDE = 0x80000; +$MDMBUF = 0x100000; +$LITOUT = 0x200000; +$TOSTOP = 0x400000; +$FLUSHO = 0x800000; +$NOHANG = 0x1000000; +$L001000 = 0x2000000; +$CRTKIL = 0x4000000; +$L004000 = 0x8000000; +$CTLECH = 0x10000000; +$PENDIN = 0x20000000; +$DECCTQ = 0x40000000; +$NOFLSH = 0x80000000; +$TIOCCSET = 0x800E7417; +$TIOCCGET = 0x400E7418; +$TIOCLBIS = 0x8004747F; +$TIOCLBIC = 0x8004747E; +$TIOCLSET = 0x8004747D; +$TIOCLGET = 0x4004747C; +$LCRTBS = 0x1; +$LPRTERA = 0x2; +$LCRTERA = 0x4; +$LTILDE = 0x8; +$LMDMBUF = 0x10; +$LLITOUT = 0x20; +$LTOSTOP = 0x40; +$LFLUSHO = 0x80; +$LNOHANG = 0x100; +$LCRTKIL = 0x400; +$LCTLECH = 0x1000; +$LPENDIN = 0x2000; +$LDECCTQ = 0x4000; +$LNOFLSH = 0x8000; +$TIOCSBRK = 0x2000747B; +$TIOCCBRK = 0x2000747A; +$TIOCSDTR = 0x20007479; +$TIOCCDTR = 0x20007478; +$TIOCGPGRP = 0x40047477; +$TIOCSPGRP = 0x80047476; +$TIOCSLTC = 0x80067475; +$TIOCGLTC = 0x40067474; +$TIOCOUTQ = 0x40047473; +$TIOCSTI = 0x80017472; +$TIOCNOTTY = 0x20007471; +$TIOCPKT = 0x80047470; +$TIOCPKT_DATA = 0x0; +$TIOCPKT_FLUSHREAD = 0x1; +$TIOCPKT_FLUSHWRITE = 0x2; +$TIOCPKT_STOP = 0x4; +$TIOCPKT_START = 0x8; +$TIOCPKT_NOSTOP = 0x10; +$TIOCPKT_DOSTOP = 0x20; +$TIOCSTOP = 0x2000746F; +$TIOCSTART = 0x2000746E; +$TIOCREMOTE = 0x20007469; +$TIOCGWINSZ = 0x40087468; +$TIOCSWINSZ = 0x80087467; +$TIOCRESET = 0x20007466; +$OTTYDISC = 0x0; +$NETLDISC = 0x1; +$NTTYDISC = 0x2; +$FIOCLEX = 0x20006601; +$FIONCLEX = 0x20006602; +$FIONREAD = 0x4004667F; +$FIONBIO = 0x8004667E; +$FIOASYNC = 0x8004667D; +$FIOSETOWN = 0x8004667C; +$FIOGETOWN = 0x4004667B; +$STPUTTABLE = 0x8004667A; +$STGETTABLE = 0x80046679; +$SIOCSHIWAT = 0x80047300; +$SIOCGHIWAT = 0x40047301; +$SIOCSLOWAT = 0x80047302; +$SIOCGLOWAT = 0x40047303; +$SIOCATMARK = 0x40047307; +$SIOCSPGRP = 0x80047308; +$SIOCGPGRP = 0x40047309; +$SIOCADDRT = 0x8034720A; +$SIOCDELRT = 0x8034720B; +$SIOCSIFADDR = 0x8020690C; +$SIOCGIFADDR = 0xC020690D; +$SIOCSIFDSTADDR = 0x8020690E; +$SIOCGIFDSTADDR = 0xC020690F; +$SIOCSIFFLAGS = 0x80206910; +$SIOCGIFFLAGS = 0xC0206911; +$SIOCGIFBRDADDR = 0xC0206912; +$SIOCSIFBRDADDR = 0x80206913; +$SIOCGIFCONF = 0xC0086914; +$SIOCGIFNETMASK = 0xC0206915; +$SIOCSIFNETMASK = 0x80206916; +$SIOCGIFMETRIC = 0xC0206917; +$SIOCSIFMETRIC = 0x80206918; +$SIOCSARP = 0x8024691E; +$SIOCGARP = 0xC024691F; +$SIOCDARP = 0x80246920; +$PIXCONTINUE = 0x80747000; +$PIXSTEP = 0x80747001; +$PIXTERMINATE = 0x20007002; +$PIGETFLAGS = 0x40747003; +$PIXINHERIT = 0x80747004; +$PIXDETACH = 0x20007005; +$PIXGETSUBCODE = 0xC0747006; +$PIXRDREGS = 0xC0747007; +$PIXWRREGS = 0xC0747008; +$PIXRDVREGS = 0xC0747009; +$PIXWRVREGS = 0xC074700A; +$PIXRDVSTATE = 0xC074700B; +$PIXWRVSTATE = 0xC074700C; +$PIXRDCREGS = 0xC074700D; +$PIXWRCREGS = 0xC074700E; +$PIRDSDRS = 0xC074700F; +$PIXGETSIGACTION = 0xC0747010; +$PIGETU = 0xC0747011; +$PISETRWTID = 0xC0747012; +$PIXGETTHCOUNT = 0xC0747013; +$PIXRUN = 0x20007014; diff --git a/contrib/perl5/h2pl/eg/sysexits.pl b/contrib/perl5/h2pl/eg/sysexits.pl new file mode 100644 index 00000000000..f4cb777ee91 --- /dev/null +++ b/contrib/perl5/h2pl/eg/sysexits.pl @@ -0,0 +1,16 @@ +$EX_OK = 0x0; +$EX__BASE = 0x40; +$EX_USAGE = 0x40; +$EX_DATAERR = 0x41; +$EX_NOINPUT = 0x42; +$EX_NOUSER = 0x43; +$EX_NOHOST = 0x44; +$EX_UNAVAILABLE = 0x45; +$EX_SOFTWARE = 0x46; +$EX_OSERR = 0x47; +$EX_OSFILE = 0x48; +$EX_CANTCREAT = 0x49; +$EX_IOERR = 0x4A; +$EX_TEMPFAIL = 0x4B; +$EX_PROTOCOL = 0x4C; +$EX_NOPERM = 0x4D; diff --git a/contrib/perl5/h2pl/getioctlsizes b/contrib/perl5/h2pl/getioctlsizes new file mode 100644 index 00000000000..403fffaf86c --- /dev/null +++ b/contrib/perl5/h2pl/getioctlsizes @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +open (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed"; + +while () { + if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\('?\w+'?,\s*\w+,\s*([^)]+)/) { + $need{$2}++; + } +} + +foreach $key ( sort keys %need ) { + print $key,"\n"; +} diff --git a/contrib/perl5/h2pl/mksizes b/contrib/perl5/h2pl/mksizes new file mode 100644 index 00000000000..cb4b8ab86ea --- /dev/null +++ b/contrib/perl5/h2pl/mksizes @@ -0,0 +1,42 @@ +#!/usr/local/bin/perl + +($iam = $0) =~ s%.*/%%; +$tmp = "$iam.$$"; +open (CODE,">$tmp.c") || die "$iam: cannot create $tmp.c: $!\n"; + +$mask = q/printf ("$sizeof{'%s'} = %d;\n"/; + +# write C program +select(CODE); + +print < +#include +#include +#include +#include +#include +#include + +main() { +EO_C_PROGRAM + +while ( <> ) { + chop; + printf "\t%s, \n\t\t\"%s\", sizeof(%s));\n", $mask, $_,$_; +} + +print "\n}\n"; + +close CODE; + +# compile C program + +select(STDOUT); + +system "cc $tmp.c -o $tmp"; +die "couldn't compile $tmp.c" if $?; +system "./$tmp"; +die "couldn't run $tmp" if $?; + +unlink "$tmp.c", $tmp; diff --git a/contrib/perl5/h2pl/mkvars b/contrib/perl5/h2pl/mkvars new file mode 100644 index 00000000000..ffb0f0b0b9e --- /dev/null +++ b/contrib/perl5/h2pl/mkvars @@ -0,0 +1,31 @@ +#!/usr/bin/perl + +require 'sizeof.ph'; + +$LIB = '/usr/local/lib/perl'; + +foreach $include (@ARGV) { + printf STDERR "including %s\n", $include; + do $include; + warn "sourcing $include: $@\n" if ($@); + if (!open (INCLUDE,"$LIB/$include")) { + warn "can't open $LIB/$include: $!\n"; + next; + } + while () { + chop; + if (/^\s*eval\s+'sub\s+(\w+)\s.*[^{]$/ || /^\s*sub\s+(\w+)\s.*[^{]$/) { + $var = $1; + $val = eval "&$var;"; + if ($@) { + warn "$@: $_"; + print < before this file then + _G_HAVE_BOOL will be properly set. If, however, the extension includes + this file first, then you will have to manually set -DHAS_BOOL in + your command line to avoid a conflict. +*/ +#ifdef _G_HAVE_BOOL +# if _G_HAVE_BOOL +# ifndef HAS_BOOL +# define HAS_BOOL 1 +# endif +# endif +#endif + +/* The NeXT dynamic loader headers will not build with the bool macro + So declare them now to clear confusion. +*/ +#ifdef NeXT +# undef FALSE +# undef TRUE + typedef enum bool { FALSE = 0, TRUE = 1 } bool; +# define ENUM_BOOL 1 +# ifndef HAS_BOOL +# define HAS_BOOL 1 +# endif /* !HAS_BOOL */ +#endif /* NeXT */ + +#ifndef HAS_BOOL +# if defined(UTS) || defined(VMS) +# define bool int +# else +# define bool char +# endif +#endif + +/* XXX A note on the perl source internal type system. The + original intent was that I32 be *exactly* 32 bits. + + Currently, we only guarantee that I32 is *at least* 32 bits. + Specifically, if int is 64 bits, then so is I32. (This is the case + for the Cray.) This has the advantage of meshing nicely with + standard library calls (where we pass an I32 and the library is + expecting an int), but the disadvantage that an I32 is not 32 bits. + Andy Dougherty August 1996 + + There is no guarantee that there is *any* integral type with + exactly 32 bits. It is perfectly legal for a system to have + sizeof(short) == sizeof(int) == sizeof(long) == 8. + + Similarly, there is no guarantee that I16 and U16 have exactly 16 + bits. + + For dealing with issues that may arise from various 32/64-bit + systems, we will ask Configure to check out + SHORTSIZE == sizeof(short) + INTSIZE == sizeof(int) + LONGSIZE == sizeof(long) + LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG) + PTRSIZE == sizeof(void *) + DOUBLESIZE == sizeof(double) + LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). + Most of these are currently unused, but they are mentioned here so + metaconfig will include the appropriate tests in Configure and + we can then start to consider how best to deal with long long + variables. + Andy Dougherty April 1998 +*/ + +typedef char I8; +typedef unsigned char U8; +/* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type. + Please search CHAR_MAX in perl.h for further details. */ +#define U8_MAX PERL_UCHAR_MAX +#define U8_MIN PERL_UCHAR_MIN + +typedef short I16; +typedef unsigned short U16; +#define I16_MAX PERL_SHORT_MAX +#define I16_MIN PERL_SHORT_MIN +#define U16_MAX PERL_USHORT_MAX +#define U16_MIN PERL_USHORT_MIN + +#if LONGSIZE > 4 + typedef int I32; + typedef unsigned int U32; +# define I32_MAX PERL_INT_MAX +# define I32_MIN PERL_INT_MIN +# define U32_MAX PERL_UINT_MAX +# define U32_MIN PERL_UINT_MIN +#else + typedef long I32; + typedef unsigned long U32; +# define I32_MAX PERL_LONG_MAX +# define I32_MIN PERL_LONG_MIN +# define U32_MAX PERL_ULONG_MAX +# define U32_MIN PERL_ULONG_MIN +#endif + +#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log2(10) =~ 146/485 */ +#define TYPE_DIGITS(T) BIT_DIGITS(sizeof(T) * 8) +#define TYPE_CHARS(T) (TYPE_DIGITS(T) + 2) /* sign, NUL */ + +#define Ctl(ch) ((ch) & 037) + +#define strNE(s1,s2) (strcmp(s1,s2)) +#define strEQ(s1,s2) (!strcmp(s1,s2)) +#define strLT(s1,s2) (strcmp(s1,s2) < 0) +#define strLE(s1,s2) (strcmp(s1,s2) <= 0) +#define strGT(s1,s2) (strcmp(s1,s2) > 0) +#define strGE(s1,s2) (strcmp(s1,s2) >= 0) +#define strnNE(s1,s2,l) (strncmp(s1,s2,l)) +#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) + +#ifdef HAS_MEMCMP +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + +/* + * Character classes. + * + * Unfortunately, the introduction of locales means that we + * can't trust isupper(), etc. to tell the truth. And when + * it comes to /\w+/ with tainting enabled, we *must* be able + * to trust our character classes. + * + * Therefore, the default tests in the text of Perl will be + * independent of locale. Any code that wants to depend on + * the current locale will use the tests that begin with "lc". + */ + +#ifdef HAS_SETLOCALE /* XXX Is there a better test for this? */ +# ifndef CTYPE256 +# define CTYPE256 +# endif +#endif + +#define isALNUM(c) (isALPHA(c) || isDIGIT(c) || (c) == '_') +#define isIDFIRST(c) (isALPHA(c) || (c) == '_') +#define isALPHA(c) (isUPPER(c) || isLOWER(c)) +#define isSPACE(c) \ + ((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f') +#define isDIGIT(c) ((c) >= '0' && (c) <= '9') +#ifdef EBCDIC + /* In EBCDIC we do not do locales: therefore() isupper() is fine. */ +# define isUPPER(c) isupper(c) +# define isLOWER(c) islower(c) +# define isPRINT(c) isprint(c) +# define toUPPER(c) toupper(c) +# define toLOWER(c) tolower(c) +#else +# define isUPPER(c) ((c) >= 'A' && (c) <= 'Z') +# define isLOWER(c) ((c) >= 'a' && (c) <= 'z') +# define isPRINT(c) (((c) > 32 && (c) < 127) || isSPACE(c)) +# define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c)) +# define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c)) +#endif + +#ifdef USE_NEXT_CTYPE + +# define isALNUM_LC(c) \ + (NXIsAlpha((unsigned int)(c)) || NXIsDigit((unsigned int)(c)) || \ + (char)(c) == '_') +# define isIDFIRST_LC(c) \ + (NXIsAlpha((unsigned int)(c)) || (char)(c) == '_') +# define isALPHA_LC(c) NXIsAlpha((unsigned int)(c)) +# define isSPACE_LC(c) NXIsSpace((unsigned int)(c)) +# define isDIGIT_LC(c) NXIsDigit((unsigned int)(c)) +# define isUPPER_LC(c) NXIsUpper((unsigned int)(c)) +# define isLOWER_LC(c) NXIsLower((unsigned int)(c)) +# define isPRINT_LC(c) NXIsPrint((unsigned int)(c)) +# define toUPPER_LC(c) NXToUpper((unsigned int)(c)) +# define toLOWER_LC(c) NXToLower((unsigned int)(c)) + +#else /* !USE_NEXT_CTYPE */ +# if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII)) + +# define isALNUM_LC(c) \ + (isalpha((unsigned char)(c)) || \ + isdigit((unsigned char)(c)) || (char)(c) == '_') +# define isIDFIRST_LC(c) (isalpha((unsigned char)(c)) || (char)(c) == '_') +# define isALPHA_LC(c) isalpha((unsigned char)(c)) +# define isSPACE_LC(c) isspace((unsigned char)(c)) +# define isDIGIT_LC(c) isdigit((unsigned char)(c)) +# define isUPPER_LC(c) isupper((unsigned char)(c)) +# define isLOWER_LC(c) islower((unsigned char)(c)) +# define isPRINT_LC(c) isprint((unsigned char)(c)) +# define toUPPER_LC(c) toupper((unsigned char)(c)) +# define toLOWER_LC(c) tolower((unsigned char)(c)) + +# else + +# define isALNUM_LC(c) \ + (isascii(c) && (isalpha(c) || isdigit(c) || (c) == '_')) +# define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_')) +# define isALPHA_LC(c) (isascii(c) && isalpha(c)) +# define isSPACE_LC(c) (isascii(c) && isspace(c)) +# define isDIGIT_LC(c) (isascii(c) && isdigit(c)) +# define isUPPER_LC(c) (isascii(c) && isupper(c)) +# define isLOWER_LC(c) (isascii(c) && islower(c)) +# define isPRINT_LC(c) (isascii(c) && isprint(c)) +# define toUPPER_LC(c) toupper(c) +# define toLOWER_LC(c) tolower(c) + +# endif +#endif /* USE_NEXT_CTYPE */ + +#ifdef EBCDIC +EXT int ebcdic_control _((int)); +# define toCTRL(c) ebcdic_control(c) +#else + /* This conversion works both ways, strangely enough. */ +# define toCTRL(c) (toUPPER(c) ^ 64) +#endif + +/* Line numbers are unsigned, 16 bits. */ +typedef U16 line_t; +#ifdef lint +#define NOLINE ((line_t)0) +#else +#define NOLINE ((line_t) 65535) +#endif + + +/* This looks obsolete (IZ): + + XXX LEAKTEST doesn't really work in perl5. There are direct calls to + safemalloc() in the source, so LEAKTEST won't pick them up. + Further, if you try LEAKTEST, you'll also end up calling + Safefree, which might call safexfree() on some things that weren't + malloced with safexmalloc. The correct "fix" to this, if anyone + is interested, is to ensure that all calls go through the New and + Renew macros. + --Andy Dougherty August 1996 +*/ + +#ifndef lint + +#define NEWSV(x,len) newSV(len) + +#ifndef LEAKTEST + +#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))) +#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))) +#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \ + memzero((char*)(v), (n)*sizeof(t)) +#define Renew(v,n,t) \ + (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) +#define Renewc(v,n,t,c) \ + (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) +#define Safefree(d) safefree((Malloc_t)(d)) + +#else /* LEAKTEST */ + +#define New(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))) +#define Newc(x,v,n,t,c) (v = (c*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))) +#define Newz(x,v,n,t) (v = (t*)safexmalloc((x),(MEM_SIZE)((n)*sizeof(t)))), \ + memzero((char*)(v), (n)*sizeof(t)) +#define Renew(v,n,t) \ + (v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) +#define Renewc(v,n,t,c) \ + (v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))) +#define Safefree(d) safexfree((Malloc_t)(d)) + +#define MAXXCOUNT 1400 +#define MAXY_SIZE 80 +#define MAXYCOUNT 16 /* (MAXY_SIZE/4 + 1) */ +extern long xcount[MAXXCOUNT]; +extern long lastxcount[MAXXCOUNT]; +extern long xycount[MAXXCOUNT][MAXYCOUNT]; +extern long lastxycount[MAXXCOUNT][MAXYCOUNT]; + +#endif /* LEAKTEST */ + +#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)) +#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t)) + +#else /* lint */ + +#define New(x,v,n,s) (v = Null(s *)) +#define Newc(x,v,n,s,c) (v = Null(s *)) +#define Newz(x,v,n,s) (v = Null(s *)) +#define Renew(v,n,s) (v = Null(s *)) +#define Move(s,d,n,t) +#define Copy(s,d,n,t) +#define Zero(d,n,t) +#define Safefree(d) (d) = (d) + +#endif /* lint */ + +#ifdef USE_STRUCT_COPY +#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s))) +#else +#define StructCopy(s,d,t) Copy(s,d,1,t) +#endif diff --git a/contrib/perl5/hints/3b1.sh b/contrib/perl5/hints/3b1.sh new file mode 100644 index 00000000000..991348af3ec --- /dev/null +++ b/contrib/perl5/hints/3b1.sh @@ -0,0 +1,15 @@ +d_voidsig='undef' +d_tosignal='int' +gidtype='int' +groupstype='int' +uidtype='int' +# Note that 'Configure' is run from 'UU', hence the strange 'ln' +# command. +for i in .. ../x2p +do + rm -f $i/3b1cc + ln ../hints/3b1cc $i +done +echo "\nIf you want to use the 3b1 shared libraries, complete this script then" >&4 +echo "read the header in 3b1cc. [Type carriage return to continue]\c" >&4 +read vch diff --git a/contrib/perl5/hints/3b1cc b/contrib/perl5/hints/3b1cc new file mode 100644 index 00000000000..0001e046b8c --- /dev/null +++ b/contrib/perl5/hints/3b1cc @@ -0,0 +1,88 @@ +# To incorporate the 7300/3b1 shared library, run this script in place +# of 'CC'. +# You can skip this is you have the shcc program installed as cc in +# your path. +# First: Run 'Configure' through to the end and run 'make depend'. +# Second: Edit 'makefile' ( not Makefile ) and set CC = 3b1cc. +# Third: Edit 'x2p/makefile' and set CC = 3b1cc. +# +# Do not use '3b1cc' as the default compiler. The call to the default +# compiler is used by 'perl' and will not be available when running +# 'perl'. +# +# Note: This script omits libraries which are redundant in the shared +# library. It is an excerpt from a grander version available upon +# request from "zebra!vern" or "vern@zebra.alphacdc.com". + +CC="cc" +LIBS= +INCL= + +LD="ld" +SHAREDLIB="/lib/crt0s.o /lib/shlib.ifile" + +# Local variables +COBJS= +LOBJS= +TARG= +FLAGS= +CMD= + +# These are libraries which are incorporated in the shared library +OMIT="-lmalloc" + +# These routines are in libc.a but not in the shared library +if [ ! -f vsprintf.o -o ! -f doprnt.o ] +then + echo "Extracting vsprintf.o from libc.a" + ar -x /lib/libc.a vsprintf.o doprnt.o +fi + +CMD="$CC" +while [ $# -gt 0 ] +do + case $1 in + -c) CFLAG=$1;; + -o) CFLAG=$1 + shift + TARG="$1";; + -l*) match=false + for i in $OMIT + do + [ "$i" = "$1" ] && match=true + done + [ "$match" != false ] || LIBS="$LIBS $1";; + -*) FLAGS="$FLAGS $1";; + *.c) COBJS="$COBJS $1";; + *.o) LOBJS="$LOBJS $1";; + *) TARG="$1";; + esac + shift +done + +if [ -n "$COBJS" ] +then + CMD="$CMD $FLAGS $INCL $LPATHS $LIBS $COBJS $CFLAG $TARG" +elif [ -n "$LOBJS" ] +then + LOBJS="$LOBJS vsprintf.o doprnt.o" + CMD="$LD -r $LOBJS $LPATHS $LIBS -o temp.o" + echo "\t$CMD" + $CMD + CMD="$LD -s temp.o $SHAREDLIB -o $TARG" + echo "\t$CMD" + $CMD + ccrslt=$? + if [ $ccrslt -ne 0 ] + then + exit $ccrslt + fi + CMD="rm -f temp.o" +else + exit 1 +fi +echo "\t$CMD" +$CMD +ccrslt=$? +rm -f $$.c +exit $ccrslt diff --git a/contrib/perl5/hints/README.hints b/contrib/perl5/hints/README.hints new file mode 100644 index 00000000000..e36bd6d1dd9 --- /dev/null +++ b/contrib/perl5/hints/README.hints @@ -0,0 +1,213 @@ +=head1 NAME + +README.hints + +=head1 DESCRIPTION + +These files are used by Configure to set things which Configure either +can't or doesn't guess properly. Most of these hint files have been +tested with at least some version of perl5, but some are still left +over from perl4. + +Please send any problems or suggested changes to perlbug@perl.com. + +Hint file naming convention: Each hint file name should have only +one '.'. (This is for portability to non-unix file systems.) Names +should also fit in <= 14 characters, for portability to older SVR3 +systems. File names are of the form $osname_$osvers.sh, with all '.' +changed to '_', and all characters (such as '/') that don't belong in +Unix filenames omitted. + +For example, consider Sun OS 4.1.3. Configure determines $osname=sunos +(all names are converted to lower case) and $osvers=4.1.3. Configure +will search for an appropriate hint file in the following order: + + sunos_4_1_3.sh + sunos_4_1.sh + sunos_4.sh + sunos.sh + +If you need to create a hint file, please try to use as general a name +as possible and include minor version differences inside case or test +statements. For example, for IRIX 6.X, we have the following hints +files: + + irix_6_0.sh + irix_6_1.sh + irix_6.sh + +That is, 6.0 and 6.1 have their own special hints, but 6.2, 6.3, and +up are all handled by the same irix_6.sh. That way, we don't have to +make a new hint file every time the IRIX O/S is upgraded. + +If you need to test for specific minor version differences in your +hints file, be sure to include a default choice. (See aix.sh for one +example.) That way, if you write a hint file for foonix 3.2, it might +still work without any changes when foonix 3.3 is released. + +Please also comment carefully on why the different hints are needed. +That way, a future version of Configure may be able to automatically +detect what is needed. + +A glossary of config.sh variables is in the file Porting/Glossary. + +=head1 Hint file tricks + +=head2 Printing critical messages + +[This is still experimental] + +If you have a *REALLY* important message that the user ought to see at +the end of the Configure run, you can store it in the file +'config.msg'. At the end of the Configure run, Configure will display +the contents of this file. Currently, the only place this is used is +in Configure itself to warn about the need to set LD_LIBRARY_PATH if +you are building a shared libperl.so. + +To use this feature, just do something like the following + + $cat <&4 + + This is a really important message. Be sure to read it + before you type 'make'. + EOM + +This message will appear on the screen as the hint file is being +processed and again at the end of Configure. + +Please use this sparingly. + +=head2 Propagating variables to config.sh + +Sometimes, you want an extra variable to appear in config.sh. For +example, if your system can't compile toke.c with the optimizer on, +you can put + + toke_cflags='optimize=""' + +at the beginning of a line in your hints file. Configure will then +extract that variable and place it in your config.sh file. Later, +while compiling toke.c, the cflags shell script will eval $toke_cflags +and hence compile toke.c without optimization. + +Note that for this to work, the variable you want to propagate must +appear in the first column of the hint file. It is extracted by +Configure with a simple sed script, so beware that surrounding case +statements aren't any help. + +By contrast, if you don't want Configure to propagate your temporary +variable, simply indent it by a leading tab in your hint file. + +For example, prior to 5.002, a bug in scope.c led to perl crashing +when compiled with -O in AIX 4.1.1. The following "obvious" +workaround in hints/aix.sh wouldn't work as expected: + + case "$osvers" in + 4.1.1) + scope_cflags='optimize=""' + ;; + esac + +because Configure doesn't parse the surrounding 'case' statement, it +just blindly propagates any variable that starts in the first column. +For this particular case, that's probably harmless anyway. + +Three possible fixes are: + +=over + +=item 1 + +Create an aix_4_1_1.sh hint file that contains the scope_cflags +line and then sources the regular aix hints file for the rest of +the information. + +=item 2 + +Do the following trick: + + scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac' + +Now when $scope_cflags is eval'd by the cflags shell script, the +case statement is executed. Of course writing scripts to be eval'd is +tricky, especially if there is complex quoting. Or, + +=item 3 + +Write directly to Configure's temporary file UU/config.sh. +You can do this with + + case "$osvers" in + 4.1.1) + echo "scope_cflags='optimize=\"\"'" >> UU/config.sh + scope_cflags='optimize=""' + ;; + esac + +Note you have to both write the definition to the temporary +UU/config.sh file and set the variable to the appropriate value. + +This is sneaky, but it works. Still, if you need anything this +complex, perhaps you should create the separate hint file for +aix 4.1.1. + +=back + +=head2 Call-backs + +=over 4 + +=item Warning + +All of the following is experimental and subject to change. But it +probably won't change much. :-) + +=item Compiler-related flags + +The settings of some things, such as optimization flags, may depend on +the particular compiler used. For example, for ISC we have the +following: + + case "$cc" in + *gcc*) ccflags="$ccflags -posix" + ldflags="$ldflags -posix" + ;; + *) ccflags="$ccflags -Xp -D_POSIX_SOURCE" + ldflags="$ldflags -Xp" + ;; + esac + +However, the hints file is processed before the user is asked which +compiler should be used. Thus in order for these hints to be useful, +the user must specify sh Configure -Dcc=gcc on the command line, as +advised by the INSTALL file. + +For versions of perl later than 5.004_61, this problem can +be circumvented by the use of "call-back units". That is, the hints +file can tuck this information away into a file UU/cc.cbu. Then, +after Configure prompts the user for the C compiler, it will load in +and run the UU/cc.cbu "call-back" unit. See hints/solaris_2.sh for an +example. + +=item Threading-related flags + +Similarly, after Configure prompts the user about whether or not to +compile Perl with threads, it will look for a "call-back" unit +usethreads.cbu. See hints/linux.sh for an example. + +=item Future status + +I hope this "call-back" scheme is simple enough to use but powerful +enough to deal with most situations. Still, there are certainly cases +where it's not enough. For example, for aix we actually change +compilers if we are using threads. + +I'd appreciate feedback on whether this is sufficiently general to be +helpful, or whether we ought to simply continue to require folks to +say things like "sh Configure -Dcc=gcc -Dusethreads" on the command line. + +=back + +Have the appropriate amount of fun :-) + + Andy Dougherty doughera@lafcol.lafayette.edu diff --git a/contrib/perl5/hints/aix.sh b/contrib/perl5/hints/aix.sh new file mode 100644 index 00000000000..25e20489318 --- /dev/null +++ b/contrib/perl5/hints/aix.sh @@ -0,0 +1,102 @@ +# hints/aix.sh +# AIX 3.x.x hints thanks to Wayne Scott +# AIX 4.1 hints thanks to Christopher Chan-Nui . +# AIX 4.1 pthreading by Christopher Chan-Nui and +# Jarkko Hietaniemi . +# Merged on Mon Feb 6 10:22:35 EST 1995 by +# Andy Dougherty + + +# Configure finds setrgid and setruid, but they're useless. The man +# pages state: +# setrgid: The EPERM error code is always returned. +# setruid: The EPERM error code is always returned. Processes cannot +# reset only their real user IDs. +d_setrgid='undef' +d_setruid='undef' + +alignbytes=8 + +usemymalloc='n' + +so="a" +dlext="so" + +# Make setsockopt work correctly. See man page. +# ccflags='-D_BSD=44' + +# uname -m output is too specific and not appropriate here +case "$archname" in +'') archname="$osname" ;; +esac + +case "$osvers" in +3*) d_fchmod=undef + ccflags="$ccflags -D_ALL_SOURCE" + ;; +*) # These hints at least work for 4.x, possibly other systems too. + ccflags="$ccflags -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE" + case "$cc" in + *gcc*) ;; + *) ccflags="$ccflags -qmaxmem=8192" ;; + esac + nm_opt='-B' + ;; +esac + +# These functions don't work like Perl expects them to. +d_setregid='undef' +d_setreuid='undef' + +# Changes for dynamic linking by Wayne Scott +# +# Tell perl which symbols to export for dynamic linking. +case "$cc" in +*gcc*) ccdlflags='-Xlinker -bE:perl.exp' ;; +*) ccdlflags='-bE:perl.exp' ;; +esac + +# The first 3 options would not be needed if dynamic libs. could be linked +# with the compiler instead of ld. +# -bI:$(PERL_INC)/perl.exp Read the exported symbols from the perl binary +# -bE:$(BASEEXT).exp Export these symbols. This file contains only one +# symbol: boot_$(EXP) can it be auto-generated? +case "$osvers" in +3*) +lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc' + ;; +*) +lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc' + +;; +esac + +if [ "X$usethreads" = "X$define" ]; then + ccflags="$ccflags -DNEED_PTHREAD_INIT" + case "$cc" in + xlc_r | cc_r) + ;; + cc | '') + cc=xlc_r # Let us be stricter. + ;; + *) + cat >&4 < +# Merged by Andy Dougherty +# Last revised Fri Jun 2 11:21:27 EDT 1995 + +# uname -a looks like +# DomainOS newton 10.4.1 bsd4.3 425t + +# We want to use both BSD includes and some of the features from the +# /sys5 includes. +ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include" + +# These adjustments are necessary (why?) to compile malloc.c. +freetype='void' +i_malloc='undef' +malloctype='void *' + +# This info is left over from perl4. +cat <<'EOF' >&4 +Some tests may fail unless you use 'chacl -B'. Also, op/stat +test 2 may fail occasionally because Apollo doesn't guarantee +that mtime will be equal to ctime on a newly created unmodified +file. Finally, the sleep test will sometimes fail. See the +sleep(3) man page to learn why. + +See hints/apollo.sh for hints on running h2ph. + +And a note on ccflags: + + Lastly, while -A cpu,mathchip generates optimal code for your DN3500 + running sr10.3, be aware that you should be using -A cpu,mathlib_sr10 + if your perl must also run on any machines running sr10.0, sr10.1, or + sr10.2. The -A cpu,mathchip option generates code that doesn't work on + pre-sr10.3 nodes. See the cc(1) man page for more details. + -- Steve Vinoski + +EOF + +# Running h2ph, on the other hand, presents a challenge. + +#The perl header files have to be generated with following commands + +#sed 's|/usr/include|/sys5/usr/include|g' h2ph >h2ph.new && chmod +x h2ph.new +#(set cdir=`pwd`; cd /sys5/usr/include; $cdir/h2ph.new sys/* ) +#(set cdir=`pwd`; cd /usr/include; $cdir/h2ph * sys/* machine/*) + +#The SYS5 headers (only sys) are overlayed by the BSD headers. It seems +#all ok, but once I am going into details, a lot of limitations from +#'h2ph' are coming up. Lines like "#define NODEV (dev_t)(-1)" result in +#syntax errors as converted by h2ph. + +# Generally, h2ph might need a lot of help. diff --git a/contrib/perl5/hints/aux_3.sh b/contrib/perl5/hints/aux_3.sh new file mode 100644 index 00000000000..aa3150afbe7 --- /dev/null +++ b/contrib/perl5/hints/aux_3.sh @@ -0,0 +1,22 @@ +# hints/aux_3.sh +# +# Improved by Jake Hamby to support both Apple CC +# and GNU CC. Tested on A/UX 3.1.1 with GCC 2.6.3. +# Now notifies of problem with version of dbm shipped with A/UX +# Last modified +# Sun Jan 5 11:16:41 WET 1997 + +case "$cc" in +*gcc*) optimize='-O2' + ccflags="$ccflags -D_POSIX_SOURCE" + echo "Setting hints for GNU CC." + ;; +*) optimize='-O' + ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES -D_POSIX_SOURCE" + POSIX_cflags='ccflags="$ccflags -ZP -Du_long=U32"' + echo "Setting hints for Apple's CC. If you plan to use" + echo "GNU CC, please rerun this Configure script as:" + echo "./Configure -Dcc=gcc" + ;; +esac +test -r ./broken-db.msg && . ./broken-db.msg diff --git a/contrib/perl5/hints/beos.sh b/contrib/perl5/hints/beos.sh new file mode 100644 index 00000000000..ab752769b68 --- /dev/null +++ b/contrib/perl5/hints/beos.sh @@ -0,0 +1,45 @@ +# BeOS hints file +# $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $ + +if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c; fi + +prefix="/boot/home/config" + +cpp="mwcc -e" + +libpth='/boot/beos/system/lib /boot/home/config/lib' +usrinc='/boot/develop/headers/posix' +locinc='/boot/develop/headers/ /boot/home/config/include' + +libc='/boot/beos/system/lib/libroot.so' +libs=' ' + +d_bcmp='define' +d_bcopy='define' +d_bzero='define' +d_index='define' +#d_htonl='define' # It exists, but much hackery would be required to support. +# a bunch of extra includes would have to be added, and it's only used at +# one place in the non-socket perl code. + +#these are all in libdll.a, which my version of nm doesn't know how to parse. +#if I can get it to both do that, and scan multiple library files, perhaps +#these can be gotten rid of. + +usemymalloc='n' +# Hopefully, Be's malloc knows better than perl's. + +d_link='undef' +dont_use_nlink='define' +# no posix (aka hard) links for us! + +d_syserrlst='undef' +# the array syserrlst[] is useless for the most part. +# large negative numbers really kind of suck in arrays. + +#d_socket='undef' +# Sockets really don't work with the current version of perl and the +# current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port +# will be required. + +export PATH="$PATH:$PWD/beos" diff --git a/contrib/perl5/hints/broken-db.msg b/contrib/perl5/hints/broken-db.msg new file mode 100644 index 00000000000..92ba0776bfc --- /dev/null +++ b/contrib/perl5/hints/broken-db.msg @@ -0,0 +1,14 @@ +# Several OSs come with an old version of the DB library which fails +# on a few of the db-recno.t tests. This file is sourced by the hints +# files for those OSs. + +cat <&4 + +Unless you've upgraded your DB library manually you will see failures in +db-recno tests 51, 53 and 55. The behavior these tests are checking is +broken in the DB library which is included with the OS. You can ignore +the errors if you're never going to use the broken functionality (recno +databases with a modified bval), otherwise you'll have to upgrade your +DB library or OS. + +EOF diff --git a/contrib/perl5/hints/bsdos.sh b/contrib/perl5/hints/bsdos.sh new file mode 100644 index 00000000000..c54a0c1606b --- /dev/null +++ b/contrib/perl5/hints/bsdos.sh @@ -0,0 +1,106 @@ +# hints/bsdos.sh +# +# hints file for BSD/OS (adapted from bsd386.sh) +# Original by Neil Bowers ; Tue Oct 4 12:01:34 EDT 1994 +# Updated by Tony Sanders ; Sat Aug 23 12:47:45 MDT 1997 +# Added 3.1 with ELF dynamic libraries (NOT in 3.1 yet. Estimated for 4.0) +# SYSV IPC tested Ok so I re-enabled. +# +# To override the compiler on the command line: +# ./Configure -Dcc=gcc2 +# +# The BSD/OS distribution is built with: +# ./Configure -des -Dbsdos_distribution=defined + +signal_t='void' +d_voidsig='define' + +usemymalloc='n' + +# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions. +# See http://www.bsdi.com/bsdi-man?setuid(2) +d_setregid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' + +# we don't want to use -lnm, since exp() is busted (in 1.1 anyway) +set `echo X "$libswanted "| sed -e 's/ nm / /'` +shift +libswanted="$*" + +# X libraries are in their own tree +glibpth="$glibpth /usr/X11/lib" +ldflags="$ldflags -L/usr/X11/lib" + +case "$optimize" in +'') optimize='-O2' ;; +esac + +case "$bsdos_distribution" in +''|undef|false) ;; +*) + d_dosuid='define' + d_portable='undef' + prefix='/usr/contrib' + perlpath='/usr/bin/perl5' + startperl='#!/usr/bin/perl5' + scriptdir='/usr/contrib/bin' + privlib='/usr/libdata/perl5' + man1dir='/usr/contrib/man/man1' + man3dir='/usr/contrib/man/man3' + # phlib added by BSDI -- we share the *.ph include dir with perl4 + phlib="/usr/libdata/perl5/site_perl/$(arch)-$osname/include" + phlibexp="/usr/libdata/perl5/site_perl/$(arch)-$osname/include" + ;; +esac + +case "$osvers" in +1.0*) + # Avoid problems with HUGE_VAL in POSIX in 1.0's cc. + POSIX_cflags='ccflags="$ccflags -UHUGE_VAL"' + ;; +1.1*) + # Use gcc2 + case "$cc" in + '') cc='gcc2' ;; + esac + ;; +2.0*|2.1*|3.0*|3.1*) + so='o' + + # default to GCC 2.X w/shared libraries + case "$cc" in + '') cc='shlicc2' + cccdlflags=' ' ;; # Avoid the dreaded -fpic + esac + + # default ld to shared library linker + case "$ld" in + '') ld='shlicc2' + lddlflags='-r' ;; # this one is necessary + esac + + # Must preload the static shared libraries. + libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted" + libswanted="rpc curses termcap $libswanted" + ;; +4.0*) + # ELF dynamic link libraries starting in 4.0 (???) + useshrplib='true' + so='so' + dlext='so' + + case "$cc" in + '') cc='cc' # cc is gcc2 in 4.0 + cccdlflags="-fPIC" + ccdlflags=" " ;; + esac + + case "$ld" in + '') ld='ld' + lddlflags="-shared -x $lddlflags" ;; + esac + ;; +esac + diff --git a/contrib/perl5/hints/convexos.sh b/contrib/perl5/hints/convexos.sh new file mode 100644 index 00000000000..9f6d702b06c --- /dev/null +++ b/contrib/perl5/hints/convexos.sh @@ -0,0 +1,12 @@ +# convexos.sh +# Thanks to David Starks-Browning +# Date: Tue, 17 Jan 1995 10:45:03 -0500 (EST) +# Subject: Re: Hints for ConvexOS 10.2 +# +# uname -a output looks like +# ConvexOS xxxx C38xx 10.2 convex +# Configure may incorrectly assign $3 to $osvers. +# +set X $myuname +shift +osvers=$4 diff --git a/contrib/perl5/hints/cxux.sh b/contrib/perl5/hints/cxux.sh new file mode 100644 index 00000000000..e3ac086e235 --- /dev/null +++ b/contrib/perl5/hints/cxux.sh @@ -0,0 +1,106 @@ +#! /local/gnu/bin/bash +# Hints for the CX/UX 7.1 operating system running on Concurrent (formerly +# Harris) NightHawk machines. written by Tom.Horsley@mail.ccur.com +# +# This config is setup for dynamic linking and the Concurrent C compiler. + +# Check some things and print warnings if this isn't going to work... +# +case ${SDE_TARGET:-ELF} in + [Cc][Oo][Ff][Ff]|[Oo][Cc][Ss]) echo '' + echo '' >&2 + echo WARNING: Do not build perl 5 with the SDE_TARGET set to >&2 + echo generate coff object - perl 5 must be built in the ELF >&2 + echo environment. >&2 + echo '' >&2 + echo '';; + [Ee][Ll][Ff]) : ;; + *) echo '' >&2 + echo 'Unknown SDE_TARGET value: '$SDE_TARGET >&2 + echo '' >&2 ;; +esac + +case `uname -r` in + [789]*) : ;; + *) echo '' + echo '' >&2 + echo WARNING: Perl 5 requires shared library support, it cannot >&2 + echo be built on releases of CX/UX prior to 7.0 with this hints >&2 + echo file. You\'ll have to do a separate port for the statically >&2 + echo linked COFF environment. >&2 + echo '' >&2 + echo '';; +esac + +# Internally at Concurrent, we use a source management tool which winds up +# giving us read-only copies of source trees that are mostly symbolic links. +# That upsets the perl build process when it tries to edit opcode.h and +# embed.h or touch perly.c or perly.h, so turn those files into "real" files +# when Configure runs. (If you already have "real" source files, this won't +# do anything). +# +if [ -x /usr/local/mkreal ] +then + for i in '.' '..' + do + for j in embed.h opcode.h perly.h perly.c + do + if [ -h $i/$j ] + then + ( cd $i ; /usr/local/mkreal $j ; chmod 666 $j ) + fi + done + done +fi + +# We DO NOT want -lmalloc +# +libswanted=`echo ' '$libswanted' ' | sed -e 's/ malloc / /'` + +# Stick the low-level elf library path in first. +# +glibpth="/usr/sde/elf/usr/lib $glibpth" + +# Need to use Concurrent cc for most of these options to be meaningful (if +# you want to get this to work with gcc, you're on your own :-). Passing +# -Bexport to the linker when linking perl is important because it leaves +# the interpreter internal symbols visible to the shared libs that will be +# loaded on demand (and will try to reference those symbols). The -u option +# to drag 'sigaction' into the perl main program is to make sure it gets +# defined for the posix shared library (for some reason sigaction is static, +# rather than being defined in libc.so.1). The 88110compat option makes sure +# the code will run on both 88100 and 88110 machines. The define is added to +# trigger a work around for a compiler bug which shows up in pp.c. +# +cc='/bin/cc -Xa -Qtarget=M88110compat -DCXUX_BROKEN_CONSTANT_CONVERT' +cccdlflags='-Zelf -Zpic' +ccdlflags='-Zelf -Zlink=dynamic -Wl,-Bexport -u sigaction' +lddlflags='-Zlink=so' + +# Configure imagines that it sees a pw_quota field, but it is really in a +# different structure than the one it thinks it is looking at. +d_pwquota='undef' + +# Configure sometimes finds what it believes to be ndbm header files on the +# system and imagines that we have the NDBM library, but we really don't. +# There is something there that once resembled ndbm, but it is purely +# for internal use in some tool and has been hacked beyond recognition +# (or even function :-) +# +i_ndbm='undef' + +# Don't use the perl malloc +# +d_mymalloc='undef' +usemymalloc='n' + +cat <<'EOM' >&4 + +WARNING: If you are using ksh to run the Configure script, you may find it +failing in mysterious ways (such as failing to find library routines which +are known to exist). Configure seems to push ksh beyond its limits +sometimes. Try using env to strip unnecessary things out of the environment +and run Configure with /sbin/sh. That sometimes seems to produce more +accurate results. + +EOM diff --git a/contrib/perl5/hints/cygwin32.sh b/contrib/perl5/hints/cygwin32.sh new file mode 100644 index 00000000000..5853499954a --- /dev/null +++ b/contrib/perl5/hints/cygwin32.sh @@ -0,0 +1,50 @@ +#! /bin/sh +# cygwin32.sh - hintsfile for building perl on Windows NT using the +# Cygnus Win32 Development Kit. +# See "http://www.cygnus.com/misc/gnu-win32/" to learn about the kit. +# +path_sep=\; +exe_ext='.exe' +firstmakefile='GNUmakefile' +if test -f $sh.exe; then sh=$sh.exe; fi +startsh="#!$sh" +cc='gcc2' +ld='ld2' +usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' +libpth='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib /gnuwin32/H-i386-cygwin32/lib' +libs='-lcygwin -lm -lc -lkernel32' +# dynamic lib stuff +so='dll' +#i_dlfcn='define' +dlsrc='dl_cygwin32.xs' +usedl='y' +# flag to include the perl.exe export variable translation file cw32imp.h +# when building extension libs +cccdlflags='-DCYGWIN32 -DDLLIMPORT ' +# flag that signals gcc2 to build exportable perl +ccdlflags='-buildperl ' +lddlflags='-L../.. -L/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib -lperlexp -lcygwin' +d_voidsig='undef' +extensions='Fcntl IO Opcode SDBM_File' +lns='cp' +signal_t='int' +useposix='false' +rd_nodata='0' +eagain='EAGAIN' +archname='cygwin32' +# + +installbin='/usr/local/bin' +installman1dir='' +installman3dir='' +installprivlib='/usr/local/lib/perl5' +installscript='/usr/local/bin' + +installsitelib='/usr/local/lib/perl5/site_perl' +libc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/lib/libc.a' + +perlpath='/usr/local/bin/perl' + +sitelib='/usr/local/lib/perl5/site_perl' +sitelibexp='/usr/local/lib/perl5/site_perl' +usrinc='/gnuwin32/H-i386-cygwin32/i386-cygwin32/include' diff --git a/contrib/perl5/hints/dcosx.sh b/contrib/perl5/hints/dcosx.sh new file mode 100644 index 00000000000..c1b0d0ac420 --- /dev/null +++ b/contrib/perl5/hints/dcosx.sh @@ -0,0 +1,188 @@ +# hints/dcosx.sh +# Last modified: Thu Jan 16 11:38:12 EST 1996 +# Stephen Zander +# hints for DC/OSx (Pyramid) & SINIX (Seimens: dc/osx rebadged) +# Based on the hints/solaris_2.sh file + +# See man vfork. +usevfork=false + +d_suidsafe=define + +# Avoid all libraries in /usr/ucblib. +set `echo $glibpth | sed -e 's@/usr/ucblib@@'` +glibpth="$*" + +# Remove bad libraries. +# -lucb contains incompatible routines. +set `echo " $libswanted " | sed -e 's@ ucb @ @'` +libswanted="$*" + +# Here's another draft of the perl5/solaris/gcc sanity-checker. + +case $PATH in +*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <&2 + +NOTE: /usr/ucb/cc does not function properly. +Remove /usr/ucb from your PATH. + +END +;; +esac + + +# Check that /dev/fd is mounted. If it is not mounted, let the +# user know that suid scripts may not work. +/usr/bin/df /dev/fd 2>&1 > /dev/null +case $? in +0) ;; +*) + cat <&4 + +NOTE: Your system does not have /dev/fd mounted. If you want to +be able to use set-uid scripts you must ask your system administrator +to mount /dev/fd. + +END + ;; +esac + + +# See if libucb can be found in /usr/lib. If it is, warn the user +# that this may cause problems while building Perl extensions. +/usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1 +case $? in +0) + cat <&4 + +NOTE: libucb has been found in /usr/lib. libucb should reside in +/usr/ucblib. You may have trouble while building Perl extensions. + +END +;; +esac + + +# See if make(1) is GNU make(1). +# If it is, make sure the setgid bit is not set. +make -v > make.vers 2>&1 +if grep GNU make.vers > /dev/null 2>&1; then + tmp=`/usr/bin/ksh -c "whence make"` + case "`/usr/bin/ls -l $tmp`" in + ??????s*) + cat <&2 + +NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id +bit set. You must either rearrange your PATH to put /usr/ccs/bin before the +GNU utilities or you must ask your system administrator to disable the +set-group-id bit on GNU make. + +END + ;; + esac +fi +rm -f make.vers + +# If the C compiler is gcc: +# - check the fixed-includes +# - check as(1) and ld(1), they should not be GNU +# If the C compiler is not gcc: +# - check as(1) and ld(1), they should not be GNU +# - increase the optimizing level to prevent object size warnings +# +# Watch out in case they have not set $cc. +case "`${cc:-cc} -v 2>&1`" in +*gcc*) + # + # Using gcc. + # + #echo Using gcc + + # Get gcc to share its secrets. + echo 'main() { return 0; }' > try.c + verbose=`${cc:-cc} -v -o try try.c 2>&1` + rm -f try try.c + tmp=`echo "$verbose" | grep '^Reading' | + awk '{print $NF}' | sed 's/specs$/include/'` + + # Determine if the fixed-includes look like they'll work. + # Doesn't work anymore for gcc-2.7.2. + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + case $verbose in + */usr/ccs/bin/as*) ;; + *) + cat <&2 + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +You must arrange to use /usr/ccs/bin/as, perhaps by setting +GCC_EXEC_PREFIX or by including -B/usr/ccs/bin in your cc command. + +END + ;; + esac + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + case $verbose in + */usr/ccs/bin/ld*) ;; + *) + cat <&2 + +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin/ld, perhaps by setting +GCC_EXEC_PREFIX or by including -B/usr/ccs/bin in your cc command. + +END + ;; + esac + + ;; #using gcc +*) + optimize='-O -K Olimit:3064' + # + # Not using gcc. + # + #echo Not using gcc + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + case `as --version < /dev/null 2>&1` in + *GNU*) + cat <&2 + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +You must arrange to use /usr/ccs/bin, perhaps by adding it to the +beginning of your PATH. + +END + ;; + esac + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + case `ld --version < /dev/null 2>&1` in + *GNU*) + cat <&2 + +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin, perhaps by adding it to the +beginning of your PATH + +END + ;; + esac + + ;; #not using gcc +esac + +# as --version or ld --version might dump core. +rm -f core + +# DC/OSx hides certain functions in a libc that looks dynamic but isn't +# because of this we reinclude -lc when building dynamic extenstions +libc='/usr/ccs/lib/libc.so' +lddlflags='-G -lc' + +# DC/OSx gets overenthusiastic with symbol removal when building dynamically +ccdlflags='-Blargedynsym' + +# System malloc is safer when using third part libs +usemymalloc='n' diff --git a/contrib/perl5/hints/dec_osf.sh b/contrib/perl5/hints/dec_osf.sh new file mode 100644 index 00000000000..a531ea8c8f7 --- /dev/null +++ b/contrib/perl5/hints/dec_osf.sh @@ -0,0 +1,334 @@ +# hints/dec_osf.sh + +# * If you want to debug perl or want to send a +# stack trace for inclusion into an bug report, call +# Configure with the additional argument -Doptimize=-g2 +# or uncomment this assignment to "optimize": +# +#optimize=-g2 +# +# If you want both to optimise and debug with the DEC cc +# you must have -g3, e.g. "-O4 -g3", and (re)run Configure. +# +# * gcc can always have both -g and optimisation on. +# +# * debugging optimised code, no matter what compiler +# one is using, can be surprising and confusing because of +# the optimisation tricks like code motion, code removal, +# loop unrolling, and inlining. The source code and the +# executable code simply do not agree any more while in +# mid-execution, the optimiser only cares about the results. +# +# * Configure will automatically add the often quoted +# -DDEBUGGING for you if the -g is specified. +# +# * There is even more optimisation available in the new +# (GEM) DEC cc: -O5 and -fast. "man cc" will tell more about them. +# The jury is still out whether either or neither help for Perl +# and how much. Based on very quick testing, -fast boosts +# raw data copy by about 5-15% (-fast brings in, among other +# things, inlined, ahem, fast memcpy()), while on the other +# hand searching things (index, m//, s///), seems to get slower. +# Your mileage will vary. +# +# * The -std is needed because the following compiled +# without the -std and linked with -lm +# +# #include +# #include +# int main(){short x=10,y=sqrt(x);printf("%d\n",y);} +# +# will in Digital UNIX 3.* and 4.0b print 0 -- and in Digital +# UNIX 4.0{,a} dump core: Floating point exception in the printf(), +# the y has become a signaling NaN. +# +# * Compilation warnings like: +# +# "Undefined the ANSI standard macro ..." +# +# can be ignored, at least while compiling the POSIX extension +# and especially if using the sfio (the latter is not a standard +# part of Perl, never mind if it says little to you). +# + +# If using the DEC compiler we must find out the DEC compiler style: +# the style changed between Digital UNIX (aka DEC OSF/1) 3 and +# Digital UNIX 4. The old compiler was originally from Ultrix and +# the MIPS company, the new compiler is originally from the VAX world +# and it is called GEM. Many of the options we are going to use depend +# on the compiler style. + +# do NOT, I repeat, *NOT* take away those leading tabs + # reset + _DEC_uname_r= + _DEC_cc_style= + # set + _DEC_uname_r=`uname -r` + # _DEC_cc_style set soon below +# Configure Black Magic (TM) + +case "$cc" in +*gcc*) ;; # pass +*) # compile something small: taint.c is fine for this. + # the main point is the '-v' flag of 'cc'. + case "`cc -v -I. -c taint.c -o /tmp/taint$$.o 2>&1`" in + */gemc_cc*) # we have the new DEC GEM CC + _DEC_cc_style=new + ;; + *) # we have the old MIPS CC + _DEC_cc_style=old + ;; + esac + # cleanup + rm -f /tmp/taint$$.o + ;; +esac + +# be nauseatingly ANSI +case "$cc" in +*gcc*) ccflags="$ccflags -ansi" + ;; +*) ccflags="$ccflags -std" + ;; +esac + +# for gcc the Configure knows about the -fpic: +# position-independent code for dynamic loading + +# we want optimisation + +case "$optimize" in +'') case "$cc" in + *gcc*) + optimize='-O3' ;; + *) case "$_DEC_cc_style" in + new) optimize='-O4' + ccflags="$ccflags -fprm d -ieee" + ;; + old) optimize='-O2 -Olimit 3200' ;; + esac + ccflags="$ccflags -D_INTRINSICS" + ;; + esac + ;; +esac + +# Make glibpth agree with the compiler suite. Note that /shlib +# is not here. That's on purpose. Even though that's where libc +# really lives from V4.0 on, the linker (and /sbin/loader) won't +# look there by default. The sharable /sbin utilities were all +# built with "-Wl,-rpath,/shlib" to get around that. This makes +# no attempt to figure out the additional location(s) searched by +# gcc, since not all versions of gcc are easily coerced into +# revealing that information. +glibpth="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc" +glibpth="$glibpth /usr/lib /usr/local/lib /var/shlib" + +# dlopen() is in libc +libswanted="`echo $libswanted | sed -e 's/ dl / /'`" + +# libPW contains nothing useful for perl +libswanted="`echo $libswanted | sed -e 's/ PW / /'`" + +# libnet contains nothing useful for perl here, and doesn't work +libswanted="`echo $libswanted | sed -e 's/ net / /'`" + +# libbsd contains nothing used by perl that is not already in libc +libswanted="`echo $libswanted | sed -e 's/ bsd / /'`" + +# libc need not be separately listed +libswanted="`echo $libswanted | sed -e 's/ c / /'`" + +# ndbm is already in libc +libswanted="`echo $libswanted | sed -e 's/ ndbm / /'`" + +# the basic lddlflags used always +lddlflags='-shared -expect_unresolved "*"' + +# Fancy compiler suites use optimising linker as well as compiler. +# +case "$_DEC_uname_r" in +*[123].*) # old loader + lddlflags="$lddlflags -O3" + ;; +*) lddlflags="$lddlflags $optimize -msym" + # -msym: If using a sufficiently recent /sbin/loader, + # keep the module symbols with the modules. + ;; +esac +# Yes, the above loses if gcc does not use the system linker. +# If that happens, let me know about it. + + +# If debugging or (old systems and doing shared) +# then do not strip the lib, otherwise, strip. +# As noted above the -DDEBUGGING is added automagically by Configure if -g. +case "$optimize" in + *-g*) ;; # left intentionally blank +*) case "$_DEC_uname_r" in + *[123].*) + case "$useshrplib" in + false|undef|'') lddlflags="$lddlflags -s" ;; + esac + ;; + *) lddlflags="$lddlflags -s" + ;; + esac + ;; +esac + +if [ "X$usethreads" = "X$define" ]; then + # Threads interfaces changed with V4.0. + case "$_DEC_uname_r" in + *[123].*) libswanted="$libswanted pthreads mach exc c_r" + ccflags="-threads $ccflags" + ;; + *) libswanted="$libswanted pthread exc" + ccflags="-pthread $ccflags" + ;; + esac + usemymalloc='n' +fi + +# +# Make embedding in things like INN and Apache more memory friendly. +# Keep it overridable on the Configure command line, though, so that +# "-Uuseshrplib" prevents this default. +# + +# This or the glibpth change above breaks the build. Commented out +# for this snapshot. +#case "$_DEC_cc_style.$useshrplib" in +# new.) useshrplib="$define" ;; +#esac + +# +# Unset temporary variables no more needed. +# + +unset _DEC_cc_style +unset _DEC_uname_r + +# +# History: +# +# perl5.004_57: +# +# 19-Dec-1997 Spider Boardman +# +# * Newer Digial UNIX compilers enforce signaling for NaN without +# -ieee. Added -fprm d at the same time since it's friendlier for +# embedding. +# +# * Fixed the library search path to match cc, ld, and /sbin/loader. +# +# * Default to building -Duseshrplib on newer systems. -Uuseshrplib +# still overrides. +# +# * Fix -pthread additions for useshrplib. ld has no -pthread option. +# +# +# perl5.004_04: +# +# 19-Sep-1997 Spider Boardman +# +# * libnet on Digital UNIX is for JAVA, not for sockets. +# +# +# perl5.003_28: +# +# 22-Feb-1997 Jarkko Hietaniemi +# +# * Restructuring Spider's suggestions. +# +# * Older Digital UNIXes cannot handle -Olimit ... for $lddlflags. +# +# * ld -s cannot be used in older Digital UNIXes when doing shared. +# +# +# 21-Feb-1997 Spider Boardman +# +# * -hidden removed. +# +# * -DSTANDARD_C removed. +# +# * -D_INTRINSICS added. (that -fast does not seem to buy much confirmed) +# +# * odbm not in libc, only ndbm. Therefore dbm back to $libswanted. +# +# * -msym for the newer runtime loaders. +# +# * $optimize also in $lddflags. +# +# +# perl5.003_27: +# +# 18-Feb-1997 Jarkko Hietaniemi +# +# * unset _DEC_cc_style and more commentary on -std. +# +# +# perl5.003_26: +# +# 15-Feb-1997 Jarkko Hietaniemi +# +# * -std and -ansi. +# +# +# perl5.003_24: +# +# 30-Jan-1997 Jarkko Hietaniemi +# +# * Fixing the note on -DDEBUGGING. +# +# * Note on -O5 -fast. +# +# +# perl5.003_23: +# +# 26-Jan-1997 Jarkko Hietaniemi +# +# * Notes on how to do both optimisation and debugging. +# +# +# 25-Jan-1997 Jarkko Hietaniemi +# +# * Remove unneeded libraries from $libswanted: PW, bsd, c, dbm +# +# * Restructure the $lddlflags build. +# +# * $optimize based on which compiler we have. +# +# +# perl5.003_22: +# +# 23-Jan-1997 Achim Bohnet +# +# * Added comments 'how to create a debugging version of perl' +# +# * Fixed logic of this script to prevent stripping of shared +# objects by the loader (see ld man page for -s) is debugging +# is set via the -g switch. +# +# +# 21-Jan-1997 Achim Bohnet +# +# * now 'dl' is always removed from libswanted. Not only if +# optimize is an empty string. +# +# +# 17-Jan-1997 Achim Bohnet +# +# * Removed 'dl' from libswanted: When the FreePort binary +# translator for Sun binaries is installed Configure concludes +# that it should use libdl.x.yz.fpx.so :-( +# Because the dlopen, dlclose,... calls are in the +# C library it not necessary at all to check for the +# dl library. Therefore dl is removed from libswanted. +# +# +# 1-Jan-1997 Achim Bohnet +# +# * Set -Olimit to 3200 because perl_yylex.c got too big +# for the optimizer. +# diff --git a/contrib/perl5/hints/dgux.sh b/contrib/perl5/hints/dgux.sh new file mode 100644 index 00000000000..03b285dbd4a --- /dev/null +++ b/contrib/perl5/hints/dgux.sh @@ -0,0 +1,141 @@ +# $Id: dgux.sh,v 1.8 1996-11-29 18:16:43-05 roderick Exp $ + +# This is a hints file for DGUX, which is Data General's Unix. It was +# originally developed with version 5.4.3.10 of the OS, and then was +# later updated running under version 4.11.2 (running on m88k hardware). +# The gross features should work with versions going back to 2.nil but +# some tweaking will probably be necessary. +# +# DGUX is a SVR4 derivative. It ships with gcc as the standard +# compiler. Since version 3.0 it has shipped with Perl 4.036 +# installed in /usr/bin, which is kind of neat. Be careful when you +# install that you don't overwrite the system version, though (by +# answering yes to the question about installing perl as /usr/bin/perl), +# as it would suck to try to get support if the vendor learned that you +# were physically replacing the system binaries. +# +# Be aware that if you opt to use dynamic loading you'll need to set +# your $LD_LIBRARY_PATH to include the source directory when you build, +# test and install the software. +# +# -Roderick Schertler + + +# Here are the things from some old DGUX hints files which are different +# from what's in here now. I don't know the exact reasons that most of +# these settings were in the hints files, presumably they can be chalked +# up to old Configure inadequacies and changes in the OS headers and the +# like. These settings might make a good place to start looking if you +# have problems. +# +# This was specified the the 4.036 hints file. That hints file didn't +# say what version of the OS it was developed using. +# +# cppstdin='/lib/cpp' +# +# The 4.036 and 5.001 hints files both contained these. The 5.001 hints +# file said it was developed with version 2.01 of DGUX. +# +# gidtype='gid_t' +# groupstype='gid_t' +# uidtype='uid_t' +# d_index='define' +# cc='gcc' +# +# These were peculiar to the 5.001 hints file. +# +# ccflags='-D_POSIX_SOURCE -D_DGUX_SOURCE' +# +# # an ugly hack, since the Configure test for "gcc -P -" hangs. +# # can't just use 'cppstdin', since our DG has a broken cppstdin :-( +# cppstdin=`cd ..; pwd`/cppstdin +# cpprun=`cd ..; pwd`/cppstdin +# +# One last note: The 5.001 hints file said "you don't want to use +# /usr/ucb/cc" in the place at which it set cc to gcc. That in +# particular baffles me, as I used to have 2.01 loaded and my memory +# is telling me that even then /usr/ucb was a symlink to /usr/bin. + + +# The standard system compiler is gcc, but invoking it as cc changes its +# behavior. I have to pick one name or the other so I can get the +# dynamic loading switches right (they vary depending on this). I'm +# picking gcc because there's no way to get at the optimization options +# and so on when you call it cc. +case $cc in + '') + cc=gcc + case $optimize in + '') optimize=-O2;; + esac + ;; +esac + +usevfork=true + +# DG has this thing set up with symlinks which point to different places +# depending on environment variables (see elink(5)) and the compiler and +# related tools use them to access different development environments +# (COFF, ELF, m88k BCS and so on), see sde(5). The upshot, however, is +# that when a normal program tries to access one of these elinks it sees +# no such file (like stat()ting a mis-directed symlink). Setting +# $plibpth to explicitly include the place to which the elinks point +# allows Configure to find libraries which vary based on the development +# environment. +# +# Starting with version 4.10 (the first time the OS supported Intel +# hardware) all libraries are accessed with this mechanism. +# +# The default $TARGET_BINARY_INTERFACE changed with version 4.10. The +# system now comes with a link named /usr/sde/default which points to +# the proper entry, but older versions lacked this and used m88kdgux +# directly. + +: && sde_path=${SDE_PATH:-/usr}/sde # hide from Configure +while : # dummy loop +do + if [ -n "$TARGET_BINARY_INTERFACE" ] + then set X "$TARGET_BINARY_INTERFACE" + else set X default dg m88k_dg ix86_dg m88kdgux m88kdguxelf + fi + shift + default_sde=$1 + for sde + do + [ -d "$sde_path/$sde" ] && break 2 + done + cat <&2 + +NOTE: I can't figure out what SDE is used by default on this machine (I +didn't find a likely directory under $sde_path). This is bad news. If +this is a R4.10 or newer system I'm not going to be able to find any of +your libraries, if this system is R3.10 or older I won't be able to find +the math library. You should re-run Configure with the environment +variable TARGET_BINARY_INTERFACE set to the proper value for this +machine, see sde(5) and the notes in hints/dgux.sh. + +END + sde=$default_sde + break +done + +plibpth="$plibpth $sde_path/$sde/usr/lib" +unset sde_path default_sde sde + +# Many functions (eg, gethostent(), killpg(), getpriority(), setruid() +# dbm_*(), and plenty more) are defined in -ldgc. Usually you don't +# need to know this (it seems that libdgc.so is searched automatically +# by ld), but Configure needs to check it otherwise it will report all +# those functions as missing. +libswanted="dgc $libswanted" + +# Dynamic loading works using the dlopen() functions. Note that dlfcn.h +# used to be broken, it declared _dl*() rather than dl*(). This was the +# case up to 3.10, it has been fixed in 4.11. I'm not sure if it was +# fixed in 4.10. If you have the older header just ignore the warnings +# (since pointers and integers have the same format on m88k). +usedl=true +# For cc rather than gcc the flags would be `-K PIC' for compiling and +# -G for loading. I haven't tested this. +cccdlflags=-fpic +lddlflags=-shared diff --git a/contrib/perl5/hints/dos_djgpp.sh b/contrib/perl5/hints/dos_djgpp.sh new file mode 100644 index 00000000000..73bae63dd2c --- /dev/null +++ b/contrib/perl5/hints/dos_djgpp.sh @@ -0,0 +1,59 @@ +# hints file for dos/djgpp v2.xx +# Original by Laszlo Molnar + +# 971015 - archname changed from 'djgpp' to 'dos-djgpp' +# 971210 - threads support + +archname='dos-djgpp' +archobjs='djgpp.o' +path_sep=\; +startsh="#! /bin/sh" + +cc='gcc' +ld='gcc' +usrinc="$DJDIR/include" + +libpth="$DJDIR/lib" +libc="$libpth/libc.a" + +so='none' +usedl='n' + +firstmakefile='GNUmakefile' +exe_ext='.exe' + +randbits=31 +lns='cp' + +usenm='true' + +d_link='undef' # these are empty functions in libc.a +d_symlink='undef' +d_fork='undef' +d_pipe='undef' + +startperl='#!perl' + +case "X$optimize" in + X) + optimize="-O2 -malign-loops=2 -malign-jumps=2 -malign-functions=2" + ;; +esac +ldflags='-s' +usemymalloc='n' +timetype='time_t' + +prefix=$DJDIR +privlib=$prefix/lib/perl5 +archlib=$privlib +sitelib=$privlib/site +sitearch=$sitelib + +eagain='EAGAIN' +rd_nodata='-1' + +if [ "X$usethreads" = "X$define" ]; then + set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'` + shift + libswanted="$*" +fi diff --git a/contrib/perl5/hints/dynix.sh b/contrib/perl5/hints/dynix.sh new file mode 100644 index 00000000000..4bdb804f530 --- /dev/null +++ b/contrib/perl5/hints/dynix.sh @@ -0,0 +1,7 @@ +# If this doesn't work, try specifying 'none' for hints. +d_castneg=undef +libswanted=`echo $libswanted | sed -e 's/socket /socket seq /'` + +# Reported by Craig Milo Rogers +# Date: Tue, 30 Jan 96 15:29:26 PST +d_casti32=undef diff --git a/contrib/perl5/hints/dynixptx.sh b/contrib/perl5/hints/dynixptx.sh new file mode 100644 index 00000000000..78a45e42a31 --- /dev/null +++ b/contrib/perl5/hints/dynixptx.sh @@ -0,0 +1,24 @@ +# Sequent Dynix/Ptx v. 4 hints +# Created 1996/03/15 by Brad Howerter, bhower@wgc.woodward.com +# Use Configure -Dcc=gcc to use gcc. + +# cc wants -G for dynamic loading +lddlflags='-G' + +# Remove inet to avoid this error in Configure, which causes Configure +# to be unable to figure out return types: +# dynamic linker: ./ssize: can't find libinet.so, +# link with -lsocket instead of -linet + +libswanted=`echo $libswanted | sed -e 's/ inet / /'` + +# Configure defaults to usenm='y', which doesn't work very well +usenm='n' + +# Reported by bruce@aps.org ("Bruce P. Schuck") as needed for +# DYNIX/ptx 4.0 V4.2.1 to get socket i/o to work +# Not defined by default in case they break other versions. +# These probably need to be worked into a piece of code that +# checks for the need for this setting. +# cppflags='-Wc,+abi-socket -I/usr/local/include' +# ccflags='-Wc,+abi-socket -I/usr/local/include' diff --git a/contrib/perl5/hints/epix.sh b/contrib/perl5/hints/epix.sh new file mode 100644 index 00000000000..b91537a202a --- /dev/null +++ b/contrib/perl5/hints/epix.sh @@ -0,0 +1,75 @@ +# epix.sh +# Hint file for EP/IX on CDC RISC boxes. +# +# From: Stanley Donald Capelik +# Modified by Andy Dougherty +# Last modified: Mon May 8 15:29:18 EDT 1995 +# +# This hint file appears to be based on the svr4 hints for perl5.000, +# with some CDC-specific additions. I've tried to updated it to +# match the 5.001 svr4 hints, which allow for dynamic loading, +# but I have no way of testing the resulting file. +# +# There were also some contradictions that I've tried to straighten +# out, but I'm not sure I got them all right. +# +# Edit config.sh to change shmattype from 'char *' to 'void *'" + +# Use Configure -Dcc=gcc to use gcc. +case "$cc" in +'') cc='/bin/cc3.11' + test -f $cc || cc='/usr/ccs/bin/cc' + ;; +esac + +usrinc='/svr4/usr/include' + +# Various things that Configure apparently doesn't get right. +strings='/svr4/usr/include/string.h' +timeincl='/svr4/usr/include/sys/time.h ' +libc='/svr4/usr/lib/libc.a' +glibpth="/svr4/usr/lib /svr4/usr/lib/cmplrs/cc /usr/ccs/lib /svr4/lib /svr4/usr/ucblib $glibpth" +osname='epix2' +archname='epix2' +d_suidsafe='define' # "./Configure -d" can't figure this out easilly +d_flock='undef' + +# Old version had this, but I'm not sure why since the old version +# also mucked around with libswanted. This is also definitely wrong +# if the user is trying to use DB_File or GDBM_File. +# libs='-lsocket -lnsl -ldbm -ldl -lc -lcrypt -lm -lucb' + +# We include support for using libraries in /usr/ucblib, but the setting +# of libswanted excludes some libraries found there. You may want to +# prevent "ucb" from being removed from libswanted and see if perl will +# build on your system. +ldflags='-non_shared -systype svr4 -L/svr4/usr/lib -L/svr4/usr/lib/cmplrs/cc -L/usr/ccs/lib -L/svr4/usr/ucblib' +ccflags='-systype svr4 -D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude' +cppflags='-D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude' + +# Don't use problematic libraries: + +libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'` +# libmalloc.a - Probably using Perl's malloc() anyway. +# libucb.a - Remove it if you have problems ld'ing. We include it because +# it is needed for ODBM_File and NDBM_File extensions. +if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: + # Use the "native" counterparts, not the BSD emulation stuff: + d_bcmp='undef'; d_bcopy='undef'; d_bzero='undef'; d_safebcpy='undef' + d_index='undef'; d_killpg='undef'; d_getprior='undef'; d_setprior='undef' + d_setlinebuf='undef'; d_setregid='undef'; d_setreuid='undef' +fi + +lddlflags="-G $ldflags" # Probably needed for dynamic loading +# We _do_ want the -L paths in ldflags, but we don't want the -non_shared. +lddlflags=`echo $lddlflags | sed 's/-non_shared//'` + +cat <<'EOM' >&4 + +If you wish to use dynamic linking, you must use + LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH +or + setenv LD_LIBRARY_PATH `pwd` +before running make. + +EOM diff --git a/contrib/perl5/hints/esix4.sh b/contrib/perl5/hints/esix4.sh new file mode 100644 index 00000000000..3d3145d2550 --- /dev/null +++ b/contrib/perl5/hints/esix4.sh @@ -0,0 +1,41 @@ +# hints/esix4.sh +# Original esix4 hint file courtesy of +# Kevin O'Gorman ( kevin@kosman.UUCP, kevin%kosman.uucp@nrc.com ) +# +# Use Configure -Dcc=gcc to use gcc. +case "$cc" in +'') cc='/bin/cc' + test -f $cc || cc='/usr/ccs/bin/cc' + ;; +esac +ldflags='-L/usr/ccs/lib -L/usr/ucblib' +test -d /usr/local/man || mansrc='none' +ccflags='-I/usr/include -I/usr/ucbinclude' +libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' ` +d_index='undef' +d_suidsafe=define +usevfork='false' +if test "$osvers" = "3.0"; then + d_gconvert='undef' + grep 'define[ ]*AF_OSI[ ]' /usr/include/sys/socket.h | grep '/\*[^*]*$' >/tmp/esix$$ + if test -s /tmp/esix$$; then + cat <&2 + +WARNING: You are likely to have problems compiling the Socket extension +unless you fix the unterminated comment for AF_OSI in the file +/usr/include/sys/socket.h. + +EOM + fi + rm -f /tmp/esix$$ +fi + +cat <<'EOM' >&4 + +If you wish to use dynamic linking, you must use + LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH +or + setenv LD_LIBRARY_PATH `pwd` +before running make. + +EOM diff --git a/contrib/perl5/hints/fps.sh b/contrib/perl5/hints/fps.sh new file mode 100644 index 00000000000..7726790ac0c --- /dev/null +++ b/contrib/perl5/hints/fps.sh @@ -0,0 +1 @@ +ccflags="$ccflags -J" diff --git a/contrib/perl5/hints/freebsd.sh b/contrib/perl5/hints/freebsd.sh new file mode 100644 index 00000000000..0f2a5a5a6d5 --- /dev/null +++ b/contrib/perl5/hints/freebsd.sh @@ -0,0 +1,155 @@ +# Original based on info from +# Carl M. Fongheiser +# Date: Thu, 28 Jul 1994 19:17:05 -0500 (CDT) +# +# Additional 1.1.5 defines from +# Ollivier Robert +# Date: Wed, 28 Sep 1994 00:37:46 +0100 (MET) +# +# Additional 2.* defines from +# Ollivier Robert +# Date: Sat, 8 Apr 1995 20:53:41 +0200 (MET DST) +# +# Additional 2.0.5 and 2.1 defined from +# Ollivier Robert +# Date: Fri, 12 May 1995 14:30:38 +0200 (MET DST) +# +# Additional 2.2 defines from +# Mark Murray +# Date: Wed, 6 Nov 1996 09:44:58 +0200 (MET) +# +# Modified to ensure we replace -lc with -lc_r, and +# to put in place-holders for various specific hints. +# Andy Dougherty +# Date: Tue Mar 10 16:07:00 EST 1998 +# +# The two flags "-fpic -DPIC" are used to indicate a +# will-be-shared object. Configure will guess the -fpic, (and the +# -DPIC is not used by perl proper) but the full define is included to +# be consistent with the FreeBSD general shared libs building process. +# +# setreuid and friends are inherently broken in all versions of FreeBSD +# before 2.1-current (before approx date 4/15/95). It is fixed in 2.0.5 +# and what-will-be-2.1 +# + +case "$osvers" in +0.*|1.0*) + usedl="$undef" + ;; +1.1*) + malloctype='void *' + groupstype='int' + d_setregid='undef' + d_setreuid='undef' + d_setrgid='undef' + d_setruid='undef' + ;; +2.0-release*) + d_setregid='undef' + d_setreuid='undef' + d_setrgid='undef' + d_setruid='undef' + ;; +# +# Trying to cover 2.0.5, 2.1-current and future 2.1/2.2 +# It does not covert all 2.1-current versions as the output of uname +# changed a few times. +# +# Even though seteuid/setegid are available, they've been turned off +# because perl isn't coded with saved set[ug]id variables in mind. +# In addition, a small patch is requried to suidperl to avoid a security +# problem with FreeBSD. +# +2.0.5*|2.0-built*|2.1*) + usevfork='true' + usemymalloc='n' + d_setregid='define' + d_setreuid='define' + d_setegid='undef' + d_seteuid='undef' + test -r ./broken-db.msg && . ./broken-db.msg + ;; +# +# 2.2 and above have phkmalloc(3). +# don't use -lmalloc (maybe there's an old one from 1.1.5.1 floating around) +2.2*) + usevfork='true' + usemymalloc='n' + libswanted=`echo $libswanted | sed 's/ malloc / /'` + d_setregid='define' + d_setreuid='define' + d_setegid='undef' + d_seteuid='undef' + ;; +# +# Guesses at what will be needed after 2.2 +*) usevfork='true' + usemymalloc='n' + libswanted=`echo $libswanted | sed 's/ malloc / /'` + ;; +esac + +# Dynamic Loading flags have not changed much, so they are separated +# out here to avoid duplicating them everywhere. +case "$osvers" in +0.*|1.0*) ;; + +3.0*) if [ -e /usr/lib/aout ]; then + libpth="/usr/lib/aout /usr/local/lib /usr/lib" + glibpth="/usr/lib/aout /usr/local/lib /usr/lib" + fi + cccdlflags='-DPIC -fpic' + lddlflags='-Bshareable' + ;; + +*) cccdlflags='-DPIC -fpic' + lddlflags="-Bshareable $lddlflags" + ;; +esac + +cat <<'EOM' >&4 + +Some users have reported that Configure halts when testing for +the O_NONBLOCK symbol with a syntax error. This is apparently a +sh error. Rerunning Configure with ksh apparently fixes the +problem. Try + ksh Configure [your options] + +EOM + +# XXX EXPERIMENTAL A.D. 03/09/1998 +# XXX This script UU/usethreads.cbu will get 'called-back' by Configure +# XXX after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOSH' +case "$usethreads" in +$define) + case "$osvers" in + 3.0*) ldflags="-pthread $ldflags" + ;; + 2.2*) if [ ! -r /usr/lib/libc_r ]; then + cat <<'EOM' >&4 +POSIX threads are not supported by default on FreeBSD $uname_r. Follow the +instructions in 'man pthread' to build and install the needed libraries. +EOM + exit 1 + fi + set `echo X "$libswanted "| sed -e 's/ c / c_r /'` + shift + libswanted="$*" + # Configure will probably pick the wrong libc to use for nm + # scan. + # The safest quick-fix is just to not use nm at all. + usenm=false + ;; + *) cat <<'EOM' >&4 +It is not known if FreeBSD $uname_r supports POSIX threads or not. Consider +upgrading to the latest STABLE release. +EOM + exit 1 + ;; + esac + ;; +esac +EOSH +# XXX EXPERIMENTAL --end of call-back diff --git a/contrib/perl5/hints/genix.sh b/contrib/perl5/hints/genix.sh new file mode 100644 index 00000000000..16b6879b46b --- /dev/null +++ b/contrib/perl5/hints/genix.sh @@ -0,0 +1 @@ +i_varargs=undef diff --git a/contrib/perl5/hints/greenhills.sh b/contrib/perl5/hints/greenhills.sh new file mode 100644 index 00000000000..da6fcc95b04 --- /dev/null +++ b/contrib/perl5/hints/greenhills.sh @@ -0,0 +1 @@ +ccflags="$ccflags -X18" diff --git a/contrib/perl5/hints/hpux.sh b/contrib/perl5/hints/hpux.sh new file mode 100644 index 00000000000..281f289c9b3 --- /dev/null +++ b/contrib/perl5/hints/hpux.sh @@ -0,0 +1,206 @@ +#! /bin/sh + +# hints/hpux.sh +# Perl Configure hints file for Hewlett-Packard's HP-UX 9.x and 10.x +# (Hopefully, 7.x through 11.x.) +# +# This file is based on hints/hpux_9.sh, Perl Configure hints file for +# Hewlett Packard HP-UX 9.x +# +# Use Configure -Dcc=gcc to use gcc. +# +# From: Jeff Okamoto +# and +# hints/hpux_10.sh, Perl Configure hints file for Hewlett Packard HP-UX 10.x +# From: Giles Lean +# and +# Use #define CPU_* instead of comments for >= 10.x. +# Support PA1.2 under 10.x. +# Distinguish between PA2.0, PA2.1, etc. +# Distinguish between MC68020, MC68030, MC68040 +# Don't assume every OS != 10 is < 10, (e.g., 11). +# From: Chuck Phillips + +# This version: August 15, 1997 +# Current maintainer: Jeff Okamoto + +#-------------------------------------------------------------------- +# Use Configure -Dcc=gcc to use gcc. +# Use Configure -Dprefix=/usr/local to install in /usr/local. +# +# You may have dynamic loading problems if the environment variable +# LDOPTS='-a archive'. Under >= 10.x, you can instead LDOPTS='-a +# archive_shared' to prefer archive libraries without requiring them. +# Regardless of HPUX release, in the "libs" variable or the ext.libs +# file, you can always give explicit path names to archive libraries +# that may not exist on the target machine. E.g., /usr/lib/libndbm.a +# instead of -lndbm. See also note below on ndbm. +# +# ALSO, bear in mind that gdbm and Berkely DB contain incompatible +# replacements for ndbm (and dbm) routines. If you want concurrent +# access to ndbm files, you need to make sure libndbm is linked in +# *before* gdbm and Berkely DB. Lastly, remember to check the +# "ext.libs" file which is *probably* messing up the order. Often, +# you can replace ext.libs with an empty file to fix the problem. +# +# If you get a message about "too much defining", as may happen +# in HPUX < 10, you might have to append a single entry to your +# ccflags: '-Wp,-H256000' +# NOTE: This is a single entry (-W takes the argument 'p,-H256000'). +#-------------------------------------------------------------------- + +# Turn on the _HPUX_SOURCE flag to get many of the HP add-ons +# regardless of compiler. For the HP ANSI C compiler, you may also +# want to include +e to enable "long long" and "long double". +# +# HP compiler flags to include (if at all) *both* as part of ccflags +# and cc itself so Configure finds (and builds) everything +# consistently: +# -Aa -D_HPUX_SOURCE +e +# +# Lastly, you may want to include the "-z" HP linker flag so that +# reading from a NULL pointer causes a SEGV. +ccflags="$ccflags -D_HPUX_SOURCE" + +# Check if you're using the bundled C compiler. This compiler doesn't support +# ANSI C (the -Aa flag) nor can it produce shared libraries. Thus we have +# to turn off dynamic loading. +case "$cc" in +'') if cc $ccflags -Aa 2>&1 | $contains 'option' >/dev/null + then + case "$usedl" in + '') usedl="$undef" + cat <<'EOM' >&4 + +The bundled C compiler can not produce shared libraries, so you will +not be able to use dynamic loading. + +EOM + ;; + esac + else + ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C + fi + # For HP's ANSI C compiler, up to "+O3" is safe for everything + # except shared libraries (PIC code). Max safe for PIC is "+O2". + # Setting both causes innocuous warnings. + #optimize='+O3' + #cccdlflags='+z +O2' + optimize='-O' + ;; +esac + +# Even if you use gcc, prefer the HP math library over the GNU one. + +case "`$cc -v 2>&1`" in +"*gcc*" ) test -d /lib/pa1.1 && ccflags="$ccflags -L/lib/pa1.1" ;; +esac + +# Determine the architecture type of this system. +# Keep leading tab below -- Configure Black Magic -- RAM, 03/02/97 + xxOsRevMajor=`uname -r | sed -e 's/^[^0-9]*//' | cut -d. -f1`; + #xxOsRevMinor=`uname -r | sed -e 's/^[^0-9]*//' | cut -d. -f2`; +if [ "$xxOsRevMajor" -ge 10 ] +then + # This system is running >= 10.x + + # Tested on 10.01 PA1.x and 10.20 PA[12].x. Idea: Scan + # /usr/include/sys/unistd.h for matches with "#define CPU_* `getconf + # CPU_VERSION`" to determine CPU type. Note the part following + # "CPU_" is used, *NOT* the comment. + # + # ASSUMPTIONS: Numbers will continue to be defined in hex -- and in + # /usr/include/sys/unistd.h -- and the CPU_* #defines will be kept + # up to date with new CPU/OS releases. + xxcpu=`getconf CPU_VERSION`; # Get the number. + xxcpu=`printf '0x%x' $xxcpu`; # convert to hex + archname=`sed -n -e "s/^#[ \t]*define[ \t]*CPU_//p" /usr/include/sys/unistd.h | + sed -n -e "s/[ \t]*$xxcpu[ \t].*//p" | + sed -e s/_RISC/-RISC/ -e s/HP_// -e s/_/./`; +else + # This system is running <= 9.x + # Tested on 9.0[57] PA and [78].0 MC680[23]0. Idea: After removing + # MC6888[12] from context string, use first CPU identifier. + # + # ASSUMPTION: Only CPU identifiers contain no lowercase letters. + archname=`getcontext | tr ' ' '\012' | grep -v '[a-z]' | grep -v MC688 | + sed -e 's/HP-//' -e 1q`; + selecttype='int *' +fi + + +# Remove bad libraries that will cause problems +# (This doesn't remove libraries that don't actually exist) +# -lld is unneeded (and I can't figure out what it's used for anyway) +# -ldbm is obsolete and should not be used +# -lBSD contains BSD-style duplicates of SVR4 routines that cause confusion +# -lPW is obsolete and should not be used +# The libraries crypt, malloc, ndir, and net are empty. +# Although -lndbm should be included, it will make perl blow up if you should +# copy the binary to a system without libndbm.sl. See ccdlflags below. +set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ dbm @ @' -e 's@ BSD @ @' -e 's@ PW @ @'` +libswanted="$*" + +# By setting the deferred flag below, this means that if you run perl +# on a system that does not have the required shared library that you +# linked it with, it will die when you try to access a symbol in the +# (missing) shared library. If you would rather know at perl startup +# time that you are missing an important shared library, switch the +# comments so that immediate, rather than deferred loading is +# performed. Even with immediate loading, you can postpone errors for +# undefined (or multiply defined) routines until actual access by +# adding the "nonfatal" option. +# ccdlflags="-Wl,-E -Wl,-B,immediate $ccdlflags" +# ccdlflags="-Wl,-E -Wl,-B,immediate,-B,nonfatal $ccdlflags" +ccdlflags="-Wl,-E -Wl,-B,deferred $ccdlflags" + +usemymalloc='y' +alignbytes=8 +# For native nm, you need "-p" to produce BSD format output. +nm_opt='-p' + +# When HP-UX runs a script with "#!", it sets argv[0] to the script name. +toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' + +# If your compile complains about FLT_MIN, uncomment the next line +# POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"' + +# Comment this out if you don't want to follow the SVR4 filesystem layout +# that HP-UX 10.0 uses +case "$prefix" in +'') prefix='/opt/perl5' ;; +esac + +# HP-UX can't do setuid emulation offered by Configure +case "$d_dosuid" in +'') d_dosuid="$undef" ;; +esac + +# Date: Fri, 6 Sep 96 23:15:31 CDT +# From: "Daniel S. Lewart" +# I looked through the gcc.info and found this: +# * GNU CC compiled code sometimes emits warnings from the HP-UX +# assembler of the form: +# (warning) Use of GR3 when frame >= 8192 may cause conflict. +# These warnings are harmless and can be safely ignored. + +# +# cppstdin and cpprun need the -Aa option if you use the unbundled +# ANSI C compiler (*not* the bundled K&R compiler or gcc) +# [XXX this should be enabled automatically by Configure, but isn't yet.] +# [XXX This is reported not to work. You may have to edit config.sh. +# After running Configure, set cpprun and cppstdin in config.sh, +# run "Configure -S" and then "make".] +# +case "$cppstdin" in +'') + case "$ccflags" in + *-Aa*) + cpprun="${cc:-cc} -E -Aa" + cppstdin="$cpprun" + cppminus='-' + cpplast='-' + ;; + esac + ;; +esac diff --git a/contrib/perl5/hints/i386.sh b/contrib/perl5/hints/i386.sh new file mode 100644 index 00000000000..0a810ffea88 --- /dev/null +++ b/contrib/perl5/hints/i386.sh @@ -0,0 +1 @@ +ldflags='-L/usr/ucblib' diff --git a/contrib/perl5/hints/irix_4.sh b/contrib/perl5/hints/irix_4.sh new file mode 100644 index 00000000000..f5883f38cb7 --- /dev/null +++ b/contrib/perl5/hints/irix_4.sh @@ -0,0 +1,24 @@ +#irix_4.sh +# Last modified Fri May 5 14:06:37 EDT 1995 +optimize='-O1' + +# Does Configure really get these wrong? Why? +d_voidsig=define +d_charsprf=undef + +case "$cc" in +*gcc*) ccflags="$ccflags -D_BSD_TYPES" ;; +*) ccflags="$ccflags -ansiposix -signed" ;; +esac + +# This hint due thanks Hershel Walters +# Date: Tue, 31 Jan 1995 16:32:53 -0600 (CST) +# Subject: IRIX4.0.4(.5? 5.0?) problems +# I don't know if they affect versions of perl other than 5.000 or +# versions of IRIX other than 4.0.4. +# +cat <<'EOM' >&4 +If you have problems, you might have try including + -DSTANDARD_C -cckr +in ccflags. +EOM diff --git a/contrib/perl5/hints/irix_5.sh b/contrib/perl5/hints/irix_5.sh new file mode 100644 index 00000000000..9d6e80246c0 --- /dev/null +++ b/contrib/perl5/hints/irix_5.sh @@ -0,0 +1,34 @@ +# irix_5.sh +# Tue Jan 9 16:04:38 EST 1996 +# Add note about socket patch. +# +# Tue Jan 2 14:52:36 EST 1996 +# Apparently, there's a stdio bug that can lead to memory +# corruption using perl's malloc, but not SGI's malloc. +usemymalloc='n' + +ld=ld +i_time='define' + +case "$cc" in +*gcc*) ccflags="$ccflags -D_BSD_TYPES" ;; +*) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 4000" ;; +esac + +lddlflags="-shared" +# For some reason we don't want -lsocket -lnsl or -ldl. Can anyone +# contribute an explanation? +set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` +shift +libswanted="$*" + +# Date: Fri, 22 Dec 1995 11:49:17 -0800 +# From: Matthew Black +# Subject: sockets broken under IRIX 5.3? YES...how to fix +# Anyone attempting to use perl4 or perl5 with SGI IRIX 5.3 may discover +# that sockets are essentially broken. The syslog interface for perl also +# fails because it uses the broken socket interface. This problem was +# reported to SGI as bug #255347 and it can be fixed by installing +# patchSG0000596. The patch can be downloaded from Advantage OnLine (SGI's +# WWW server) or from the Support Advantage 9/95 Patch CDROM. Thanks to Tom +# Christiansen and others who provided assistance. diff --git a/contrib/perl5/hints/irix_6.sh b/contrib/perl5/hints/irix_6.sh new file mode 100644 index 00000000000..384701ffd6d --- /dev/null +++ b/contrib/perl5/hints/irix_6.sh @@ -0,0 +1,190 @@ +# hints/irix_6.sh +# +# original from Krishna Sethuraman, krishna@sgi.com +# +# Modified Mon Jul 22 14:52:25 EDT 1996 +# Andy Dougherty +# with help from Dean Roehrich . +# cc -n32 update info from Krishna Sethuraman, krishna@sgi.com. +# additional update from Scott Henry, scotth@sgi.com + +# Futzed with by John Stoffel on 4/24/1997 +# - assumes 'cc -n32' by default +# - tries to check for various compiler versions and do the right +# thing when it can +# - warnings turned off (-n32 messages): +# 1116 - non-void function should return a value +# 1048 - cast between pointer-to-object and pointer-to-function +# 1042 - operand types are incompatible + +# Tweaked by Chip Salzenberg on 5/13/97 +# - don't assume 'cc -n32' if the n32 libm.so is missing + +# Threaded by Jarkko Hietaniemi on 11/18/97 +# - POSIX threads knowledge by IRIX version + +# gcc-enabled by Kurt Starsinic on 3/24/1998 + +# Use sh Configure -Dcc='cc -n32' to try compiling with -n32. +# or -Dcc='cc -n32 -mips3' (or -mips4) to force (non)portability +# Don't bother with -n32 unless you have the 7.1 or later compilers. +# But there's no quick and light-weight way to check in 6.2. + +# Let's assume we want to use 'cc -n32' by default, unless the +# necessary libm is missing (which has happened at least twice) +case "$cc" in +'') + if test -f /usr/lib32/libm.so + then + cc='cc -n32' + fi ;; +esac + +# Check for which compiler we're using + +case "$cc" in +*"cc -n32"*) + + # Perl 5.004_57 introduced new qsort code into pp_ctl.c that + # makes IRIX cc prior to 7.2.1 to emit bad code. + # so some serious hackery follows to set pp_ctl flags correctly. + + # Check for which version of the compiler we're running + case "`$cc -version 2>&1`" in + *7.0*) # Mongoose 7.0 + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0" + optimize='none' + ;; + *7.1*|*7.2|*7.20) # Mongoose 7.1+ + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" + optimize='-O3' +# This is a temporary fix for 5.005. +# Leave pp_ctl_cflags line at left margin for Configure. See +# hints/README.hints, especially the section +# =head2 Propagating variables to config.sh +pp_ctl_cflags='optimize=-O' + ;; + *7.*) # Mongoose 7.2.1+ + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=on" + optimize='-O3' + ;; + *6.2*) # Ragnarok 6.2 + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184" + optimize='none' + ;; + *) # Be safe and not optimize + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0" + optimize='none' + ;; + esac + + ld=ld + # perl's malloc can return improperly aligned buffer + usemymalloc='undef' + # NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker + ldflags=' -L/usr/local/lib32 -L/usr/local/lib' + cccdlflags=' ' + # From: David Billinghurst + # If you get complaints about so_locations then change the following + # line to something like: + # lddlflags="-n32 -shared -check_registry /usr/lib32/so_locations" + lddlflags="-n32 -shared" + libc='/usr/lib32/libc.so' + plibpth='/usr/lib32 /lib32 /usr/ccs/lib' + nm_opt='-p' + nm_so_opt='-p' + ;; +*gcc*) + ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -D_POSIX_C_SOURCE" + optimize="-O3" + usenm='undef' + ;; +*) + # this is needed to force the old-32 paths + # since the system default can be changed. + ccflags="$ccflags -32 -D_BSD_TYPES -D_BSD_TIME -Olimit 3100" + optimize='-O' + ;; +esac + +# We don't want these libraries. +# Socket networking is in libc, these are not installed by default, +# and just slow perl down. (scotth@sgi.com) +set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` +shift +libswanted="$*" + +# I have conflicting reports about the sun, crypt, bsd, and PW +# libraries on Irix 6.2. +# +# One user rerports: +# Don't need sun crypt bsd PW under 6.2. You *may* need to link +# with these if you want to run perl built under 6.2 on a 5.3 machine +# (I haven't checked) +# +# Another user reported that if he included those libraries, a large number +# of the tests failed (approx. 20-25) and he would get a core dump. To +# make things worse, test results were inconsistent, i.e., some of the +# tests would pass some times and fail at other times. +# The safest thing to do seems to be to eliminate them. +# +# Actually, the only libs that you want are '-lm'. Everything else +# you need is in libc. You do also need '-lbsd' if you choose not +# to use the -D_BSD_* defines. Note that as of 6.2 the only +# difference between '-lmalloc' and '-lc' malloc is the debugging +# and control calls, which aren't used by perl. -- scotth@sgi.com + +set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /' -e 's/ malloc / /'` +shift +libswanted="$*" + +if [ "X$usethreads" = "X$define" -o "X$usethreads" = "Xy" ]; then + if test ! -f /usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then + uname_r=`uname -r` + case "`uname -r`" in + 5*|6.0|6.1) + echo >&4 "IRIX $uname_r does not have the POSIX threads." + echo >&4 "You should upgrade to at least IRIX 6.2 with pthread patches." + echo >&4 "Cannot continue, aborting." + exit 1 + ;; + 6.2) + echo >&4 "" +cat >&4 <&4 "IRIX $uname_r should have the POSIX threads." + echo >&4 "But somehow you do not seem to have them installed." + echo >&4 "Cannot continue, aborting." + exit 1 + ;; + esac + unset uname_r + fi + # -lpthread needs to come before -lc but after other libraries such + # as -lgdbm and such like. We assume here that -lc is present in + # libswanted. If that fails to be true in future, then this can be + # changed to add pthread to the very end of libswanted. + set `echo X "$libswanted "| sed -e 's/ c / pthread /'` + ld="${cc:-cc}" + shift + libswanted="$*" + usemymalloc='n' +fi diff --git a/contrib/perl5/hints/irix_6_0.sh b/contrib/perl5/hints/irix_6_0.sh new file mode 100644 index 00000000000..b0a39943bd4 --- /dev/null +++ b/contrib/perl5/hints/irix_6_0.sh @@ -0,0 +1,51 @@ +# irix_6.sh +# from Krishna Sethuraman, krishna@sgi.com +# Date: Wed Jan 18 11:40:08 EST 1995 +# added `-32' to force compilation in 32-bit mode. +# otherwise, copied from irix_5.sh. + +# Perl built with this hints file under IRIX 6.0.1 passes +# all tests (`make test'). + +# Tue Jan 2 14:52:36 EST 1996 +# Apparently, there's a stdio bug that can lead to memory +# corruption using perl's malloc, but not SGI's malloc. +usemymalloc='n' + +ld=ld +i_time='define' +cc="cc -32" +ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" +lddlflags="-32 -shared" + +# We don't want these libraries. Anyone know why? +set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` +shift +libswanted="$*" +# +# The following might be of interest if you wish to try 64-bit mode: +# irix_6_64bit.sh +# Krishna Sethuraman, krishna@sgi.com +# taken from irix_5.sh . Changes from irix_5.sh: +# Olimit and nested comments (warning 1009) no longer accepted +# -OPT:fold_arith_limit so POSIX module will optimize +# no 64bit versions of sun, crypt, nsl, socket, dl dso's available +# as of IRIX 6.0.1 so omit those from libswanted line via `sed'. + +# perl 5 built with this hints file passes most tests (`make test'). +# Fails on op/subst test only. (built and tested under IRIX 6.0.1). + +# i_time='define' +# ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -woff 1009 -OPT:fold_arith_limit=1046" +# lddlflags="-shared" +# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'` +# shift +# libswanted="$*" + +if [ "X$usethreads" = "X$define" ]; then + echo >&4 "IRIX 6.0 does not have POSIX threads." + echo >&4 "You should upgrade to at least IRIX 6.3." + echo >&4 "Cannot continue, aborting." + exit 1 +fi + diff --git a/contrib/perl5/hints/irix_6_1.sh b/contrib/perl5/hints/irix_6_1.sh new file mode 100644 index 00000000000..1c54f774a90 --- /dev/null +++ b/contrib/perl5/hints/irix_6_1.sh @@ -0,0 +1,50 @@ +# irix_6.sh +# from Krishna Sethuraman, krishna@sgi.com +# Date: Wed Jan 18 11:40:08 EST 1995 +# added `-32' to force compilation in 32-bit mode. +# otherwise, copied from irix_5.sh. + +# Perl built with this hints file under IRIX 6.0.1 passes +# all tests (`make test'). + +# Tue Jan 2 14:52:36 EST 1996 +# Apparently, there's a stdio bug that can lead to memory +# corruption using perl's malloc, but not SGI's malloc. +usemymalloc='n' + +ld=ld +i_time='define' +cc="cc -32" +ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" +lddlflags="-32 -shared" + +# We don't want these libraries. Anyone know why? +set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` +shift +libswanted="$*" +# +# The following might be of interest if you wish to try 64-bit mode: +# irix_6_64bit.sh +# Krishna Sethuraman, krishna@sgi.com +# taken from irix_5.sh . Changes from irix_5.sh: +# Olimit and nested comments (warning 1009) no longer accepted +# -OPT:fold_arith_limit so POSIX module will optimize +# no 64bit versions of sun, crypt, nsl, socket, dl dso's available +# as of IRIX 6.0.1 so omit those from libswanted line via `sed'. + +# perl 5 built with this hints file passes most tests (`make test'). +# Fails on op/subst test only. (built and tested under IRIX 6.0.1). + +# i_time='define' +# ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -woff 1009 -OPT:fold_arith_limit=1046" +# lddlflags="-shared" +# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'` +# shift +# libswanted="$*" + +if [ "X$usethreads" = "X$define" ]; then + echo >&4 "IRIX 6.1 does not have POSIX threads." + echo >&4 "You should upgrade to at least IRIX 6.3." + echo >&4 "Cannot continue, aborting." + exit 1 +fi diff --git a/contrib/perl5/hints/isc.sh b/contrib/perl5/hints/isc.sh new file mode 100644 index 00000000000..cdfe91c605a --- /dev/null +++ b/contrib/perl5/hints/isc.sh @@ -0,0 +1,44 @@ +# isc.sh +# Interactive Unix Versions 3 and 4. +# Compile perl entirely in posix mode. +# Andy Dougherty doughera@lafcol.lafayette.edu +# Wed Oct 5 15:57:37 EDT 1994 +# +# Use Configure -Dcc=gcc to use gcc +# + +# We don't want to explicitly mention -lc (since we're using POSIX mode.) +# We also don't want -lx (the Xenix compatability libraries.) The only +# thing that it seems to pick up is chsize(), which has been reported to +# not work. chsize() can also be implemented via fcntl() in perl (if you +# define -D_SYSV3). We'll leave in -lPW since it's harmless. Some +# extension might eventually need it for alloca, though perl doesn't use +# it. + +set `echo X "$libswanted "| sed -e 's/ c / /' -e 's/ x / /'` +shift +libswanted="$*" + +case "$cc" in +*gcc*) ccflags="$ccflags -posix" + ldflags="$ldflags -posix" + ;; +*) ccflags="$ccflags -Xp -D_POSIX_SOURCE" + ldflags="$ldflags -Xp" + ;; +esac + +# getsockname() and getpeername() return 256 for no good reason +ccflags="$ccflags -DBOGUS_GETNAME_RETURN=256" + +# rename(2) can't rename long filenames +d_rename=undef + +# for ext/IPC/SysV/SysV.xs +ccflags="$ccflags -DPERL_ISC" + +# You can also include -D_SYSV3 to pick up "traditionally visible" +# symbols hidden by name-space pollution rules. This raises some +# compilation "redefinition" warnings, but they appear harmless. +# ccflags="$ccflags -D_SYSV3" + diff --git a/contrib/perl5/hints/isc_2.sh b/contrib/perl5/hints/isc_2.sh new file mode 100644 index 00000000000..d8ca7dc63a7 --- /dev/null +++ b/contrib/perl5/hints/isc_2.sh @@ -0,0 +1,25 @@ +# isc_2.sh +# Interactive Unix Version 2.2 +# Compile perl entirely in posix mode. +# Andy Dougherty doughera@lafcol.lafayette.edu +# Wed Oct 5 15:57:37 EDT 1994 +# +# Use Configure -Dcc=gcc to use gcc +# +set `echo X "$libswanted "| sed -e 's/ c / /'` +shift +libswanted="$*" +case "$cc" in +*gcc*) ccflags="$ccflags -posix" + ldflags="$ldflags -posix" + ;; +*) ccflags="$ccflags -Xp -D_POSIX_SOURCE" + ldflags="$ldflags -Xp" + ;; +esac +# Compensate for conflicts in +doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' +pp_sys_cflags='ccflags="$ccflags -DENOTSOCK=103"' + +# for ext/IPC/SysV/SysV.xs +ccflags="$ccflags -DPERL_ISC" diff --git a/contrib/perl5/hints/linux.sh b/contrib/perl5/hints/linux.sh new file mode 100644 index 00000000000..545f50eb3d3 --- /dev/null +++ b/contrib/perl5/hints/linux.sh @@ -0,0 +1,215 @@ +# hints/linux.sh +# Original version by rsanders +# Additional support by Kenneth Albanowski +# +# ELF support by H.J. Lu +# Additional info from Nigel Head +# and Kenneth Albanowski +# +# Consolidated by Andy Dougherty +# +# Updated Thu Feb 8 11:56:10 EST 1996 + +# Updated Thu May 30 10:50:22 EDT 1996 by + +# Updated Fri Jun 21 11:07:54 EDT 1996 +# NDBM support for ELF renabled by + +# No version of Linux supports setuid scripts. +d_suidsafe='undef' + +# perl goes into the /usr tree. See the Filesystem Standard +# available via anonymous FTP at tsx-11.mit.edu in +# /pub/linux/docs/linux-standards/fsstnd. +# Allow a command line override, e.g. Configure -Dprefix=/foo/bar +case "$prefix" in +'') prefix='/usr' ;; +esac + +# gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool. +ccflags="-Dbool=char -DHAS_BOOL $ccflags" + +# BSD compatability library no longer needed +# 'kaffe' has a /usr/lib/libnet.so which is not at all relevent for perl. +set `echo X "$libswanted "| sed -e 's/ bsd / /' -e 's/ net / /'` +shift +libswanted="$*" + +# Configure may fail to find lstat() since it's a static/inline +# function in . +d_lstat=define + +# Explanation? +case "$usemymalloc" in +'') usemymalloc='n' ;; +esac + +case "$optimize" in +'') optimize='-O2' ;; +esac + +# Are we using ELF? Thanks to Kenneth Albanowski +# for this test. +cat >try.c <<'EOM' +/* Test for whether ELF binaries are produced */ +#include +#include +main() { + char buffer[4]; + int i=open("a.out",O_RDONLY); + if(i==-1) + exit(1); /* fail */ + if(read(i,&buffer[0],4)<4) + exit(1); /* fail */ + if(buffer[0] != 127 || buffer[1] != 'E' || + buffer[2] != 'L' || buffer[3] != 'F') + exit(1); /* fail */ + exit(0); /* succeed (yes, it's ELF) */ +} +EOM +if ${cc:-gcc} try.c >/dev/null 2>&1 && ./a.out; then + cat <<'EOM' >&4 + +You appear to have ELF support. I'll try to use it for dynamic loading. +If dynamic loading doesn't work, read hints/linux.sh for further information. +EOM + +#For RedHat Linux 3.0.3, you may need to fetch +# ftp://ftp.redhat.com/pub/redhat-3.0.3/i386/updates/RPMS/ld.so-1.7.14-3.i386.rpm +# + +else + cat <<'EOM' >&4 + +You don't have an ELF gcc. I will use dld if possible. If you are +using a version of DLD earlier than 3.2.6, or don't have it at all, you +should probably upgrade. If you are forced to use 3.2.4, you should +uncomment a couple of lines in hints/linux.sh and restart Configure so +that shared libraries will be disallowed. + +EOM + lddlflags="-r $lddlflags" + # These empty values are so that Configure doesn't put in the + # Linux ELF values. + ccdlflags=' ' + cccdlflags=' ' + ccflags="-DOVR_DBL_DIG=14 $ccflags" + so='sa' + dlext='o' + nm_so_opt=' ' + ## If you are using DLD 3.2.4 which does not support shared libs, + ## uncomment the next two lines: + #ldflags="-static" + #so='none' + + # In addition, on some systems there is a problem with perl and NDBM + # which causes AnyDBM and NDBM_File to lock up. This is evidenced + # in the tests as AnyDBM just freezing. Apparently, this only + # happens on a.out systems, so we disable NDBM for all a.out linux + # systems. If someone can suggest a more robust test + # that would be appreciated. + # + # More info: + # Date: Wed, 7 Feb 1996 03:21:04 +0900 + # From: Jeffrey Friedl + # + # I tried compiling with DBM support and sure enough things locked up + # just as advertised. Checking into it, I found that the lockup was + # during the call to dbm_open. Not *in* dbm_open -- but between the call + # to and the jump into. + # + # To make a long story short, making sure that the *.a and *.sa pairs of + # /usr/lib/lib{m,db,gdbm}.{a,sa} + # were perfectly in sync took care of it. + # + # This will generate a harmless Whoa There! message + case "$d_dbm_open" in + '') cat <<'EOM' >&4 + +Disabling ndbm. This will generate a Whoa There message in Configure. +Read hints/linux.sh for further information. +EOM + # You can override this with Configure -Dd_dbm_open + d_dbm_open=undef + ;; + esac +fi + +rm -f try.c a.out + +if /bin/bash -c exit; then + echo '' + echo 'You appear to have a working bash. Good.' +else + cat << 'EOM' >&4 + +*********************** Warning! ********************* +It would appear you have a defective bash shell installed. This is likely to +give you a failure of op/exec test #5 during the test phase of the build, +Upgrading to a recent version (1.14.4 or later) should fix the problem. +****************************************************** +EOM + +fi + +# On SPARClinux, +# The following csh consistently coredumped in the test directory +# "/home/mikedlr/perl5.003_94/t", though not most other directories. + +#Name : csh Distribution: Red Hat Linux (Rembrandt) +#Version : 5.2.6 Vendor: Red Hat Software +#Release : 3 Build Date: Fri May 24 19:42:14 1996 +#Install date: Thu Jul 11 16:20:14 1996 Build Host: itchy.redhat.com +#Group : Shells Source RPM: csh-5.2.6-3.src.rpm +#Size : 184417 +#Description : BSD c-shell + +# For this reason I suggest using the much bug-fixed tcsh for globbing +# where available. + +if [ ! "`csh -c 'echo $version' 2>/dev/null`" ] +then + echo 'Real csh found (might break); looking for tcsh ...' + # Use ./UU/loc to find tcsh. (We no longer run in the hints/ directory) + if xxx=`./UU/loc tcsh blurfl $pth`; $test -f "$xxx"; then + echo "Found tcsh. I'll use it for globbing." + # We can't change Configure's setting of $csh, due to the way + # Configure handles $d_portable and commands found in $loclist. + # We can set the value for CSH in config.h by setting full_csh. + full_csh=$xxx + else + echo "Couldn't find tcsh. BEWARE: GLOBBING MIGHT BE BROKEN." + fi +else + echo 'Your csh is really tcsh. Good.' +fi + +# Shimpei Yamashita +# Message-Id: <33EF1634.B36B6500@pobox.com> +# +# MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other +# linuces, needs special flags passed in order for dynamic loading to work. +# instead of the recommended: +# ccdlflags='-rdynamic' +# +# it should be: +# ccdlflags='-Wl,-E' + +# XXX EXPERIMENTAL A.D. 2/27/1998 +# XXX This script UU/usethreads.cbu will get 'called-back' by Configure +# XXX after it has prompted the user for whether to use threads. +cat > UU/usethreads.cbu <<'EOSH' +case "$usethreads" in +$define|true|[yY]*) + ccflags="-D_REENTRANT $ccflags" + # -lpthread needs to come before -lc but after other libraries such + # as -lgdbm and such like. We assume here that -lc is present in + # libswanted. If that fails to be true in future, then this can be + # changed to add pthread to the very end of libswanted. + set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` + shift + libswanted="$*" + ;; +esac +EOSH +# XXX EXPERIMENTAL --end of call-back diff --git a/contrib/perl5/hints/lynxos.sh b/contrib/perl5/hints/lynxos.sh new file mode 100644 index 00000000000..ddffcbe3cc7 --- /dev/null +++ b/contrib/perl5/hints/lynxos.sh @@ -0,0 +1,11 @@ +# +# LynxOS hints +# +# These hints were submitted by: +# Greg Seibert +# seibert@Lynx.COM +# + +cc='gcc' +so='none' +usemymalloc='n' diff --git a/contrib/perl5/hints/machten.sh b/contrib/perl5/hints/machten.sh new file mode 100644 index 00000000000..f283873699d --- /dev/null +++ b/contrib/perl5/hints/machten.sh @@ -0,0 +1,224 @@ +# machten.sh +# This is for MachTen 4.0.3. It might work on other versions and variants too. +# +# Users of earlier MachTen versions might need a fixed tr from ftp.tenon.com. +# This should be described in the MachTen release notes. +# +# MachTen 2.x has its own hint file. +# +# This file has been put together by Andy Dougherty +# based on comments from lots of +# folks, especially +# Mark Pease +# Martijn Koster +# Richard Yeh +# +# For now, explicitly disable dynamic loading -- MT 4.1.1 has it, +# but these hints do not yet support it. +# Define NOTEDEF_MACHTEN to undo gratuitous Tenon hack to signal.h. +# -- Dominic Dunlop 9800802 +# Completely disable SysV IPC pending more complete support from Tenon +# -- Dominic Dunlop 980712 +# Use vfork and perl's malloc by default +# -- Dominic Dunlop 980630 +# Raise perl's stack size again; cut down reg_infty; document +# -- Dominic Dunlop 980619 +# Use of semctl() can crash system: disable -- Dominic Dunlop 980506 +# Raise stack size further; slight tweaks to accomodate MT 4.1 +# -- Dominic Dunlop 980211 +# Raise perl's stack size -- Dominic Dunlop 970922 +# Reinstate sigsetjmp iff version is 4.0.3 or greater; use nm +# (assumes Configure change); prune libswanted -- Dominic Dunlop 970113 +# Warn about test failure due to old Berkeley db -- Dominic Dunlop 970105 +# Do not use perl's malloc; SysV IPC OK -- Neil Cutcliffe, Tenon 961030 +# File::Find's use of link count disabled by Dominic Dunlop 960528 +# Perl's use of sigsetjmp etc. disabled by Dominic Dunlop 960521 +# +# Comments, questions, and improvements welcome! +# +# MachTen 4.1.1 does support dynamic loading, but perl doesn't +# know how to use it yet. +usedl=${usedl:-undef} + +# MachTen 4.1.1 may have an unhelpful hack in /usr/include/signal.h. +# Undo it if so. +if grep NOTDEF_MACHTEN /usr/include/signal.h > /dev/null +then + ccflags="$ccflags -DNOTDEF_MACHTEN" +fi + +# Power MachTen is a real memory system and its standard malloc +# has been optimized for this. Using this malloc instead of Perl's +# malloc may result in significant memory savings. In particular, +# unlike most UNIX memory allocation subsystems, MachTen's free() +# really does return unneeded process data memory to the system. +# However, MachTen's malloc() is woefully slow -- maybe 100 times +# slower than perl's own, so perl's own is usually the better +# choice. In order to use perl's malloc(), the sbrk() system call +# must be simulated using MachTen's malloc(). See malloc.c for +# precise details of how this is achieved. Recent improvements +# to perl's malloc() currently crash MachTen, and so are disabled +# by -DPLAIN_MALLOC and -DNO_FANCY_MALLOC. +usemymalloc=${usemymalloc:-y} + +# Do not wrap the following long line +malloc_cflags='ccflags="$ccflags -DPLAIN_MALLOC -DNO_FANCY_MALLOC -DUSE_PERL_SBRK"' + +# Note that an empty malloc_cflags appears in config.sh if perl's +# malloc() is not used. his is harmless. +case "$usemymalloc" in +n) unset malloc_cflags;; +*) ccflags="$ccflags -DHIDEMYMALLOC" +esac + +# When MachTen does a fork(), it immediately copies the whole of +# the parent process' data space for the child. This can be +# expensive. Using vfork() where appropriate avoids this cost. +d_vfork=${d_vfork:-define} + +# Specify a high level of optimization (-O3 wouldn't do much more) +optimize=${optimize:--O2 -fomit-frame-pointer} + +# Make symbol table listings les voluminous +nmopts=-gp + +# Set reg_infty -- the maximum allowable number of repeats in regular +# expressions such as /a{1,$max_repeats}/, and the maximum number of +# times /a*/ will match. Setting this too high without having a stack +# large enough to accommodate deep recursion in the regular expression +# engine allows perl to crash your Mac due to stack overrun if it +# encounters a pathological regular expression. The default is a +# compromise between capability and required stack size (see below). +# You may override the default value from the Configure command-line +# like this: +# +# Configure -Dreg_infty=16368 ... + +reg_infty=${reg_infty:-2047} + +# If you want to have many perl processes active simultaneously -- +# processing CGI forms -- for example, you should opt for a small stack. +# For safety, you should set reg_infty no larger than the corresponding +# value given in this table: +# +# Stack size reg_infty value supported +# ---------- ------------------------- +# 128k 2**8-1 (256) +# 256k 2**9-1 (511) +# 512k 2**10-1 (1023) +# 1M 2**11-1 (2047) +# ... +# 16M 2**15-1 (32767) (perl's default value) + +# This script selects a safe stack size based on the value of reg_infty +# specified above. However, you may choose to take a risk and set +# stack size lower: pathological regular expressions are rare in real-world +# programs. But be aware that, if perl does encounter one, it WILL +# crash your system. Do not set stack size lower than 96k unless +# you want perl's installation tests ( make test ) to crash your system. +# +# You may override the default value from the Configure command-line +# by specifying the required size in kilobytes like this: +# +# Configure -Dstack_size=96 + +if [ "X$stack_size" = 'X' ] +then + stack_size=128 + X=`expr $reg_infty / 256` + + while [ $X -gt 0 ] + do + X=`expr $X / 2` + stack_size=`expr $stack_size \* 2` + done + X=`expr $stack_size \* 1024` +fi + +ldflags="$ldflags -Xlstack=$X" +ccflags="$ccflags -DREG_INFTY=$reg_infty" + +# Install in /usr/local by default +prefix='/usr/local' + +# At least on PowerMac, doubles must be aligned on 8 byte boundaries. +# I don't know if this is true for all MachTen systems, or how to +# determine this automatically. +alignbytes=8 + +# 4.0.2 and earlier had a problem with perl's use of sigsetjmp and +# friends. Use setjmp and friends instead. +expr "$osvers" \< "4.0.3" > /dev/null && d_sigsetjmp='undef' + +# System V IPC support in MachTen 4.1 is incomplete (missing msg function +# prototypes, no ftok()), buggy (semctl(.., .., IPC_STATUS, ..) hangs +# system), and undocumented. Claim it's not there until things improve. +d_msg=${d_msg:-undef} +d_sem=${d_sem:-undef} +d_shm=${d_shm:-undef} + +# Get rid of some extra libs which it takes Configure a tediously +# long time never to find on MachTen +set `echo X "$libswanted "|sed -e 's/ net / /' -e 's/ socket / /' \ + -e 's/ inet / /' -e 's/ nsl / /' -e 's/ nm / /' -e 's/ malloc / /' \ + -e 's/ ld / /' -e 's/ sun / /' -e 's/ posix / /' \ + -e 's/ cposix / /' -e 's/ crypt / /' \ + -e 's/ ucb / /' -e 's/ bsd / /' -e 's/ BSD / /' -e 's/ PW / /'` +shift +libswanted="$*" + +# While link counts on MachTen 4.1's fast file systems work correctly, +# on Macintosh Heirarchical File Systems, (and on HFS+) +# MachTen always reports ony two links to directories, even if they +# contain subdirectories. Consequently, we use this variable to stop +# File::Find using the link count to determine whether there are +# subdirectories to be searched. This will generate a harmless message: +# Hmm...You had some extra variables I don't know about...I'll try to keep 'em. +# Propagating recommended variable dont_use_nlink +dont_use_nlink=define + +cat <&4 + +During Configure, you may see the message + +*** WHOA THERE!!! *** + The recommended value for \$d_msg on this machine was "undef"! + Keep the recommended value? [y] + +as well as similar messages concerning \$d_sem and \$d_shm. Select the +default answers: MachTen 4.1 appears to provide System V IPC support, +but it is incomplete and buggy: perl should be built without it. + +Similarly, when you see + +*** WHOA THERE!!! *** + The recommended value for \$d_vfork on this machine was "define"! + Keep the recommended value? [y] + +select the default answer: vfork() works, and avoids expensive data +copying. + +At the end of Configure, you will see a harmless message + +Hmm...You had some extra variables I don't know about...I'll try to keep 'em. + Propagating recommended variable dont_use_nlink + Propagating recommended variable nmopts + Propagating recommended variable malloc_cflags... + Propagating recommended variable reg_infty +Read the File::Find documentation for more information about dont_use_nlink + +Your perl will be built with a stack size of ${stack_size}k and a regular +expression repeat count limit of $reg_infty. If you want alternative +values, see the file hints/machten.sh for advice on how to change them. + +Tests + io/fs test 4 and + op/stat test 3 +may fail since MachTen may not return a useful nlinks field to stat +on directories. + +EOM +expr "$osvers" \< "4.1" >/dev/null && test -r ./broken-db.msg && \ + . ./broken-db.msg + +unset stack_size X diff --git a/contrib/perl5/hints/machten_2.sh b/contrib/perl5/hints/machten_2.sh new file mode 100644 index 00000000000..bc7dde4e3fa --- /dev/null +++ b/contrib/perl5/hints/machten_2.sh @@ -0,0 +1,94 @@ +# machten.sh +# This file has been put together by Mark Pease +# Comments, questions, and improvements welcome! +# +# MachTen does not support dynamic loading. If you wish to, you +# can fetch, compile, and install the dld package. +# This ought to work with the ext/DynaLoader/dl_dld.xs in the +# perl5 package. Have fun! +# Some possible locations for dld: +# ftp-swiss.ai.mit.edu:pub/scm/dld-3.2.7.tar.gz +# prep.ai.mit.edu:/pub/gnu/jacal/dld-3.2.7.tar.gz +# ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/dld-3.2.7.tar.gz +# tsx-11.mit.edu:/pub/linux/sources/libs/dld-3.2.7.tar.gz +# +# Original version was for MachTen 2.1.1. +# Last modified by Andy Dougherty +# Tue Aug 13 12:31:01 EDT 1996 +# +# Warning about tests which no longer fail +# fixed by Tom Phoenix +# March 5, 1997 +# +# Locale, optimization, and malloc changes by Tom Phoenix Mar 15, 1997 +# +# groupstype change and note about t/lib/findbin.t by Tom, Mar 24, 1997 + +# MachTen's ability to have valid filepaths beginning with "//" may +# be causing lib/FindBin.pm to fail. I don't know how to fix it, but +# the reader is encouraged to do so! :-) -- Tom + +# There seem to be some hard-to-diagnose problems under MachTen's +# malloc, so we'll use Perl's. If you have problems which Perl's +# malloc's diagnostics can't help you with, you may wish to use +# MachTen's malloc after all. +case "$usemymalloc" in +'') usemymalloc='y' ;; +esac + +# I (Tom Phoenix) don't know how to test for locales on MachTen. (If +# you do, please fix this hints file!) But since mine didn't come +# with locales working out of the box, I'll assume that's the case +# for most folks. +case "$d_setlocale" in +'') d_setlocale=undef +esac + +# MachTen doesn't have secure setid scripts +d_suidsafe='undef' + +# groupstype should be gid_t, as near as I can tell, but it only +# seems to work right when it's int. +groupstype='int' + +case "$optimize" in +'') optimize='-O2' ;; +esac + +so='none' +# These are useful only if you have DLD, but harmless otherwise. +# Make sure gcc doesn't use -fpic. +cccdlflags=' ' # That's an empty space. +lddlflags='-r' +dlext='o' + +# MachTen does not support POSIX enough to compile the POSIX module. +useposix=false + +#MachTen might have an incomplete Berkeley DB implementation. +i_db=$undef + +#MachTen versions 2.X have no hard links. This variable is used +# by File::Find. +# This will generate a harmless message: +# Hmm...You had some extra variables I don't know about...I'll try to keep 'em. +# Propagating recommended variable dont_use_nlink +# Without this, tests io/fs #4 and op/stat #3 will fail. +dont_use_nlink=define + +cat <<'EOM' >&4 + +During Configure, you may get two "WHOA THERE" messages, for $d_setlocale +and $i_db being 'undef'. You may keep the undef value. + +At the end of Configure, you will see a harmless message + +Hmm...You had some extra variables I don't know about...I'll try to keep 'em. + Propagating recommended variable dont_use_nlink + +Read the File::Find documentation for more information. + +It's possible that test t/lib/findbin.t will fail on some configurations +of MachTen. + +EOM diff --git a/contrib/perl5/hints/mips.sh b/contrib/perl5/hints/mips.sh new file mode 100644 index 00000000000..bc0b7e80737 --- /dev/null +++ b/contrib/perl5/hints/mips.sh @@ -0,0 +1,14 @@ +perl_cflags='optimize="-g"' +d_volatile=undef +d_castneg=undef +cc=cc +glibpth="/usr/lib/cmplrs/cc $glibpth" +groupstype=int +nm_opt='-B' +case $PATH in +*bsd*:/bin:*) cat <&4 +NOTE: Some people have reported having much better luck with Mips CC than +with the BSD cc. Put /bin first in your PATH if you have difficulties. +END +;; +esac diff --git a/contrib/perl5/hints/mpc.sh b/contrib/perl5/hints/mpc.sh new file mode 100644 index 00000000000..da6fcc95b04 --- /dev/null +++ b/contrib/perl5/hints/mpc.sh @@ -0,0 +1 @@ +ccflags="$ccflags -X18" diff --git a/contrib/perl5/hints/mpeix.sh b/contrib/perl5/hints/mpeix.sh new file mode 100644 index 00000000000..4a32b77fa26 --- /dev/null +++ b/contrib/perl5/hints/mpeix.sh @@ -0,0 +1,104 @@ +# The MPE/iX linker doesn't complain about unresolved symbols, and so the only +# way to test for unresolved symbols in a program is by attempting to run it. +# But this is slow, and fraught with problems, so the better solution is to use +# nm. +# +# MPE/iX lacks a fully functional native nm, so we need to use our fake nm +# script which will extract the symbol info from the native link editor and +# reformat into something nm-like. +# +# Created for 5.003 by Mark Klein, mklein@dis.com. +# Substantially revised for 5.004_01 by Mark Bixby, markb@cccd.edu. +# Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. +# +osname='mpeix' +osvers='5.5' +# +# Force Configure to use our wrapper mpeix/nm script +# +PATH="$PWD/mpeix:$PATH" +nm="$PWD/mpeix/nm" +_nm=$nm +nm_opt='-configperl' +usenm='true' +# +# Various directory locations. +# +prefix='/PERL/PUB' +archname='PA-RISC1.1' +bin="$prefix" +installman1dir="$prefix/man/man1" +installman3dir="$prefix/man/man3" +man1dir="$prefix/man/man1" +man3dir="$prefix/man/man3" +perlpath="$prefix/PERL" +scriptdir="$prefix" +startperl="#!$prefix/perl" +startsh='#!/bin/sh' +# +# Compiling. +# +cc='gcc' +cccdlflags='none' +ccflags='-DMPE -D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL -DIS_SOCKET_CLIB_ITSELF' +locincpth='/usr/local/include /usr/contrib/include /BIND/PUB/include' +optimize='-O2' +ranlib='/bin/true' +# Special compiling options for certain source files. +regcomp_cflags='optimize=-O' +toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' +# +# Linking. +# +lddlflags='-b' +libs='-lbind -lsvipc -lsocket -lm -lc' +loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib' +# +# External functions and data items. +# +d_crypt='define' +d_difftime='define' +d_dlerror='undef' +d_dlopen='undef' +d_Gconvert='gcvt((x),(n),(b))' +d_inetaton='undef' +d_link='undef' +d_mblen='define' +d_mbstowcs='define' +d_mbtowc='define' +d_memcmp='define' +d_memcpy='define' +d_memmove='define' +d_memset='define' +d_pwage='undef' +d_pwcomment='undef' +d_pwgecos='undef' +d_pwpasswd='undef' +d_setpgid='undef' +d_setsid='undef' +d_setvbuf='define' +d_statblks='undef' +d_strchr='define' +d_strcoll='define' +d_strerrm='strerror(e)' +d_strerror='define' +d_strtod='define' +d_strtol='define' +d_strtoul='define' +d_strxfrm='define' +d_syserrlst='define' +d_time='define' +d_wcstombs='define' +d_wctomb='define' +# +# Include files. +# +i_termios='undef' +i_time='define' +i_systime='undef' +i_systimek='undef' +timeincl='/usr/include/time.h' +# +# Data types. +# +timetype='time_t' diff --git a/contrib/perl5/hints/ncr_tower.sh b/contrib/perl5/hints/ncr_tower.sh new file mode 100644 index 00000000000..7ddb9230e90 --- /dev/null +++ b/contrib/perl5/hints/ncr_tower.sh @@ -0,0 +1,16 @@ +# For SysV release 2, there are no directory functions defined. To +# prevent compile errors, acquire the functions written by Doug Gwynn. +# They are contained in dirent.tar.gz and can be accessed from gnu +# repositories, as well as other places. +# +# The following hints have been verified to work with PERL5 (001m) on +# SysVr2 with the following caveat(s): +# 1. Maximum User program space (MAXSPACE) must be at least 2MB. +# 2. The directory functions mentioned above have been installed. +# +optimize='-O0' +ccflags="$ccflags -W2,-Sl,1500 -W0,-Sp,350,-Ss,2500 -Wp,-Sd,30" +d_mkdir=$undef +usemymalloc='y' +useposix='false' +so='none' diff --git a/contrib/perl5/hints/netbsd.sh b/contrib/perl5/hints/netbsd.sh new file mode 100644 index 00000000000..71d508448a6 --- /dev/null +++ b/contrib/perl5/hints/netbsd.sh @@ -0,0 +1,79 @@ +# hints/netbsd.sh +# +# talk to mrg@eterna.com.au if you want to change this file. +# +# netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o, +# so Configure doesn't find them (unless you abandon the nm scan). +# this should be *just* 0.9 below as netbsd 0.9a was the first to +# introduce shared libraries. however, they don't work/build on +# pmax, powerpc and alpha ports correctly, yet. + +case "$archname" in +'') + archname=`uname -m`-${osname} + ;; +esac + +case "$osvers" in +0.9|0.8*) + usedl="$undef" + ;; +*) + case `uname -m` in + alpha|powerpc|pmax) + d_dlopen=$undef + ;; +# this doesn't work (yet). +# alpha) +# d_dlopen=$define +# d_dlerror=$define +# cccdlflags="-DPIC -fPIC $cccdlflags" +# lddlflags="-shared $lddlflags" +# ;; + *) + d_dlopen=$define + d_dlerror=$define +# we use -fPIC here because -fpic is *NOT* enough for some of the +# extensions like Tk on some netbsd platforms (the sparc is one) + cccdlflags="-DPIC -fPIC $cccdlflags" + lddlflags="-Bforcearchive -Bshareable $lddlflags" + ;; + esac + ;; +esac +# netbsd 1.3 linker warns about setr[gu]id being deprecated. +# (setregid, setreuid, preferred?) +case "$osvers" in +1.3|1.3*) + d_setrgid="$undef" + d_setruid="$undef" + ;; +esac + +# netbsd had these but they don't really work as advertised, in the +# versions listed below. if they are defined, then there isn't a +# way to make perl call setuid() or setgid(). if they aren't, then +# ($<, $>) = ($u, $u); will work (same for $(/$)). this is because +# you can not change the real userid of a process under 4.4BSD. +# netbsd fixed this in 1.2A. +case "$osvers" in +0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*) + d_setregid="$undef" + d_setreuid="$undef" + d_setrgid="$undef" + d_setruid="$undef" + ;; +esac +# netbsd 1.3 linker warns about setr[gu]id being deprecated. +# (setregid, setreuid, preferred?) +case "$osvers" in +1.3|1.3*) + d_setrgid="$undef" + d_setruid="$undef" + ;; +esac + +# vfork is ok on NetBSD. +case "$usevfork" in +'') usevfork=true ;; +esac diff --git a/contrib/perl5/hints/newsos4.sh b/contrib/perl5/hints/newsos4.sh new file mode 100644 index 00000000000..a33cb3154a3 --- /dev/null +++ b/contrib/perl5/hints/newsos4.sh @@ -0,0 +1,34 @@ +# +# hints file for NEWS-OS 4.x +# + +echo +echo 'Compiling Tips:' +echo 'When you have found that ld complains "multiple defined" error' +echo 'on linking /lib/libdbm.a, do following instructions.' +echo ' cd /tmp (working on /tmp)' +echo ' cp /lib/libdbm.a dbm.o (copy current libdbm.a)' +echo ' ar cr libdbm.a dbm.o (make archive)' +echo ' mv /lib/libdbm.a /lib/libdbm.a.backup (backup original library)' +echo ' cp /tmp/libdbm.a /lib (copy newer one)' +echo ' ranlib /lib/libdbm.a (ranlib for later use)' +echo + +# No shared library. +so='none' +# Umm.. I like gcc. +cc='gcc' +# Configure does not find out where is libm. +plibpth='/usr/lib/cmplrs/cc' +# times() returns 'struct tms' +clocktype='struct tms' +# getgroups(2) returns integer (not gid_t) +groupstype='int' +# time(3) returns long (not time_t) +timetype='long' +# filemode type is int (not mode_t) +modetype='int' +# using sprintf(3) instead of gcvt(3) +d_Gconvert='sprintf((b),"%.*g",(n),(x))' +# No POSIX. +useposix='false' diff --git a/contrib/perl5/hints/next_3.sh b/contrib/perl5/hints/next_3.sh new file mode 100644 index 00000000000..43340c03ad2 --- /dev/null +++ b/contrib/perl5/hints/next_3.sh @@ -0,0 +1,131 @@ +# This file has been put together by Anno Siegel , +# Andreas Koenig and Gerd Knops . +# Comments, questions, and improvements welcome! +# +# These hints work for NeXT 3.2 and 3.3. 3.0 has it's own +# special hint file. +# + +###################################################################### +# THE MALLOC STORY +###################################################################### +# 1994: +# the simple program `for ($i=1;$i<38771;$i++){$t{$i}=123}' fails +# with Larry's malloc on NS 3.2 due to broken sbrk() +# +# setting usemymalloc='n' was the solution back then. Later came +# reports that perl would run unstable on 3.2: +# +# 1996: +# From about perl5.002beta1h perl became unstable on the +# NeXT. Intermittent coredumps were frequent on 3.2 OS. There were +# reports, that the developer version of 3.3 didn't have problems, so it +# seemed pretty obvious that we had to work around an malloc bug in 3.2. +# This hints file reflects a patch to perl5.002_01 that introduces a +# home made sbrk routine (remember, NeXT's sbrk _never_ worked). This +# sbrk makes it possible to run perl with its own malloc. Thanks to +# Ilya who showed me the way to his sbrk for OS/2!! +# +# The whole malloc desaster lead to a failing gdbm test. It is far +# beyond my understanding, why GDBM_File breaks with the "fix", but in +# general I consider it better to have a working perl with broken GDBM +# than no perl at all. +# +# So, this hintsfile is using perl's malloc. If you want to turn +# perl's malloc off, you need to remove '-DUSE_PERL_SBRK' and +# '-DHIDEMYMALLOC' from the ccflags and set usemymalloc to 'n'. +# +# 1997: +# From perl5.003_22 the malloc bug has no impact any more. We can run +# a perl without a special sbrk. Apparently Chip Salzenberg, the hero +# of 5.004 anyway, earned another trophy during Australien Open. +# +# use the following two lines to enable USE_PERL_SBRK. Try this if you +# encounter intermittent core dumps: +#ccflags='-DUSE_NEXT_CTYPE -DUSE_PERL_SBRK -DHIDEMYMALLOC' +#usemymalloc='y' +# use the following two lines if you have perl5.003_22 or better and +# do not encounter intermittent core dumps. + +ccflags='-DUSE_NEXT_CTYPE' +usemymalloc='n' + +###################################################################### +# End of the MALLOC story +###################################################################### + +ldflags='-u libsys_s' +libswanted='dbm gdbm db' + +lddlflags='-nostdlib -r' +# Give cccdlflags an empty value since Configure will detect we are +# using GNU cc and try to specify -fpic for cccdlflags. +cccdlflags=' ' + +###################################################################### +# MAB support +###################################################################### +# By default we will build for all architectures your development +# environment supports. If you only want to build for the platform +# you are on, simply comment or remove the line below. +# +# If you want to build for specific architectures, change the line +# below to something like +# +# archs='m68k i386' +# +archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` + +# +# leave the following part alone +# +archcount=`echo $archs |wc -w` +if [ $archcount -gt 1 ] +then + for d in $archs + do + mabflags="$mabflags -arch $d" + done + ccflags="$ccflags $mabflags" + ldflags="$ldflags $mabflags" + lddlflags="$lddlflags $mabflags" + archname='next-fat' +fi +###################################################################### +# END MAB support +###################################################################### +ld='cc' + +i_utime='undef' +groupstype='int' +direntrytype='struct direct' +d_strcoll='undef' +d_uname='define' +# +# At least on m68k there are situations when memcmp doesn't behave +# as expected. So we'll use perl's memcmp. +# +d_sanemcmp='undef' +# setpgid() is in the posix library, but we don't use -posix, so +# we don't see it. ext/POSIX/POSIX.xs *does* use -posix, so +# setpgid is still available as POSIX::setpgid. +# See ext/POSIX/POSIX/hints/next.pl. +d_setpgid='undef' +d_setsid='define' +d_tcgetpgrp='define' +d_tcsetpgrp='define' + +# +# On some NeXT machines, the timestamp put by ranlib is not correct, and +# this may cause useless recompiles. Fix that by adding a sleep before +# running ranlib. The '5' is an empirical number that's "long enough." +# +ranlib='sleep 5; /bin/ranlib' + +# +# There where reports that the compiler on HPPA machines +# fails with the -O flag on pp.c. +# Compiling pp.c with -O for HPPA machines results in a broken perl. +# This is true whether we're on an HPPA machine or cross-compiling +# for one. +pp_cflags='optimize=""' diff --git a/contrib/perl5/hints/next_3_0.sh b/contrib/perl5/hints/next_3_0.sh new file mode 100644 index 00000000000..b8cc2c2d905 --- /dev/null +++ b/contrib/perl5/hints/next_3_0.sh @@ -0,0 +1,53 @@ +# This file has been put together by Anno Siegel +# and Andreas Koenig . Comments, questions, and +# improvements welcome! + +# This file was modified to work on NS 3.0 by Kevin White +# , based on suggestions by Andreas +# Koenig and Andy Dougherty. + +echo With NS 3.0 you won\'t be able to use the POSIX module. >&4 +echo Be aware that some of the tests that are run during \"make test\" >&4 +echo will fail due to the lack of POSIX support on this system. >&4 +echo >&4 +echo Also, if you have the GDBM installed, make sure the header file >&4 +echo is located at a place on the system where the C compiler will >&4 +echo find it. By default, it is placed in /usr/local/include/gdbm.h. >&4 +echo It will not be found there. Try moving it to >&4 +echo /NextDeveloper/Headers/bsd/gdbm.h. >&4 + +ccflags='-DUSE_NEXT_CTYPE -DNEXT30_NO_ATTRIBUTE' +POSIX_cflags='ccflags="-posix $ccflags"' +useposix='undef' +ldflags='-u libsys_s' +libswanted='dbm gdbm db' +# +lddlflags='-r' +# Give cccdlflags an empty value since Configure will detect we are +# using GNU cc and try to specify -fpic for cccdlflags. +cccdlflags=' ' +# +i_utime='undef' +groupstype='int' +direntrytype='struct direct' +d_strcoll='undef' +# the simple program `for ($i=1;$i<38771;$i++){$t{$i}=123}' fails +# with Larry's malloc on NS 3.2 due to broken sbrk() +usemymalloc='n' +d_uname='define' + +# Thanks to Etienne Grossman for sending +# the correct values for perl5.003_11 for the following 4 +# variables. For older version all four were defined. +d_setsid='undef' +d_tcgetpgrp='undef' +d_tcsetpgrp='undef' +d_setpgid='undef' + +# +# On some NeXT machines, the timestamp put by ranlib is not correct, and +# this may cause useless recompiles. Fix that by adding a sleep before +# running ranlib. The '5' is an empirical number that's "long enough." +# (Thanks to Andreas Koenig ) +ranlib='sleep 5; /bin/ranlib' + diff --git a/contrib/perl5/hints/next_4.sh b/contrib/perl5/hints/next_4.sh new file mode 100644 index 00000000000..b3887e612b0 --- /dev/null +++ b/contrib/perl5/hints/next_4.sh @@ -0,0 +1,95 @@ +###################################################################### +# +# IMPORTANT: before you run 'make', you need to enter one of these two +# lines (depending on your shell): +# DYLD_LIBRARY_PATH=`pwd`; export DYLD_LIBRARY_PATH +# or +# setenv DYLD_LIBRARY_PATH `pwd` +# +###################################################################### + +# Posix support has been removed from NextStep +# +useposix='undef' + +libpth='/lib /usr/lib' +libswanted=' ' +libc='/NextLibrary/Frameworks/System.framework/System' + +ldflags='-dynamic -prebind' +lddlflags='-dynamic -bundle -undefined suppress' +ccflags='-dynamic -fno-common -DUSE_NEXT_CTYPE -DUSE_PERL_SBRK -DHIDEMYMALLOC' +cccdlflags='none' +ld='cc' +#optimize='-g -O' + +###################################################################### +# MAB support +###################################################################### +# By default we will build for all architectures your development +# environment supports. If you only want to build for the platform +# you are on, simply comment or remove the line below. +# +# If you want to build for specific architectures, change the line +# below to something like +# +# archs='m68k i386' +# +archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'` + +# +# leave the following part alone +# +archcount=`echo $archs |wc -w` +if [ $archcount -gt 1 ] +then + for d in $archs + do + mabflags="$mabflags -arch $d" + done + ccflags="$ccflags $mabflags" + ldflags="$ldflags $mabflags" + lddlflags="$lddlflags $mabflags" +fi +###################################################################### +# END MAB support +###################################################################### + +useshprlib='true' +dlext='bundle' +so='dylib' + +# +# The default prefix would be '/usr/local'. But since many people are +# likely to have still 3.3 machines on their network, we do not want +# to overwrite possibly existing 3.3 binaries. +# You can use Configure -Dprefix=/foo/bar to override this, or simply +# remove the lines below. +# +case "$prefix" in +'') prefix='/usr/local/OPENSTEP' ;; +esac + +archname='OPENSTEP-Mach' + +# +# At least on m68k there are situations when memcmp doesn't behave +# as expected. So we'll use perl's memcmp. +# +d_sanemcmp='undef' + +d_strcoll='undef' +i_dbm='define' +i_utime='undef' +groupstype='int' +direntrytype='struct direct' + +usemymalloc='y' +clocktype='int' + +# +# On some NeXT machines, the timestamp put by ranlib is not correct, and +# this may cause useless recompiles. Fix that by adding a sleep before +# running ranlib. The '5' is an empirical number that's "long enough." +# (Thanks to Andreas Koenig ) +ranlib='sleep 5; /bin/ranlib' diff --git a/contrib/perl5/hints/openbsd.sh b/contrib/perl5/hints/openbsd.sh new file mode 100644 index 00000000000..4c98ec8587a --- /dev/null +++ b/contrib/perl5/hints/openbsd.sh @@ -0,0 +1,51 @@ +# hints/openbsd.sh +# +# hints file for OpenBSD; Todd Miller +# Edited to allow Configure command-line overrides by +# Andy Dougherty +# + +# OpenBSD has a better malloc than perl... +test "$usemymalloc" || usemymalloc='n' + +# Currently, vfork(2) is not a real win over fork(2) but this will +# change in a future release. +usevfork='true' + +# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions +# in 4.4BSD. Configure will find these but they are just emulated +# and do not have the same semantics as in 4.3BSD. +d_setregid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' + +# +# Not all platforms support shared libs... +# +case `uname -m` in +alpha|mips|powerpc|vax) + d_dlopen=$undef + ;; +*) + d_dlopen=$define + d_dlerror=$define + # we use -fPIC here because -fpic is *NOT* enough for some of the + # extensions like Tk on some OpenBSD platforms (ie: sparc) + cccdlflags="-DPIC -fPIC $cccdlflags" + lddlflags="-Bforcearchive -Bshareable $lddlflags" + ;; +esac + +# OpenBSD doesn't need libcrypt but many folks keep a stub lib +# around for old NetBSD binaries. +libswanted=`echo $libswanted | sed 's/ crypt / /'` + +# Configure can't figure this out non-interactively +d_suidsafe='define' + +# cc is gcc so we can do better than -O +# Allow a command-line override, such as -Doptimize=-g +test "$optimize" || optimize='-O2' + +# end diff --git a/contrib/perl5/hints/opus.sh b/contrib/perl5/hints/opus.sh new file mode 100644 index 00000000000..da6fcc95b04 --- /dev/null +++ b/contrib/perl5/hints/opus.sh @@ -0,0 +1 @@ +ccflags="$ccflags -X18" diff --git a/contrib/perl5/hints/os2.sh b/contrib/perl5/hints/os2.sh new file mode 100644 index 00000000000..78d370a1e93 --- /dev/null +++ b/contrib/perl5/hints/os2.sh @@ -0,0 +1,302 @@ +#! /bin/sh +# hints/os2.sh +# This file reflects the tireless work of +# Ilya Zakharevich +# +# Trimmed and comments added by +# Andy Dougherty +# Exactly what is required beyond a standard OS/2 installation? +# (see in README.os2) + +# Note that symbol extraction code gives wrong answers (sometimes?) on +# gethostent and setsid. + +# Optimization (GNU make 3.74 cannot be loaded :-(): +emxload -m 30 sh.exe ls.exe tr.exe id.exe sed.exe # make.exe +emxload -m 30 grep.exe egrep.exe fgrep.exe cat.exe rm.exe mv.exe cp.exe +emxload -m 30 uniq.exe basename.exe sort.exe awk.exe echo.exe + +path_sep=\; + +if test -f $sh.exe; then sh=$sh.exe; fi + +startsh="#!$sh" +cc='gcc' + +# Make denser object files and DLL +case "X$optimize" in + X) + optimize="-O2 -fomit-frame-pointer -malign-loops=2 -malign-jumps=2 -malign-functions=2 -s" + ld_dll_optimize="-s" + ;; +esac + +# Get some standard things (indented to avoid putting in config.sh): + oifs="$IFS" + IFS=" ;" + set $MANPATH + tryman="$@" + set $LIBRARY_PATH + libemx="$@" + set $C_INCLUDE_PATH + usrinc="$@" + IFS="$oifs" + tryman="`./UU/loc . /man $tryman`" + tryman="`echo $tryman | tr '\\\' '/'`" + + # indented to avoid having it *two* times at start + libemx="`./UU/loc os2.a /emx/lib $libemx`" + +usrinc="`./UU/loc stdlib.h /emx/include $usrinc`" +usrinc="`dirname $usrinc | tr '\\\' '/'`" +libemx="`dirname $libemx | tr '\\\' '/'`" + +if test -d $tryman/man1; then + sysman="$tryman/man1" +else + sysman="`./UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`" +fi + +emxpath="`dirname $libemx`" +if test ! -d "$emxpath"; then + emxpath="`./UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`" +fi + +if test ! -d "$libemx"; then + libemx="$emxpath/lib" +fi +if test ! -d "$libemx"; then + if test -d "$LIBRARY_PATH"; then + libemx="$LIBRARY_PATH" + else + libemx="`./UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`" + fi +fi + +if test ! -d "$usrinc"; then + if test -d "$emxpath/include"; then + usrinc="$emxpath/include" + else + if test -d "$C_INCLUDE_PATH"; then + usrinc="$C_INCLUDE_PATH" + else + usrinc="`./UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`" + fi + fi +fi + +rsx="`./UU/loc rsx.exe undef $pth`" + +if test "$libemx" = "X"; then echo "Cannot find C library!" >&2; fi + +# Acute backslashitis: +libpth="`echo \"$LIBRARY_PATH\" | tr ';\\\' ' /'`" +libpth="$libpth $libemx/mt $libemx" + +set `emxrev -f emxlibcm` +emxcrtrev=$5 + +so='dll' + +# Additional definitions: + +firstmakefile='GNUmakefile' +exe_ext='.exe' + +# We provide it +i_dlfcn='define' + +aout_d_shrplib='undef' +aout_useshrplib='false' +aout_obj_ext='.o' +aout_lib_ext='.a' +aout_ar='ar' +aout_plibext='.a' +aout_lddlflags="-Zdll $ld_dll_optimize" +if [ $emxcrtrev -ge 50 ]; then + aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000' +else + aout_ldflags='-Zexe -Zstack 32000' +fi + +# To get into config.sh: +aout_ldflags="$aout_ldflags" + +aout_d_fork='define' +aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' +aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' +aout_use_clib='c' +aout_usedl='undef' +aout_archobjs="os2.o dl_os2.o" + +# variable which have different values for aout compile +used_aout='d_shrplib useshrplib plibext lib_ext obj_ext ar plibext d_fork lddlflags ldflags ccflags use_clib usedl archobjs cppflags' + +if [ "$emxaout" != "" ]; then + d_shrplib="$aout_d_shrplib" + useshrplib="$aout_useshrplib" + obj_ext="$aout_obj_ext" + lib_ext="$aout_lib_ext" + ar="$aout_ar" + plibext="$aout_plibext" + if [ $emxcrtrev -lt 50 ]; then + d_fork="$aout_d_fork" + fi + lddlflags="$aout_lddlflags" + ldflags="$aout_ldflags" + ccflags="$aout_ccflags" + cppflags="$aout_cppflags" + use_clib="$aout_use_clib" + usedl="$aout_usedl" +else + d_shrplib='define' + useshrplib='true' + obj_ext='.obj' + lib_ext='.lib' + ar='emxomfar' + plibext='.lib' + if [ $emxcrtrev -ge 50 ]; then + d_fork='define' + else + d_fork='undef' + fi + lddlflags="-Zdll -Zomf -Zmt -Zcrtdll $ld_dll_optimize" + # Recursive regmatch may eat 2.5M of stack alone. + ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' + if [ $emxcrtrev -ge 50 ]; then + ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I.' + else + ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK' + fi + use_clib='c_import' + usedl='define' +fi + +# indented to miss config.sh + _ar="$ar" + +# To get into config.sh (should start at the beginning of line) +# or you can put it into config.over. +plibext="$plibext" +# plibext is not needed anymore. Just directly set $libperl. +libperl="libperl${plibext}" + +#libc="/emx/lib/st/c_import$lib_ext" +libc="$libemx/mt/$use_clib$lib_ext" + +if test -r "$libemx/c_alias$lib_ext"; then + libnames="$libemx/c_alias$lib_ext" +fi +# otherwise puts -lc ??? + +# [Maybe we should just remove c from $libswanted ?] + +# Test would pick up wrong rand, so we hardwire the value for random() +libs='-lsocket -lm -lbsd' +randbits=31 +archobjs="os2$obj_ext dl_os2$obj_ext" + +# Run files without extension with sh: +EXECSHELL=sh + +cccdlflags='-Zdll' +dlsrc='dl_dlopen.xs' +ld='gcc' + +#cppflags='-DDOSISH -DOS2=2 -DEMBED -I.' + +# for speedup: (some patches to ungetc are also needed): +# Note that without this guy tests 8 and 10 of io/tell.t fail, with it 11 fails + +stdstdunder=`echo "#include " | cpp | egrep -c "char +\* +_ptr"` +d_stdstdio='define' +d_stdiobase='define' +d_stdio_ptr_lval='define' +d_stdio_cnt_lval='define' + +if test "$stdstdunder" = 0; then + stdio_ptr='((fp)->ptr)' + stdio_cnt='((fp)->rcount)' + stdio_base='((fp)->buffer)' + stdio_bufsiz='((fp)->rcount + (fp)->ptr - (fp)->buffer)' + ccflags="$ccflags -DMYTTYNAME" + myttyname='define' +else + stdio_ptr='((fp)->_ptr)' + stdio_cnt='((fp)->_rcount)' + stdio_base='((fp)->_buffer)' + stdio_bufsiz='((fp)->_rcount + (fp)->_ptr - (fp)->_buffer)' +fi + +# to put into config.sh +myttyname="$myttyname" + +# To have manpages installed +nroff='nroff.cmd' +# above will be overwritten otherwise, indented to avoid config.sh + _nroff='nroff.cmd' + +# should be handled automatically by Configure now. +ln='cp' +# Will be rewritten otherwise, indented to not put in config.sh + _ln='cp' +lns='cp' + +nm_opt='-p' + +####### We define these functions ourselves + +d_getprior='define' +d_setprior='define' + +if [ "X$usethreads" = "X$define" ]; then + ccflags="-Zmt $ccflags" + cppflags="-Zmt $cppflags" # Do we really need to set this? + aout_ccflags="-DUSE_THREADS $aout_ccflags" + aout_cppflags="-DUSE_THREADS $aout_cppflags" + aout_lddlflags="-Zmt $aout_lddlflags" + aout_ldflags="-Zmt $aout_ldflags" +fi + +# The next two are commented. pdksh handles #!, extproc gives no path part. +# sharpbang='extproc ' +# shsharp='false' + +# Commented: +#startsh='extproc ksh\\n#! sh' + +# Copy pod: + +cp ./README.os2 ./pod/perlos2.pod + +# Now install the external modules. We are in the ./hints directory. + +cd ./os2/OS2 + +if ! test -d ../../ext/OS2 ; then + mkdir ../../ext/OS2 +fi + +cp -rfu * ../../ext/OS2/ + +# Install tests: + +for xxx in * ; do + if $test -d $xxx/t; then + cp -uf $xxx/t/*.t ../../t/lib + else + if $test -d $xxx; then + cd $xxx + for yyy in * ; do + if $test -d $yyy/t; then + cp -uf $yyy/t/*.t ../../t/lib + fi + done + cd .. + fi + fi +done + + +# Now go back +cd ../.. diff --git a/contrib/perl5/hints/os390.sh b/contrib/perl5/hints/os390.sh new file mode 100644 index 00000000000..1cf945dca39 --- /dev/null +++ b/contrib/perl5/hints/os390.sh @@ -0,0 +1,56 @@ +# hints/os390.sh +# +# OS/390 hints by David J. Fiander +# +# OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to: +# +# John Pfuntner +# Len Johnson +# Bud Huff +# Peter Prymmer +# Andy Dougherty +# Tim Bunce +# +# as well as the authors of the aix.sh file +# + +# To get ANSI C, we need to use c89, and ld doesn't exist +cc='c89' +ld='c89' +# c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again, +# YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant. +# -DEBCDIC should come from Configure. +ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC' +# Turning on optimization breaks perl +optimize='none' + +alignbytes=8 + +usemymalloc='n' + +so='a' + +# On OS/390, libc.a doesn't really hold anything at all, +# so running nm on it is pretty useless. +usenm='n' + +# Dynamic loading doesn't work on OS/390 quite yet +usedl='n' +dlext='none' + +# Configure can't figure this out for some reason +d_shmatprototype='define' + +usenm='false' +i_time='define' +i_systime='define' + +# (from aix.sh) +# uname -m output is too specific and not appropriate here +# osname should come from Configure +# +case "$archname" in +'') archname="$osname" ;; +esac + +archobjs=ebcdic.o diff --git a/contrib/perl5/hints/powerux.sh b/contrib/perl5/hints/powerux.sh new file mode 100644 index 00000000000..6d6bac02ed7 --- /dev/null +++ b/contrib/perl5/hints/powerux.sh @@ -0,0 +1,95 @@ +# Hints for the PowerUX operating system running on Concurrent (formerly +# Harris) NightHawk machines. Written by Tom.Horsley@mail.ccur.com +# +# Note: The OS is fated to change names again to PowerMAX OS, but this +# PowerUX file should still work (I wish marketing would make up their mind +# about the name :-). +# +# This config uses dynamic linking and the Concurrent C compiler. It has +# been tested on Power PC based 6000 series machines running PowerUX. + +# Internally at Concurrent, we use a source management tool which winds up +# giving us read-only copies of source trees that are mostly symbolic links. +# That upsets the perl build process when it tries to edit opcode.h and +# embed.h or touch perly.c or perly.h, so turn those files into "real" files +# when Configure runs. (If you already have "real" source files, this won't +# do anything). +# +if [ -x /usr/local/mkreal ] +then + for i in '.' '..' + do + for j in embed.h opcode.h perly.h perly.c + do + if [ -h $i/$j ] + then + ( cd $i ; /usr/local/mkreal $j ; chmod 666 $j ) + fi + done + done +fi + +# We DO NOT want -lmalloc or -lPW, we DO need -lgen to follow -lnsl, so +# fixup libswanted to reflect that desire (also need -lresolv if you want +# DNS name lookup to work, which seems desirable :-). +# +libswanted=`echo ' '$libswanted' ' | sed -e 's/ malloc / /' -e 's/ PW / /' -e 's/ nsl / nsl gen resolv /'` + +# We DO NOT want /usr/ucblib in glibpth +# +glibpth=`echo ' '$glibpth' ' | sed -e 's@ /usr/ucblib @ @'` + +# Yes, csh exists, but doesn't work worth beans, if perl tries to use it, +# the glob test fails, so just pretend it isn't there... +# +d_csh='undef' + +# Need to use Concurrent cc for most of these options to be meaningful (if you +# want to get this to work with gcc, you're on your own :-). Passing +# -Bexport to the linker when linking perl is important because it leaves +# the interpreter internal symbols visible to the shared libs that will be +# loaded on demand (and will try to reference those symbols). +# +cc='/bin/cc' +cccdlflags='-Zpic' +ccdlflags='-Zlink=dynamic -Wl,-Bexport' +lddlflags='-Zlink=so' + +# Configure sometime finds what it believes to be ndbm header files on the +# system and imagines that we have the NDBM library, but we really don't. +# There is something there that once resembled ndbm, but it is purely +# for internal use in some tool and has been hacked beyond recognition +# (or even function :-) +# +i_ndbm='undef' + +# There is a bug in memcmp (which I hope will be fixed soon) which sometimes +# fails to provide the correct compare status (it is data dependant), so just +# pretend there is no memcmp... +# +d_memcmp='undef' + +# Due to problems with dynamic linking (which I also hope will be fixed soon) +# you can't build a libperl.so, the core has to be in the static part of the +# perl executable. +# +useshrplib='false' + +# PowerMAX OS has support for a few different kinds of filesystems. The +# newer "xfs" filesystem does *not* report a reasonable value in the +# 'nlinks' field of stat() info for directories (in fact, it is always 1). +# Since xfs is the only filesystem which supports partitions bigger than +# 2gig and you can't hardly buy a disk that small anymore, xfs is coming in +# to greater and greater use, so we pretty much have no choice but to +# abandon all hope that number of links will mean anything. +# +dont_use_nlink=define + +# Misc other flags that might be able to change, but I know these work right. +# +d_suidsafe='define' +d_isascii='define' +d_mymalloc='undef' +usemymalloc='n' +ssizetype='ssize_t' +usevfork='false' diff --git a/contrib/perl5/hints/qnx.sh b/contrib/perl5/hints/qnx.sh new file mode 100644 index 00000000000..b53a33d7370 --- /dev/null +++ b/contrib/perl5/hints/qnx.sh @@ -0,0 +1,182 @@ +#---------------------------------------------------------------- +# QNX hints +# +# As of perl5.004_04, all tests pass under: +# QNX 4.23A +# Watcom 10.6 with Beta/970211.wcc.update.tar.F +# socket3r.lib Nov21 1996. +# +# As with many unix ports, this one depends on a few "standard" +# unix utilities which are not necessarily standard for QNX. +# +# /bin/sh This is used heavily by Configure and then by +# perl itself. QNX's version is fine, but Configure +# will choke on the 16-bit version, so if you are +# running QNX 4.22, link /bin/sh to /bin32/ksh +# ar This is the standard unix library builder. +# We use wlib. With Watcom 10.6, when wlib is +# linked as "ar", it behaves like ar and all is +# fine. Under 9.5, a cover is required. One is +# included in ../qnx +# nm This is used (optionally) by configure to list +# the contents of libraries. I will generate +# a cover function on the fly in the UU directory. +# cpp Configure and perl need a way to invoke a C +# preprocessor. I have created a simple cover +# for cc which does the right thing. Without this, +# Configure will create it's own wrapper which works, +# but it doesn't handle some of the command line arguments +# that perl will throw at it. +# make You really need GNU make to compile this. GNU make +# ships by default with QNX 4.23, but you can get it +# from quics for earlier versions. +#---------------------------------------------------------------- +# Outstanding Issues: +# lib/posix.t test fails on test 17 because acos(1) != 0. +# Resolved in 970211 Beta +# lib/io_udp.t test hangs because of a bug in getsockname(). +# Fixed in latest BETA socket3r.lib +# There is currently no support for dynamically linked +# libraries. +#---------------------------------------------------------------- +# These hints were submitted by: +# Norton T. Allen +# Harvard University Atmospheric Research Project +# allen@huarp.harvard.edu +# +# If you have suggestions or changes, please let me know. +#---------------------------------------------------------------- + +echo "" +echo "Some tests may fail. Please read the hints/qnx.sh file." +echo "" + +#---------------------------------------------------------------- +# At present, all QNX systems are equivalent architectures, +# so it is reasonable to call archname=x86-qnx rather than +# making an unnecessary distinction between AT-qnx and PCI-qnx, +# for example. +#---------------------------------------------------------------- +archname='x86-qnx' + +#---------------------------------------------------------------- +# QNX doesn't come with a csh and the ports of tcsh I've used +# don't work reliably: +#---------------------------------------------------------------- +csh='' +d_csh='undef' +full_csh='' + +#---------------------------------------------------------------- +# setuid scripts are secure under QNX. +# (Basically, the same race conditions apply, but assuming +# the scripts are located in a secure directory, the methods +# for exploiting the race condition are defeated because +# the loader expands the script name fully before executing +# the interpreter.) +#---------------------------------------------------------------- +d_suidsafe='define' + +#---------------------------------------------------------------- +# difftime is implemented as a preprocessor macro, so it doesn't show +# up in the libraries: +#---------------------------------------------------------------- +d_difftime='define' + +#---------------------------------------------------------------- +# strtod is in the math library, but we can't tell Configure +# about the math library or it will confuse the linker +#---------------------------------------------------------------- +d_strtod='define' + +lib_ext='3r.lib' +libc='/usr/lib/clib3r.lib' + +#---------------------------------------------------------------- +# ccflags: +# I like to turn the warnings up high, but a few common +# constructs make a lot of noise, so I turn those warnings off. +# A few still remain... +# +# HIDEMYMALLOC is necessary if using mymalloc since it is very +# tricky (though not impossible) to totally replace the watcom +# malloc/free set. +# +# unix.h is required as a general rule for unixy applications. +#---------------------------------------------------------------- +ccflags='-DHIDEMYMALLOC -mf -w4 -Wc,-wcd=202 -Wc,-wcd=203 -Wc,-wcd=302 -Wc,-fi=unix.h' + +#---------------------------------------------------------------- +# ldflags: +# If you want debugging information, you must specify -g on the +# link as well as the compile. If optimize != -g, you should +# remove this. +#---------------------------------------------------------------- +ldflags="-g -N1M" + +so='none' +selecttype='fd_set *' + +#---------------------------------------------------------------- +# Add -lunix to list of libs. This is needed mainly so the nm +# search will find funcs in the unix lib. Including unix.h should +# automatically include the library without -l. +#---------------------------------------------------------------- +libswanted="$libswanted unix" + +if [ -z "`which ar 2>/dev/null`" ]; then + cat <<-'EOF' >&4 + I don't see an 'ar', so I'm guessing you are running + Watcom 9.5 or earlier. You may want to install the ar + cover found in the qnx subdirectory of this distribution. + It might reasonably be placed in /usr/local/bin. + + EOF +fi +#---------------------------------------------------------------- +# Here is a nm script which fixes up wlib's output to look +# something like nm's, at least enough so that Configure can +# use it. +#---------------------------------------------------------------- +if [ -z "`which nm 2>/dev/null`" ]; then + cat <<-EOF + Creating a quick-and-dirty nm cover for Configure to use: + + EOF + cat >./UU/nm <<-'EOF' + #! /bin/sh + #__USAGE + #%C [ ...] + # Designed to mimic Unix's nm utility to list + # defined symbols in a library + unset WLIB + for i in $*; do wlib $i; done | + awk ' + /^ / { + for (i = 1; i <= NF; i++) { + sub("_$", "", $i) + print "000000 T " $i + } + }' + EOF + chmod +x ./UU/nm +fi + +cppstdin=`which cpp 2>/dev/null` +if [ -n "$cppstdin" ]; then + cat <<-EOF >&4 + I found a cpp at $cppstdin and will assume it is a good + thing to use. If this proves to be false, there is a + thin cover for cpp in the qnx subdirectory of this + distribution which you could move into your path. + EOF + cpprun="$cppstdin" +else + cat <<-EOF >&4 + + There is a cpp cover in the qnx subdirectory of this + distribution which works a little better than the + Configure default. You may wish to copy it to + /usr/local/bin or some other suitable location. + EOF +fi diff --git a/contrib/perl5/hints/sco.sh b/contrib/perl5/hints/sco.sh new file mode 100644 index 00000000000..cef1c0c9423 --- /dev/null +++ b/contrib/perl5/hints/sco.sh @@ -0,0 +1,140 @@ +# sco.sh +# Courtesy of Joel Rosi-Schwartz + +# Additional SCO version info from +# Peter Wolfe +# Last revised +# Fri Jul 19 14:54:25 EDT 1996 +# by Andy Dougherty + +# To use gcc, use sh Configure -Dcc=gcc +# But gcc will *not* do dynamic laoding on 3.2.5, +# for that use sh Configure -Dcc=icc +# See below for more details. + +# figure out what SCO version we are. The output of uname -X is +# something like: +# System = SCO_SV +# Node = xxxxx +# Release = 3.2v5.0.0 +# KernelID = 95/08/08 +# Machine = Pentium +# BusType = ISA +# Serial = xxxxx +# Users = 5-user +# OEM# = 0 +# Origin# = 1 +# NumCPU = 1 + +# Use /bin/uname (because Gnu may be first on the path and +# it does not support -X) to figure out what SCO version we are: +case `/bin/uname -X | egrep '^Release'` in +*3.2v4.*) scorls=3 ;; # I don't know why this is 3 instead of 4 :-) +*3.2v5.*) scorls=5 ;; +*) scorls=3 ;; # this probabaly shouldn't happen +esac + +# Try to use libintl.a since it has strcoll and strxfrm +libswanted="intl $libswanted" +# Try to use libdbm.nfs.a since it has dbmclose. +# +if test -f /usr/lib/libdbm.nfs.a ; then + libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'` +fi +set X $libswanted +shift +libswanted="$*" + +# We don't want Xenix cross-development libraries +glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'` +xlibpth='' + +case "$cc" in +*gcc*) ccflags="$ccflags -U M_XENIX" + optimize="$optimize -O2" + ;; +scocc) ;; + +# On SCO 3.2v5 both cc and icc can build dynamic load, but cc core +# dumps if optimised, so I am only setting this up for icc. +# It is possible that some 3.2v4.2 system have icc, I seem to +# recall it was available as a seperate product but I have no +# knowledge if it can do dynamic loading and if so how. +# Joel Rosi-Schwartz +icc)# Apparently, SCO's cc gives rather verbose warnings + # Set -w0 to turn them off. + case $scorls in + 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; + 5) ccflags="$ccflags -belf -w0 -U M_XENIX" + optimize="-O1" # -g -O1 will not work + # optimize="-O0" may be needed for pack test to pass. + lddlflags='-G -L/usr/local/lib' + ldflags=' -W l,-Bexport -L/usr/local/lib' + dlext='so' + dlsrc='dl_dlopen.xs' + usedl='define' + ;; + esac + ;; + +*) # Apparently, miniperl core dumps if -O is used. + case "$optimize" in + '') optimize=none ;; + esac + # Apparently, SCO's cc gives rather verbose warnings + # Set -w0 to turn them off. + case $scorls in + 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;; + 5) ccflags="$ccflags -w0 -U M_XENIX -DPERL_SCO5" ;; + esac + ;; +esac +i_varargs=undef + +# I have received one report that nm extraction doesn't work if you're +# using the scocc compiler. This system had the following 'myconfig' +# uname='xxx xxx 3.2 2 i386 ' +# cc='scocc', optimize='-O' +usenm='false' + +# If you want to use nm, you'll probably have to use nm -p. The +# following does that for you: +nm_opt='-p' + +# I have received one report that you can't include utime.h in +# pp_sys.c. Uncomment the following line if that happens to you: +# i_utime=undef + +# Apparently, some versions of SCO include both .so and .a libraries, +# but they don't mix as they do on other ELF systems. The upshot is +# that Configure finds -ldl (libdl.so) but 'ld' complains it can't +# find libdl.a. +# I don't know which systems have this feature, so I'll just remove +# -dl from libswanted for all SCO systems until someone can figure +# out how to get dynamic loading working on SCO. +# +# The output of uname -X on one such system was +# System = SCO_SV +# Node = xxxxx +# Release = 3.2v5.0.0 +# KernelID = 95/08/08 +# Machine = Pentium +# BusType = ISA +# Serial = xxxxx +# Users = 5-user +# OEM# = 0 +# Origin# = 1 +# NumCPU = 1 +# +# The 5.0.0 on the Release= line is probably the thing to watch. +# Andy Dougherty +# Thu Feb 1 15:06:56 EST 1996 +libswanted=`echo " $libswanted " | sed -e 's/ dl / /'` +set X $libswanted +shift +libswanted="$*" + +# Perl 5.003_05 and later try to include both and +# in pp_sys.c, but that fails due to a redefinition of struct timeval. +# This will generate a WHOA THERE. Accept the default. +i_sysselct=$undef diff --git a/contrib/perl5/hints/sco_2_3_0.sh b/contrib/perl5/hints/sco_2_3_0.sh new file mode 100644 index 00000000000..146363ab3d5 --- /dev/null +++ b/contrib/perl5/hints/sco_2_3_0.sh @@ -0,0 +1,2 @@ +yacc='/usr/bin/yacc -Sm25000' +i_dirent=undef diff --git a/contrib/perl5/hints/sco_2_3_1.sh b/contrib/perl5/hints/sco_2_3_1.sh new file mode 100644 index 00000000000..146363ab3d5 --- /dev/null +++ b/contrib/perl5/hints/sco_2_3_1.sh @@ -0,0 +1,2 @@ +yacc='/usr/bin/yacc -Sm25000' +i_dirent=undef diff --git a/contrib/perl5/hints/sco_2_3_2.sh b/contrib/perl5/hints/sco_2_3_2.sh new file mode 100644 index 00000000000..e113a4ec65e --- /dev/null +++ b/contrib/perl5/hints/sco_2_3_2.sh @@ -0,0 +1,2 @@ +yacc='/usr/bin/yacc -Sm25000' +libswanted=`echo " $libswanted "| sed 's/ x / /'` diff --git a/contrib/perl5/hints/sco_2_3_3.sh b/contrib/perl5/hints/sco_2_3_3.sh new file mode 100644 index 00000000000..6d398fccf2e --- /dev/null +++ b/contrib/perl5/hints/sco_2_3_3.sh @@ -0,0 +1,3 @@ +yacc='/usr/bin/yacc -Sm25000' +echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" >&4 +echo "macro definition in /usr/include/string.h. If so, delete the semicolon." >&4 diff --git a/contrib/perl5/hints/sco_2_3_4.sh b/contrib/perl5/hints/sco_2_3_4.sh new file mode 100644 index 00000000000..34bcadae5f5 --- /dev/null +++ b/contrib/perl5/hints/sco_2_3_4.sh @@ -0,0 +1,5 @@ +yacc='/usr/bin/yacc -Sm25000' +ccflags="$ccflags -UM_I86" +usemymalloc='y' +echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" >&4 +echo "macro definition in /usr/include/string.h. If so, delete the semicolon." >&4 diff --git a/contrib/perl5/hints/solaris_2.sh b/contrib/perl5/hints/solaris_2.sh new file mode 100644 index 00000000000..856f80103f9 --- /dev/null +++ b/contrib/perl5/hints/solaris_2.sh @@ -0,0 +1,441 @@ +# hints/solaris_2.sh +# Last modified: Wed May 27 13:04:45 EDT 1998 +# Andy Dougherty +# Based on input from lots of folks, especially +# Dean Roehrich + +# If perl fails tests that involve dynamic loading of extensions, and +# you are using gcc, be sure that you are NOT using GNU as and ld. One +# way to do that is to invoke Configure with +# +# sh Configure -Dcc='gcc -B/usr/ccs/bin/' +# + +# See man vfork. +usevfork=false + +d_suidsafe=define + +# Avoid all libraries in /usr/ucblib. +set `echo $glibpth | sed -e 's@/usr/ucblib@@'` +glibpth="$*" + +# Remove bad libraries. -lucb contains incompatible routines. +# -lld doesn't do anything useful. +# -lmalloc can cause a problem with GNU CC & Solaris. Specifically, +# libmalloc.a may allocate memory that is only 4 byte aligned, but +# GNU CC on the Sparc assumes that doubles are 8 byte aligned. +# Thanks to Hallvard B. Furuseth +set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ malloc @ @' -e 's@ ucb @ @'` +libswanted="$*" + +# Look for architecture name. We want to suggest a useful default. +case "$archname" in +'') + if test -f /usr/bin/arch; then + archname=`/usr/bin/arch` + archname="${archname}-${osname}" + elif test -f /usr/ucb/arch; then + archname=`/usr/ucb/arch` + archname="${archname}-${osname}" + fi + ;; +esac + +###################################################### +# General sanity testing. See below for excerpts from the Solaris FAQ. + +# From roehrich@ironwood-fddi.cray.com Wed Sep 27 12:51:46 1995 +# Date: Thu, 7 Sep 1995 16:31:40 -0500 +# From: Dean Roehrich +# To: perl5-porters@africa.nicoh.com +# Subject: Re: On perl5/solaris/gcc + +# Here's another draft of the perl5/solaris/gcc sanity-checker. + +case `type ${cc:-cc}` in +*/usr/ucb/cc*) cat <&4 + +NOTE: Some people have reported problems with /usr/ucb/cc. +If you have difficulties, please make sure the directory +containing your C compiler is before /usr/ucb in your PATH. + +END +;; +esac + + +# Check that /dev/fd is mounted. If it is not mounted, let the +# user know that suid scripts may not work. +/usr/bin/df /dev/fd 2>&1 > /dev/null +case $? in +0) ;; +*) + cat <&4 + +NOTE: Your system does not have /dev/fd mounted. If you want to +be able to use set-uid scripts you must ask your system administrator +to mount /dev/fd. + +END + ;; +esac + + +# See if libucb can be found in /usr/lib. If it is, warn the user +# that this may cause problems while building Perl extensions. +/usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1 +case $? in +0) + cat <&4 + +NOTE: libucb has been found in /usr/lib. libucb should reside in +/usr/ucblib. You may have trouble while building Perl extensions. + +END +;; +esac + +# Use shell built-in 'type' command instead of /usr/bin/which to +# avoid possible csh start-up problems and also to use the same shell +# we'll be using to Configure and make perl. +# The path name is the last field in the output, but the type command +# has an annoying array of possible outputs, e.g.: +# make is hashed (/opt/gnu/bin/make) +# cc is /usr/ucb/cc +# foo not found +# use a command like type make | awk '{print $NF}' | sed 's/[()]//g' + +# See if make(1) is GNU make(1). +# If it is, make sure the setgid bit is not set. +make -v > make.vers 2>&1 +if grep GNU make.vers > /dev/null 2>&1; then + tmp=`type make | awk '{print $NF}' | sed 's/[()]//g'` + case "`/usr/bin/ls -lL $tmp`" in + ??????s*) + cat <&2 + +NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id +bit set. You must either rearrange your PATH to put /usr/ccs/bin before the +GNU utilities or you must ask your system administrator to disable the +set-group-id bit on GNU make. + +END + ;; + esac +fi +rm -f make.vers + +# XXX EXPERIMENTAL A.D. 2/27/1998 +# XXX This script UU/cc.cbu will get 'called-back' by Configure after it +# XXX has prompted the user for the C compiler to use. +cat > UU/cc.cbu <<'EOSH' +# If the C compiler is gcc: +# - check the fixed-includes +# - check as(1) and ld(1), they should not be GNU +# (GNU as and ld 2.8.1 and later are reportedly ok, however.) +# If the C compiler is not gcc: +# - check as(1) and ld(1), they should not be GNU +# (GNU as and ld 2.8.1 and later are reportedly ok, however.) +# +# Watch out in case they have not set $cc. + +# Get gcc to share its secrets. +echo 'main() { return 0; }' > try.c + # Indent to avoid propagation to config.sh + verbose=`${cc:-cc} -v -o try try.c 2>&1` + +if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then + # + # Using gcc. + # + #echo Using gcc + + tmp=`echo "$verbose" | grep '^Reading' | + awk '{print $NF}' | sed 's/specs$/include/'` + + # Determine if the fixed-includes look like they'll work. + # Doesn't work anymore for gcc-2.7.2. + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + if echo "$verbose" | grep ' /usr/ccs/bin/as ' >/dev/null 2>&1; then + : + else + cat <&2 + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +I'm arranging to use /usr/ccs/bin/as by including -B/usr/ccs/bin/ +in your ${cc:-cc} command. (Note that the trailing "/" is required.) + +END + cc="${cc:-cc} -B/usr/ccs/bin/" + fi + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + # Recompute $verbose since we may have just changed $cc. + verbose=`${cc:-cc} -v -o try try.c 2>&1 | grep ld 2>&1` + if echo "$verbose" | grep ' /usr/ccs/bin/ld ' >/dev/null 2>&1; then + : + else + # It's not /usr/ccs/bin/ld - but it might be egcs's ld wrapper, + # which calls /usr/ccs/bin/ld in turn. Passing -V to it will + # make it show its true colors. + + myld=`echo $verbose| grep ld | awk '/\/ld/ {print $1}'` + # This assumes that gcc's output will not change, and that + # /full/path/to/ld will be the first word of the output. + + # all Solaris versions of ld I've seen contain the magic + # string used in the grep below. + if $myld -V 2>&1 | grep "ld: Software Generation Utilities" >/dev/null 2>&1; then + cat <&2 + +Aha. You're using egcs and /usr/ccs/bin/ld. + +END + + else + cat <&2 + +NOTE: You are using GNU ld(1). GNU ld(1) will not build Perl. +I'm arranging to use /usr/ccs/bin/ld by including -B/usr/ccs/bin/ +in your ${cc:-cc} command. (Note that the trailing "/" is required.) + +END + cc="${cc:-cc} -B/usr/ccs/bin/" + fi + fi + +else + # + # Not using gcc. + # + #echo Not using gcc + + # See if as(1) is GNU as(1). GNU as(1) won't work for this job. + case `as --version < /dev/null 2>&1` in + *GNU*) + cat <&2 + +NOTE: You are using GNU as(1). GNU as(1) will not build Perl. +You must arrange to use /usr/ccs/bin/as, perhaps by adding /usr/ccs/bin +to the beginning of your PATH. + +END + ;; + esac + + # See if ld(1) is GNU ld(1). GNU ld(1) won't work for this job. + # ld --version doesn't properly report itself as a GNU tool, + # as of ld version 2.6, so we need to be more strict. TWP 9/5/96 + gnu_ld=false + case `ld --version < /dev/null 2>&1` in + *GNU*|ld\ version\ 2*) + gnu_ld=true ;; + *) ;; + esac + if $gnu_ld ; then : + else + # Try to guess from path + case `type ld | awk '{print $NF}'` in + *gnu*|*GNU*|*FSF*) + gnu_ld=true ;; + esac + fi + if $gnu_ld ; then + cat <&2 + +NOTE: You are apparently using GNU ld(1). GNU ld(1) will not build Perl. +You must arrange to use /usr/ccs/bin/ld, perhaps by adding /usr/ccs/bin +to the beginning of your PATH. + +END + fi + +fi + +# as --version or ld --version might dump core. +rm -f try try.c +rm -f core + +# XXX +EOSH + +if [ "X$usethreads" = "X$define" ]; then + ccflags="-D_REENTRANT $ccflags" + # -lpthread needs to come before -lc but after other libraries such + # as -lgdbm and such like. We assume here that -lc is present in + # libswanted. If that fails to be true in future, then this can be + # changed to add pthread to the very end of libswanted. + # sched_yield is in -lposix4 + set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'` + shift + libswanted="$*" + + # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp() + # when linked with the threads library, such that whatever positive value + # you pass to siglongjmp(), sigsetjmp() returns 1. + # Thanks to Simon Parsons for this report. + # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by + # siglongjmp in a MT program". As of 19980622, there is no patch + # available. + cat >try.c <<'EOM' + /* Test for sig(set|long)jmp bug. */ + #include + + main() + { + sigjmp_buf env; + int ret; + + ret = sigsetjmp(env, 1); + if (ret) { return ret == 2; } + siglongjmp(env, 2); + } +EOM + if test "`arch`" = i86pc -a "$osvers" = 2.6 \ + && ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then + d_sigsetjmp=$undef + cat << 'EOM' >&2 + +You will see a *** WHOA THERE!!! *** message from Configure for +d_sigsetjmp. Keep the recommended value. See hints/solaris_2.sh +for more information. + +EOM + fi +fi + +# This is just a trick to include some useful notes. +cat > /dev/null <<'End_of_Solaris_Notes' + +Here are some notes kindly contributed by Dean Roehrich. + +----- +Generic notes about building Perl5 on Solaris: +- Use /usr/ccs/bin/make. +- If you use GNU make, remove its setgid bit. +- Remove all instances of *ucb* from your path. +- Make sure libucb is not in /usr/lib (it should be in /usr/ucblib). +- Do not use GNU as or GNU ld, or any of GNU binutils or GNU libc. +- Do not use /usr/ucb/cc. +- Do not change Configure's default answers, except for the path names. +- Do not use -lmalloc. +- Do not build on SunOS 4 and expect it to work properly on SunOS 5. +- /dev/fd must be mounted if you want set-uid scripts to work. + + +Here are the gcc-related questions and answers from the Solaris 2 FAQ. Note +the themes: + - run fixincludes + - run fixincludes correctly + - don't use GNU as or GNU ld + +Question 5.7 covers the __builtin_va_alist problem people are always seeing. +Question 6.1.3 covers the GNU as and GNU ld issues which are always biting +people. +Question 6.9 is for those who are still trying to compile Perl4. + +The latest Solaris 2 FAQ can be found in the following locations: + rtfm.mit.edu:/pub/usenet-by-group/comp.sys.sun.admin + ftp.fwi.uva.nl:/pub/solaris + +Perl5 comes with a script in the top-level directory called "myconfig" which +will print a summary of the configuration in your config.sh. My summary for +Solaris 2.4 and gcc 2.6.3 follows. I have also built with gcc 2.7.0 and the +results are identical. This configuration was generated with Configure's -d +option (take all defaults, don't bother prompting me). All tests pass for +Perl5.001, patch.1m. + +Summary of my perl5 (patchlevel 1) configuration: + Platform: + osname=solaris, osver=2.4, archname=sun4-solaris + uname='sunos poplar 5.4 generic_101945-27 sun4d sparc ' + hint=recommended + Compiler: + cc='gcc', optimize='-O', ld='gcc' + cppflags='' + ccflags ='' + ldflags ='' + stdchar='unsigned char', d_stdstdio=define, usevfork=false + voidflags=15, castflags=0, d_casti32=define, d_castneg=define + intsize=4, alignbytes=8, usemymalloc=y, randbits=15 + Libraries: + so=so + libpth=/lib /usr/lib /usr/ccs/lib /usr/local/lib + libs=-lsocket -lnsl -ldl -lm -lc -lcrypt + libc=/usr/lib/libc.so + Dynamic Linking: + dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef + cccdlflags='-fpic', ccdlflags=' ', lddlflags='-G' + + +Dean +roehrich@cray.com +9/7/95 + +----------- + +From: Casper.Dik@Holland.Sun.COM (Casper H.S. Dik - Network Security Engineer) +Subject: Solaris 2 Frequently Asked Questions (FAQ) 1.48 +Date: 25 Jul 1995 12:20:18 GMT + +5.7) Why do I get __builtin_va_alist or __builtin_va_arg_incr undefined? + + You're using gcc without properly installing the gcc fixed + include files. Or you ran fixincludes after installing gcc + w/o moving the gcc supplied varargs.h and stdarg.h files + out of the way and moving them back again later. This often + happens when people install gcc from a binary distribution. + If there's a tmp directory in gcc's include directory, fixincludes + didn't complete. You should have run "just-fixinc" instead. + + Another possible cause is using ``gcc -I/usr/include.'' + +6.1) Where is the C compiler or where can I get one? + + [...] + + 3) Gcc. + + Gcc is available from the GNU archives in source and binary + form. Look in a directory called sparc-sun-solaris2 for + binaries. You need gcc 2.3.3 or later. You should not use + GNU as or GNU ld. Make sure you run just-fixinc if you use + a binary distribution. Better is to get a binary version and + use that to bootstrap gcc from source. + + [...] + + When you install gcc, don't make the mistake of installing + GNU binutils or GNU libc, they are not as capable as their + counterparts you get with Solaris 2.x. + +6.9) I can't get perl 4.036 to compile or run. + + Run Configure, and use the solaris_2_0 hints, *don't* use + the solaris_2_1 hints and don't use the config.sh you may + already have. First you must make sure Configure and make + don't find /usr/ucb/cc. (It must use gcc or the native C + compiler: /opt/SUNWspro/bin/cc) + + Some questions need a special answer. + + Are your system (especially dbm) libraries compiled with gcc? [y] y + + yes: gcc 2.3.3 or later uses the standard calling + conventions, same as Sun's C. + + Any additional cc flags? [ -traditional -Dvolatile=__volatile__ + -I/usr/ucbinclude] -traditional -Dvolatile=__volatile__ + Remove /usr/ucbinclude. + + Any additional libraries? [-lsocket -lnsl -ldbm -lmalloc -lm + -lucb] -lsocket -lnsl -lm + + Don't include -ldbm, -lmalloc and -lucb. + + Perl 5 compiled out of the box. + +End_of_Solaris_Notes + diff --git a/contrib/perl5/hints/stellar.sh b/contrib/perl5/hints/stellar.sh new file mode 100644 index 00000000000..23e15e90912 --- /dev/null +++ b/contrib/perl5/hints/stellar.sh @@ -0,0 +1,2 @@ +optimize="-O0" +ccflags="$ccflags -nw" diff --git a/contrib/perl5/hints/sunos_4_0.sh b/contrib/perl5/hints/sunos_4_0.sh new file mode 100644 index 00000000000..56a87bf5be3 --- /dev/null +++ b/contrib/perl5/hints/sunos_4_0.sh @@ -0,0 +1,2 @@ +ccflags="$ccflags -DFPUTS_BOTCH" +i_unistd=$undef diff --git a/contrib/perl5/hints/sunos_4_1.sh b/contrib/perl5/hints/sunos_4_1.sh new file mode 100644 index 00000000000..4585d793d76 --- /dev/null +++ b/contrib/perl5/hints/sunos_4_1.sh @@ -0,0 +1,72 @@ +# hints/sunos_4_1.sh +# Last modified: Wed May 27 11:00:02 EDT 1998 +# Andy Dougherty + +case "$cc" in +*gcc*) usevfork=false + # GNU as and GNU ld might not work. See the INSTALL file. + ;; +*) usevfork=true ;; +esac + +# Configure will issue a WHOA warning. The problem is that +# Configure finds getzname, not tzname. If you're in the System V +# environment, you can set d_tzname='define' since tzname[] is +# available in the System V environment. +d_tzname='undef' + +# Configure will issue a WHOA warning. The problem is that unistd.h +# contains incorrect prototypes for some functions in the usual +# BSD-ish environment. In particular, it has +# extern int getgroups(/* int gidsetsize, gid_t grouplist[] */); +# but groupslist[] ought to be of type int, not gid_t. +# This is only really a problem for perl if the +# user is using gcc, and not running in the SysV environment. +# The gcc fix-includes script exposes those incorrect prototypes. +# There may be other examples as well. Volunteers are welcome to +# track them all down :-). In the meantime, we'll just skip unistd.h +# for SunOS in most of the code. (However, see ext/POSIX/hints/sunos_4.pl.) +i_unistd='undef' + +cat << 'EOM' >&4 + +You will probably see *** WHOA THERE!!! *** messages from Configure for +d_tzname and i_unistd. Keep the recommended values. See +hints/sunos_4_1.sh for more information. +EOM + +# The correct setting of groupstype depends on which version of the C +# library is used. If you are in the 'System V environment' +# (i.e. you have /usr/5bin ahead of /usr/bin in your PATH), and +# you use Sun's cc compiler, then you'll pick up /usr/5bin/cc, which +# links against the C library in /usr/5lib. This library has +# groupstype='gid_t'. +# If you are in the normal BSDish environment, then you'll pick up +# /usr/ucb/cc, which links against the C library in /usr/lib. That +# library has groupstype='int'. +# +# If you are using gcc, it links against the C library in /usr/lib +# independent of whether or not you are in the 'System V environment'. +# If you want to use the System V libraries, then you need to +# manually set groupstype='gid_t' and add explicit references to +# /usr/5lib when Configure prompts you for where to look for libraries. +# +# Check if user is in a bsd or system 5 type environment +if cat -b /dev/null 2>/dev/null +then # bsd + groupstype='int' +else # sys5 + case "$cc" in + *gcc*) groupstype='int';; # gcc doesn't do anything special + *) groupstype='gid_t';; # /usr/5bin/cc pulls in /usr/5lib/ stuff. + esac +fi + +# If you get the message "unresolved symbol '__lib_version' " while +# linking, your system probably has the optional 'acc' compiler (and +# libraries) installed, but you are using the bundled 'cc' compiler with +# the unbundled libraries. The solution is either to use 'acc' and the +# unbundled libraries (specifically /lib/libm.a), or 'cc' and the bundled +# library. +# +# Thanks to William Setzer for this info. diff --git a/contrib/perl5/hints/svr4.sh b/contrib/perl5/hints/svr4.sh new file mode 100644 index 00000000000..cf6906dac78 --- /dev/null +++ b/contrib/perl5/hints/svr4.sh @@ -0,0 +1,153 @@ +# svr4 hints, System V Release 4.x +# Last modified 1996/10/25 by Tye McQueen, tye@metronet.com +# Merged 1998/04/23 with perl5.004_04 distribution by +# Andy Dougherty + +# Use Configure -Dcc=gcc to use gcc. +case "$cc" in +'') cc='/bin/cc' + test -f $cc || cc='/usr/ccs/bin/cc' + ;; +esac + +# We include support for using libraries in /usr/ucblib, but the setting +# of libswanted excludes some libraries found there. If you run into +# problems, you may have to remove "ucb" from libswanted. Just delete +# the comment '#' from the sed command below. +ldflags='-L/usr/ccs/lib -L/usr/ucblib' +ccflags='-I/usr/include -I/usr/ucbinclude' +# Don't use problematic libraries: +libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'` +# libmalloc.a - Probably using Perl's malloc() anyway. +# libucb.a - Remove it if you have problems ld'ing. We include it because +# it is needed for ODBM_File and NDBM_File extensions. + +if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: + d_Gconvert='gcvt((x),(n),(b))' # Try gcvt() before gconvert(). + # Use the "native" counterparts, not the BSD emulation stuff: + d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef' + d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' + d_setlinebuf='undef' + # d_setregid='undef' d_setreuid='undef' # ??? +fi + +# UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and +# /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it +# appears that /usr/ccs/lib/libc.so contains more symbols: +# +# Try the following if you want to use nm-extraction. We'll just +# skip the nm-extraction phase, since searching for all the different +# library versions will be hard to keep up-to-date. +# +# if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \ +# -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then +# if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then +# if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null || +# nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then +# : +# else +# libc=/usr/ccs/lib/libc.so +# fi +# fi +# fi +# +# Don't bother with nm. Just compile & link a small C program. +case "$usenm" in +'') usenm=false;; +esac + +# Broken C-Shell tests (Thanks to Tye McQueen): +# The OS-specific checks may be obsoleted by the this generic test. + sh_cnt=`sh -c 'echo /*' | wc -c` + csh_cnt=`csh -f -c 'glob /*' 2>/dev/null | wc -c` + csh_cnt=`expr 1 + $csh_cnt` +if [ "$sh_cnt" -ne "$csh_cnt" ]; then + echo "You're csh has a broken 'glob', disabling..." >&2 + d_csh='undef' +fi + +# Unixware-specific problems. The undocumented -X argument to uname +# is probably a reasonable way of detecting UnixWare. +# UnixWare has a broken csh. (This might already be detected above). +# In Unixware 2.1.1 the fields in FILE* got renamed! +# Unixware 1.1 can't cast large floats to 32-bit ints. +# Configure can't detect memcpy or memset on Unixware 2 or 7 +# +# Leave leading tabs on the next two lines so Configure doesn't +# propagate these variables to config.sh + uw_ver=`uname -v` + uw_isuw=`uname -X 2>&1 | grep Release` + +if [ "$uw_isuw" = "Release = 4.2" ]; then + case $uw_ver in + 1.1) + d_casti32='undef' + ;; + esac +fi +if [ "$uw_isuw" = "Release = 4.2MP" ]; then + case $uw_ver in + 2.1) + d_csh='undef' + d_memcpy='define' + d_memset='define' + ;; + 2.1.*) + d_csh='undef' + d_memcpy='define' + d_memset='define' + stdio_cnt='((fp)->__cnt)' + d_stdio_cnt_lval='define' + stdio_ptr='((fp)->__ptr)' + d_stdio_ptr_lval='define' + ;; + esac +fi +if [ "$uw_isuw" = "Release = 5" ]; then + case $uw_ver in + 7) + d_csh='undef' + d_memcpy='define' + d_memset='define' + stdio_cnt='((fp)->__cnt)' + d_stdio_cnt_lval='define' + stdio_ptr='((fp)->__ptr)' + d_stdio_ptr_lval='define' + ;; + esac +fi +# End of Unixware-specific tests. + +# DDE SMES Supermax Enterprise Server +case "`uname -sm`" in +"UNIX_SV SMES") + # the *grent functions are in libgen. + libswanted="$libswanted gen" + # csh is broken (also) in SMES + # This may already be detected by the generic test above. + d_csh='undef' + case "$cc" in + *gcc*) ;; + *) # for cc we need -K PIC (not -K pic) + cccdlflags="$cccdlflags -K PIC" + ;; + esac + ;; +esac + +# Configure may fail to find lstat() since it's a static/inline function +# in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other +# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) +d_lstat=define + +d_suidsafe='define' # "./Configure -d" can't figure this out easilly + +cat <<'EOM' >&4 + +If you wish to use dynamic linking, you must use + LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH +or + setenv LD_LIBRARY_PATH `pwd` +before running make. + +EOM diff --git a/contrib/perl5/hints/ti1500.sh b/contrib/perl5/hints/ti1500.sh new file mode 100644 index 00000000000..69482d86802 --- /dev/null +++ b/contrib/perl5/hints/ti1500.sh @@ -0,0 +1 @@ +usemymalloc='n' diff --git a/contrib/perl5/hints/titanos.sh b/contrib/perl5/hints/titanos.sh new file mode 100644 index 00000000000..cea99f82a3a --- /dev/null +++ b/contrib/perl5/hints/titanos.sh @@ -0,0 +1,39 @@ +# Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines. +# Created by: JT McDuffie (jt@kpc.com) 26 DEC 1991 +# p5ed by: Jarkko Hietaniemi Aug 27 1994 +# NOTE: You should run Configure with tcsh (yes, tcsh). +# Comments by Andy Dougherty 28 Mar 1995 +alignbytes="8" +byteorder="4321" +castflags='0' +gidtype='ushort' +groupstype='unsigned short' +intsize='4' +usenm='true' +nm_opt='-eh' +malloctype='void *' +models='none' +ccflags="$ccflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" +cppflags="$cppflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" +stdchar='unsigned char' +# +# Apparently there are some harmful libs in Configure's $libswanted. +# Perl5.000 had: libs='-lnsl -ldbm -lPW -lmalloc -lm' +# Unfortunately, this line prevents users from including things like +# -lgdbm and -ldb, which they may or may not have or want. +# We should probably fiddle with libswanted instead of libs. +# And even there, we should only bother to delete harmful libraries. +# However, I don't know what they are or why they should be deleted, +# so this will have to do for now. --AD 28 Mar 1995 +libswanted='sfio nsl dbm gdbm db PW malloc m' +# +# Extensions: This system can not compile POSIX. We'll let Configure +# figure out the others. +useposix='n' +# +uidtype='ushort' +voidflags='7' +inclwanted='/usr/include /usr/include/net' +# Setting libpth shouldn't be needed any more. +# libpth='/usr/lib /usr/local/lib /lib' +pth='. /bin /usr/bin /usr/ucb /usr/local/bin /usr/X11/bin /usr/lbin /etc /usr/lib' diff --git a/contrib/perl5/hints/ultrix_4.sh b/contrib/perl5/hints/ultrix_4.sh new file mode 100644 index 00000000000..d8d2063b22d --- /dev/null +++ b/contrib/perl5/hints/ultrix_4.sh @@ -0,0 +1,66 @@ +# hints/ultrix_4.sh +# Last updated by Andy Dougherty +# Fri Feb 10 10:04:51 EST 1995 +# +# Use Configure -Dcc=gcc to use gcc. +# +# This used to use -g, but that pulls in -DDEBUGGING by default. +case "$optimize" in +'') + # recent versions have a working compiler. + case "$osvers" in + *4.[45]*) optimize='-O2' ;; + *) optimize='none' ;; + esac + ;; +esac + +# Some users have reported Configure runs *much* faster if you +# replace all occurences of /bin/sh by /bin/sh5 +# Something like: +# sed 's!/bin/sh!/bin/sh5!g' Configure > Configure.sh5 +# Then run "sh5 Configure.sh5 [your options]" + +case "$myuname" in +*risc*) cat <&4 +Note that there is a bug in some versions of NFS on the DECStation that +may cause utime() to work incorrectly. If so, regression test io/fs +may fail if run under NFS. Ignore the failure. +EOF +esac + +# Compiler flags that depend on osversion: +case "$cc" in +*gcc*) ;; +*) + case "$osvers" in + *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" ;; + *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" + # Prototypes sometimes cause compilation errors in 4.2. + prototype=undef + case "$myuname" in + *risc*) d_volatile=undef ;; + esac + ;; + *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3200" ;; + *) ccflags="$ccflags -std -Olimit 3200" ;; + esac + ;; +esac + +# Other settings that depend on $osvers: +case "$osvers" in +*4.1*) ;; +*4.2*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; +*4.3*) ;; +*) ranlib='ranlib' ;; +esac + +# Settings that don't depend on $osvers: + +util_cflags='ccflags="$ccflags -DLOCALE_ENVIRON_REQUIRED"' +groupstype='int' +# This will cause a WHOA THERE warning, but it's accurate. The +# configure test should be beefed up to try using the field when +# it can't find any of the standardly-named fields. +d_dirnamlen='define' diff --git a/contrib/perl5/hints/umips.sh b/contrib/perl5/hints/umips.sh new file mode 100644 index 00000000000..17d5ff46239 --- /dev/null +++ b/contrib/perl5/hints/umips.sh @@ -0,0 +1,39 @@ +# hints/umips.sh +# +# Mips R3030 / Bruker AspectSation running RISC/os (UMIPS) 4.52 +# compiling with gcc 2.7.2 +# +# Created Sat Aug 17 00:17:15 MET DST 1996 +# by Guenter Schmidt +# +# uname -a output looks like this: +# xxx xxx 4_52 umips mips + +# Speculative notes on getting cc to work added by +# Andy Dougherty +# Tue Aug 20 21:51:49 EDT 1996 + +# Recommend the GNU C Compiler +case "$cc" in +'') echo 'gcc 2.7.2 (or later) is recommended. Use Configure -Dcc=gcc' >&4 + # The test with the native compiler not succeed: + # `sh cflags libperl.a miniperlmain.o` miniperlmain.c + # CCCMD = cc -c -I/usr/local/include -I/usr/include/bsd -DLANGUAGE_C -O + # ccom: Error: ./mg.h, line 12: redeclaration of formal parameter, sv + # int (*svt_set) (SV *sv, MAGIC* mg); + # ------------------------------------------^ + # ccom: Error: ./mg.h, line 12: redeclaration of formal parameter, mg + # This is probably a result of incomplete prototype support. + prototype=undef + ;; +esac + +# POSIX support in RiscOS is not useable +useposix='false' + +# Will give WHOA message, but the prototype are defined in the GCC inc dirs +case "$cc" in +*gcc*) d_shmatprototype='define' ;; +esac + +glibpth="$glibpth /usr/lib/cmplrs/cc" diff --git a/contrib/perl5/hints/unicos.sh b/contrib/perl5/hints/unicos.sh new file mode 100644 index 00000000000..ab0203bec61 --- /dev/null +++ b/contrib/perl5/hints/unicos.sh @@ -0,0 +1,16 @@ +case `uname -r` in +6.1*) shellflags="-m+65536" ;; +esac +case "$optimize" in +'') optimize="-O1" ;; +esac +d_setregid='undef' +d_setreuid='undef' +case "$usemymalloc" in +'') # The perl malloc.c SHOULD work says Ilya. + # But for the time being (5.004_68), alas, it doesn't. + # usemymalloc='y' + # ccflags="$ccflags -DNO_RCHECK" + usemymalloc='n' + ;; +esac diff --git a/contrib/perl5/hints/unicosmk.sh b/contrib/perl5/hints/unicosmk.sh new file mode 100644 index 00000000000..f0b63cb0ebe --- /dev/null +++ b/contrib/perl5/hints/unicosmk.sh @@ -0,0 +1,10 @@ +case "$optimize" in +'') optimize="-O1" ;; +esac +d_setregid='undef' +d_setreuid='undef' +case "$usemymalloc" in +'') usemymalloc='y' + ccflags="$ccflags -DNO_RCHECK" + ;; +esac diff --git a/contrib/perl5/hints/unisysdynix.sh b/contrib/perl5/hints/unisysdynix.sh new file mode 100644 index 00000000000..4251ba8d471 --- /dev/null +++ b/contrib/perl5/hints/unisysdynix.sh @@ -0,0 +1 @@ +d_waitpid=undef diff --git a/contrib/perl5/hints/utekv.sh b/contrib/perl5/hints/utekv.sh new file mode 100644 index 00000000000..95a31fdedfe --- /dev/null +++ b/contrib/perl5/hints/utekv.sh @@ -0,0 +1,12 @@ +# XD88/10 UTekV hints by Kaveh Ghazi (ghazi@caip.rutgers.edu) 2/11/92 +# Modified by Andy Dougherty 4 Oct. 1994 + +# The -X18 is only if you are using the Greenhills compiler. +ccflags="$ccflags -X18" + +usemymalloc='y' + +echo " " >&4 +echo "NOTE: You may have to take out makefile dependencies on the files in" >&4 +echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail. A" >&4 +echo "simple 'grep -v /usr/include/ makefile' should suffice." >&4 diff --git a/contrib/perl5/hints/uts.sh b/contrib/perl5/hints/uts.sh new file mode 100644 index 00000000000..9ad72d7e987 --- /dev/null +++ b/contrib/perl5/hints/uts.sh @@ -0,0 +1,2 @@ +ccflags="$ccflags -DCRIPPLED_CC" +d_lstat=define diff --git a/contrib/perl5/hv.c b/contrib/perl5/hv.c new file mode 100644 index 00000000000..40bb9b8e73d --- /dev/null +++ b/contrib/perl5/hv.c @@ -0,0 +1,1226 @@ +/* hv.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * "I sit beside the fire and think of all that I have seen." --Bilbo + */ + +#include "EXTERN.h" +#include "perl.h" + +static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store)); +#ifndef PERL_OBJECT +static void hsplit _((HV *hv)); +static void hfreeentries _((HV *hv)); +static HE* more_he _((void)); +#endif + +#if defined(STRANGE_MALLOC) || defined(MYMALLOC) +# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) ) +#else +# define MALLOC_OVERHEAD 16 +# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD ) +#endif + +STATIC HE* +new_he(void) +{ + HE* he; + if (PL_he_root) { + he = PL_he_root; + PL_he_root = HeNEXT(he); + return he; + } + return more_he(); +} + +STATIC void +del_he(HE *p) +{ + HeNEXT(p) = (HE*)PL_he_root; + PL_he_root = p; +} + +STATIC HE* +more_he(void) +{ + register HE* he; + register HE* heend; + New(54, PL_he_root, 1008/sizeof(HE), HE); + he = PL_he_root; + heend = &he[1008 / sizeof(HE) - 1]; + while (he < heend) { + HeNEXT(he) = (HE*)(he + 1); + he++; + } + HeNEXT(he) = 0; + return new_he(); +} + +STATIC HEK * +save_hek(char *str, I32 len, U32 hash) +{ + char *k; + register HEK *hek; + + New(54, k, HEK_BASESIZE + len + 1, char); + hek = (HEK*)k; + Copy(str, HEK_KEY(hek), len, char); + *(HEK_KEY(hek) + len) = '\0'; + HEK_LEN(hek) = len; + HEK_HASH(hek) = hash; + return hek; +} + +void +unshare_hek(HEK *hek) +{ + unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek)); +} + +/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot + * contains an SV* */ + +SV** +hv_fetch(HV *hv, char *key, U32 klen, I32 lval) +{ + register XPVHV* xhv; + register U32 hash; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + dTHR; + sv = sv_newmortal(); + mg_copy((SV*)hv, sv, key, klen); + PL_hv_fetch_sv = sv; + return &PL_hv_fetch_sv; + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + U32 i; + for (i = 0; i < klen; ++i) + if (isLOWER(key[i])) { + char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen)))); + SV **ret = hv_fetch(hv, nkey, klen, 0); + if (!ret && lval) + ret = hv_store(hv, key, klen, NEWSV(61,0), 0); + return ret; + } + } +#endif + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) { + if (lval +#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ + || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) +#endif + ) + Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + else + return 0; + } + + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return &HeVAL(entry); + } +#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { + char *gotenv; + + if ((gotenv = PerlEnv_getenv(key)) != Nullch) { + sv = newSVpv(gotenv,strlen(gotenv)); + SvTAINTED_on(sv); + return hv_store(hv,key,klen,sv,hash); + } + } +#endif + if (lval) { /* gonna assign to this, so it better be there */ + sv = NEWSV(61,0); + return hv_store(hv,key,klen,sv,hash); + } + return 0; +} + +/* returns a HE * structure with the all fields set */ +/* note that hent_val will be a mortal sv for MAGICAL hashes */ +HE * +hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash) +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + dTHR; + sv = sv_newmortal(); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); + if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) { + char *k; + New(54, k, HEK_BASESIZE + sizeof(SV*), char); + HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k; + } + HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv); + HeVAL(&PL_hv_fetch_ent_mh) = sv; + return &PL_hv_fetch_ent_mh; + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + U32 i; + key = SvPV(keysv, klen); + for (i = 0; i < klen; ++i) + if (isLOWER(key[i])) { + SV *nkeysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(nkeysv)); + entry = hv_fetch_ent(hv, nkeysv, 0, 0); + if (!entry && lval) + entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash); + return entry; + } + } +#endif + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) { + if (lval +#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ + || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) +#endif + ) + Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + else + return 0; + } + + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return entry; + } +#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { + char *gotenv; + + if ((gotenv = PerlEnv_getenv(key)) != Nullch) { + sv = newSVpv(gotenv,strlen(gotenv)); + SvTAINTED_on(sv); + return hv_store_ent(hv,keysv,sv,hash); + } + } +#endif + if (lval) { /* gonna assign to this, so it better be there */ + sv = NEWSV(61,0); + return hv_store_ent(hv,keysv,sv,hash); + } + return 0; +} + +static void +hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store) +{ + MAGIC *mg = SvMAGIC(hv); + *needs_copy = FALSE; + *needs_store = TRUE; + while (mg) { + if (isUPPER(mg->mg_type)) { + *needs_copy = TRUE; + switch (mg->mg_type) { + case 'P': + case 'S': + *needs_store = FALSE; + } + } + mg = mg->mg_moremagic; + } +} + +SV** +hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash) +{ + register XPVHV* xhv; + register I32 i; + register HE *entry; + register HE **oentry; + + if (!hv) + return 0; + + xhv = (XPVHV*)SvANY(hv); + if (SvMAGICAL(hv)) { + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + if (needs_copy) { + mg_copy((SV*)hv, val, key, klen); + if (!xhv->xhv_array && !needs_store) + return 0; +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + SV *sv = sv_2mortal(newSVpv(key,klen)); + key = strupr(SvPVX(sv)); + hash = 0; + } +#endif + } + } + if (!hash) + PERL_HASH(hash, key, klen); + + if (!xhv->xhv_array) + Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + i = 1; + + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + return &HeVAL(entry); + } + + entry = new_he(); + if (HvSHAREKEYS(hv)) + HeKEY_hek(entry) = share_hek(key, klen, hash); + else /* gotta do the real thing */ + HeKEY_hek(entry) = save_hek(key, klen, hash); + HeVAL(entry) = val; + HeNEXT(entry) = *oentry; + *oentry = entry; + + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(hv); + } + + return &HeVAL(entry); +} + +HE * +hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash) +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register I32 i; + register HE *entry; + register HE **oentry; + + if (!hv) + return 0; + + xhv = (XPVHV*)SvANY(hv); + if (SvMAGICAL(hv)) { + dTHR; + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + if (needs_copy) { + bool save_taint = PL_tainted; + if (PL_tainting) + PL_tainted = SvTAINTED(keysv); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); + TAINT_IF(save_taint); + if (!xhv->xhv_array && !needs_store) + return Nullhe; +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + key = SvPV(keysv, klen); + keysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(keysv)); + hash = 0; + } +#endif + } + } + + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + + if (!xhv->xhv_array) + Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + i = 1; + + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + return entry; + } + + entry = new_he(); + if (HvSHAREKEYS(hv)) + HeKEY_hek(entry) = share_hek(key, klen, hash); + else /* gotta do the real thing */ + HeKEY_hek(entry) = save_hek(key, klen, hash); + HeVAL(entry) = val; + HeNEXT(entry) = *oentry; + *oentry = entry; + + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(hv); + } + + return entry; +} + +SV * +hv_delete(HV *hv, char *key, U32 klen, I32 flags) +{ + register XPVHV* xhv; + register I32 i; + register U32 hash; + register HE *entry; + register HE **oentry; + SV **svp; + SV *sv; + + if (!hv) + return Nullsv; + if (SvRMAGICAL(hv)) { + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + + if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) { + sv = *svp; + mg_clear(sv); + if (!needs_store) { + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + return Nullsv; /* element cannot be deleted */ + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + sv = sv_2mortal(newSVpv(key,klen)); + key = strupr(SvPVX(sv)); + } +#endif + } + } + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return Nullsv; + + PERL_HASH(hash, key, klen); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + entry = *oentry; + i = 1; + for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + if (flags & G_DISCARD) + sv = Nullsv; + else + sv = sv_mortalcopy(HeVAL(entry)); + if (entry == xhv->xhv_eiter) + HvLAZYDEL_on(hv); + else + hv_free_ent(hv, entry); + --xhv->xhv_keys; + return sv; + } + return Nullsv; +} + +SV * +hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash) +{ + register XPVHV* xhv; + register I32 i; + register char *key; + STRLEN klen; + register HE *entry; + register HE **oentry; + SV *sv; + + if (!hv) + return Nullsv; + if (SvRMAGICAL(hv)) { + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + + if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) { + sv = HeVAL(entry); + mg_clear(sv); + if (!needs_store) { + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + return Nullsv; /* element cannot be deleted */ + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + key = SvPV(keysv, klen); + keysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(keysv)); + hash = 0; + } +#endif + } + } + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return Nullsv; + + key = SvPV(keysv, klen); + + if (!hash) + PERL_HASH(hash, key, klen); + + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + entry = *oentry; + i = 1; + for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + if (flags & G_DISCARD) + sv = Nullsv; + else + sv = sv_mortalcopy(HeVAL(entry)); + if (entry == xhv->xhv_eiter) + HvLAZYDEL_on(hv); + else + hv_free_ent(hv, entry); + --xhv->xhv_keys; + return sv; + } + return Nullsv; +} + +bool +hv_exists(HV *hv, char *key, U32 klen) +{ + register XPVHV* xhv; + register U32 hash; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + dTHR; + sv = sv_newmortal(); + mg_copy((SV*)hv, sv, key, klen); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + sv = sv_2mortal(newSVpv(key,klen)); + key = strupr(SvPVX(sv)); + } +#endif + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return 0; + + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return TRUE; + } + return FALSE; +} + + +bool +hv_exists_ent(HV *hv, SV *keysv, U32 hash) +{ + register XPVHV* xhv; + register char *key; + STRLEN klen; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + dTHR; /* just for SvTRUE */ + sv = sv_newmortal(); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } +#ifdef ENV_IS_CASELESS + else if (mg_find((SV*)hv,'E')) { + key = SvPV(keysv, klen); + keysv = sv_2mortal(newSVpv(key,klen)); + (void)strupr(SvPVX(keysv)); + hash = 0; + } +#endif + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return 0; + + key = SvPV(keysv, klen); + if (!hash) + PERL_HASH(hash, key, klen); + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + return TRUE; + } + return FALSE; +} + +STATIC void +hsplit(HV *hv) +{ + register XPVHV* xhv = (XPVHV*)SvANY(hv); + I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ + register I32 newsize = oldsize * 2; + register I32 i; + register char *a = xhv->xhv_array; + register HE **aep; + register HE **bep; + register HE *entry; + register HE **oentry; + + PL_nomemok = TRUE; +#if defined(STRANGE_MALLOC) || defined(MYMALLOC) + Renew(a, ARRAY_ALLOC_BYTES(newsize), char); + if (!a) { + PL_nomemok = FALSE; + return; + } +#else +#define MALLOC_OVERHEAD 16 + New(2, a, ARRAY_ALLOC_BYTES(newsize), char); + if (!a) { + PL_nomemok = FALSE; + return; + } + Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); + if (oldsize >= 64) { + offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize)); + } + else + Safefree(xhv->xhv_array); +#endif + + PL_nomemok = FALSE; + Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ + xhv->xhv_max = --newsize; + xhv->xhv_array = a; + aep = (HE**)a; + + for (i=0; ixhv_fill++; + *bep = entry; + continue; + } + else + oentry = &HeNEXT(entry); + } + if (!*aep) /* everything moved */ + xhv->xhv_fill--; + } +} + +void +hv_ksplit(HV *hv, IV newmax) +{ + register XPVHV* xhv = (XPVHV*)SvANY(hv); + I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ + register I32 newsize; + register I32 i; + register I32 j; + register char *a; + register HE **aep; + register HE *entry; + register HE **oentry; + + newsize = (I32) newmax; /* possible truncation here */ + if (newsize != newmax || newmax <= oldsize) + return; + while ((newsize & (1 + ~newsize)) != newsize) { + newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */ + } + if (newsize < newmax) + newsize *= 2; + if (newsize < newmax) + return; /* overflow detection */ + + a = xhv->xhv_array; + if (a) { + PL_nomemok = TRUE; +#if defined(STRANGE_MALLOC) || defined(MYMALLOC) + Renew(a, ARRAY_ALLOC_BYTES(newsize), char); + if (!a) { + PL_nomemok = FALSE; + return; + } +#else + New(2, a, ARRAY_ALLOC_BYTES(newsize), char); + if (!a) { + PL_nomemok = FALSE; + return; + } + Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); + if (oldsize >= 64) { + offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize)); + } + else + Safefree(xhv->xhv_array); +#endif + PL_nomemok = FALSE; + Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ + } + else { + Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char); + } + xhv->xhv_max = --newsize; + xhv->xhv_array = a; + if (!xhv->xhv_fill) /* skip rest if no entries */ + return; + + aep = (HE**)a; + for (i=0; ixhv_fill++; + aep[j] = entry; + continue; + } + else + oentry = &HeNEXT(entry); + } + if (!*aep) /* everything moved */ + xhv->xhv_fill--; + } +} + +HV * +newHV(void) +{ + register HV *hv; + register XPVHV* xhv; + + hv = (HV*)NEWSV(502,0); + sv_upgrade((SV *)hv, SVt_PVHV); + xhv = (XPVHV*)SvANY(hv); + SvPOK_off(hv); + SvNOK_off(hv); +#ifndef NODEFAULT_SHAREKEYS + HvSHAREKEYS_on(hv); /* key-sharing on by default */ +#endif + xhv->xhv_max = 7; /* start with 8 buckets */ + xhv->xhv_fill = 0; + xhv->xhv_pmroot = 0; + (void)hv_iterinit(hv); /* so each() will start off right */ + return hv; +} + +HV * +newHVhv(HV *ohv) +{ + register HV *hv; + register XPVHV* xhv; + STRLEN hv_max = ohv ? HvMAX(ohv) : 0; + STRLEN hv_fill = ohv ? HvFILL(ohv) : 0; + + hv = newHV(); + while (hv_max && hv_max + 1 >= hv_fill * 2) + hv_max = hv_max / 2; /* Is always 2^n-1 */ + ((XPVHV*)SvANY(hv))->xhv_max = hv_max; + if (!hv_fill) + return hv; + +#if 0 + if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) { + /* Quick way ???*/ + } + else +#endif + { + HE *entry; + I32 hv_riter = HvRITER(ohv); /* current root of iterator */ + HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */ + + /* Slow way */ + hv_iterinit(hv); + while (entry = hv_iternext(ohv)) { + hv_store(hv, HeKEY(entry), HeKLEN(entry), + SvREFCNT_inc(HeVAL(entry)), HeHASH(entry)); + } + HvRITER(ohv) = hv_riter; + HvEITER(ohv) = hv_eiter; + } + + return hv; +} + +void +hv_free_ent(HV *hv, register HE *entry) +{ + SV *val; + + if (!entry) + return; + val = HeVAL(entry); + if (val && isGV(val) && GvCVu(val) && HvNAME(hv)) + PL_sub_generation++; /* may be deletion of method from stash */ + SvREFCNT_dec(val); + if (HeKLEN(entry) == HEf_SVKEY) { + SvREFCNT_dec(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); + } + else if (HvSHAREKEYS(hv)) + unshare_hek(HeKEY_hek(entry)); + else + Safefree(HeKEY_hek(entry)); + del_he(entry); +} + +void +hv_delayfree_ent(HV *hv, register HE *entry) +{ + if (!entry) + return; + if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv)) + PL_sub_generation++; /* may be deletion of method from stash */ + sv_2mortal(HeVAL(entry)); /* free between statements */ + if (HeKLEN(entry) == HEf_SVKEY) { + sv_2mortal(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); + } + else if (HvSHAREKEYS(hv)) + unshare_hek(HeKEY_hek(entry)); + else + Safefree(HeKEY_hek(entry)); + del_he(entry); +} + +void +hv_clear(HV *hv) +{ + register XPVHV* xhv; + if (!hv) + return; + xhv = (XPVHV*)SvANY(hv); + hfreeentries(hv); + xhv->xhv_fill = 0; + xhv->xhv_keys = 0; + if (xhv->xhv_array) + (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); +} + +STATIC void +hfreeentries(HV *hv) +{ + register HE **array; + register HE *entry; + register HE *oentry = Null(HE*); + I32 riter; + I32 max; + + if (!hv) + return; + if (!HvARRAY(hv)) + return; + + riter = 0; + max = HvMAX(hv); + array = HvARRAY(hv); + entry = array[0]; + for (;;) { + if (entry) { + oentry = entry; + entry = HeNEXT(entry); + hv_free_ent(hv, oentry); + } + if (!entry) { + if (++riter > max) + break; + entry = array[riter]; + } + } + (void)hv_iterinit(hv); +} + +void +hv_undef(HV *hv) +{ + register XPVHV* xhv; + if (!hv) + return; + xhv = (XPVHV*)SvANY(hv); + hfreeentries(hv); + Safefree(xhv->xhv_array); + if (HvNAME(hv)) { + Safefree(HvNAME(hv)); + HvNAME(hv) = 0; + } + xhv->xhv_array = 0; + xhv->xhv_max = 7; /* it's a normal hash */ + xhv->xhv_fill = 0; + xhv->xhv_keys = 0; + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); +} + +I32 +hv_iterinit(HV *hv) +{ + register XPVHV* xhv; + HE *entry; + + if (!hv) + croak("Bad hash"); + xhv = (XPVHV*)SvANY(hv); + entry = xhv->xhv_eiter; +#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */ + if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) + prime_env_iter(); +#endif + if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ + HvLAZYDEL_off(hv); + hv_free_ent(hv, entry); + } + xhv->xhv_riter = -1; + xhv->xhv_eiter = Null(HE*); + return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */ +} + +HE * +hv_iternext(HV *hv) +{ + register XPVHV* xhv; + register HE *entry; + HE *oldentry; + MAGIC* mg; + + if (!hv) + croak("Bad hash"); + xhv = (XPVHV*)SvANY(hv); + oldentry = entry = xhv->xhv_eiter; + + if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { + SV *key = sv_newmortal(); + if (entry) { + sv_setsv(key, HeSVKEY_force(entry)); + SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + } + else { + char *k; + HEK *hek; + + xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */ + Zero(entry, 1, HE); + Newz(54, k, HEK_BASESIZE + sizeof(SV*), char); + hek = (HEK*)k; + HeKEY_hek(entry) = hek; + HeKLEN(entry) = HEf_SVKEY; + } + magic_nextpack((SV*) hv,mg,key); + if (SvOK(key)) { + /* force key to stay around until next time */ + HeSVKEY_set(entry, SvREFCNT_inc(key)); + return entry; /* beware, hent_val is not set */ + } + if (HeVAL(entry)) + SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hek(entry)); + del_he(entry); + xhv->xhv_eiter = Null(HE*); + return Null(HE*); + } + + if (!xhv->xhv_array) + Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + if (entry) + entry = HeNEXT(entry); + while (!entry) { + ++xhv->xhv_riter; + if (xhv->xhv_riter > xhv->xhv_max) { + xhv->xhv_riter = -1; + break; + } + entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; + } + + if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ + HvLAZYDEL_off(hv); + hv_free_ent(hv, oldentry); + } + + xhv->xhv_eiter = entry; + return entry; +} + +char * +hv_iterkey(register HE *entry, I32 *retlen) +{ + if (HeKLEN(entry) == HEf_SVKEY) { + STRLEN len; + char *p = SvPV(HeKEY_sv(entry), len); + *retlen = len; + return p; + } + else { + *retlen = HeKLEN(entry); + return HeKEY(entry); + } +} + +/* unlike hv_iterval(), this always returns a mortal copy of the key */ +SV * +hv_iterkeysv(register HE *entry) +{ + if (HeKLEN(entry) == HEf_SVKEY) + return sv_mortalcopy(HeKEY_sv(entry)); + else + return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""), + HeKLEN(entry))); +} + +SV * +hv_iterval(HV *hv, register HE *entry) +{ + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + SV* sv = sv_newmortal(); + if (HeKLEN(entry) == HEf_SVKEY) + mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); + else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); + return sv; + } + } + return HeVAL(entry); +} + +SV * +hv_iternextsv(HV *hv, char **key, I32 *retlen) +{ + HE *he; + if ( (he = hv_iternext(hv)) == NULL) + return NULL; + *key = hv_iterkey(he, retlen); + return hv_iterval(hv, he); +} + +void +hv_magic(HV *hv, GV *gv, int how) +{ + sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); +} + +char* +sharepvn(char *sv, I32 len, U32 hash) +{ + return HEK_KEY(share_hek(sv, len, hash)); +} + +/* possibly free a shared string if no one has access to it + * len and hash must both be valid for str. + */ +void +unsharepvn(char *str, I32 len, U32 hash) +{ + register XPVHV* xhv; + register HE *entry; + register HE **oentry; + register I32 i = 1; + I32 found = 0; + + /* what follows is the moral equivalent of: + if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) { + if (--*Svp == Nullsv) + hv_delete(PL_strtab, str, len, G_DISCARD, hash); + } */ + xhv = (XPVHV*)SvANY(PL_strtab); + /* assert(xhv_array != 0) */ + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != len) + continue; + if (memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + found = 1; + if (--HeVAL(entry) == Nullsv) { + *oentry = HeNEXT(entry); + if (i && !*oentry) + xhv->xhv_fill--; + Safefree(HeKEY_hek(entry)); + del_he(entry); + --xhv->xhv_keys; + } + break; + } + + if (!found) + warn("Attempt to free non-existent shared string"); +} + +/* get a (constant) string ptr from the global string table + * string will get added if it is not already there. + * len and hash must both be valid for str. + */ +HEK * +share_hek(char *str, I32 len, register U32 hash) +{ + register XPVHV* xhv; + register HE *entry; + register HE **oentry; + register I32 i = 1; + I32 found = 0; + + /* what follows is the moral equivalent of: + + if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE))) + hv_store(PL_strtab, str, len, Nullsv, hash); + */ + xhv = (XPVHV*)SvANY(PL_strtab); + /* assert(xhv_array != 0) */ + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != len) + continue; + if (memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + found = 1; + break; + } + if (!found) { + entry = new_he(); + HeKEY_hek(entry) = save_hek(str, len, hash); + HeVAL(entry) = Nullsv; + HeNEXT(entry) = *oentry; + *oentry = entry; + xhv->xhv_keys++; + if (i) { /* initial entry? */ + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) + hsplit(PL_strtab); + } + } + + ++HeVAL(entry); /* use value slot as REFCNT */ + return HeKEY_hek(entry); +} + + + diff --git a/contrib/perl5/hv.h b/contrib/perl5/hv.h new file mode 100644 index 00000000000..19694ac5d1d --- /dev/null +++ b/contrib/perl5/hv.h @@ -0,0 +1,120 @@ +/* hv.h + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +typedef struct he HE; +typedef struct hek HEK; + +struct he { + HE *hent_next; + HEK *hent_hek; + SV *hent_val; +}; + +struct hek { + U32 hek_hash; + I32 hek_len; + char hek_key[1]; +}; + +/* This structure must match the beginning of struct xpvmg in sv.h. */ +struct xpvhv { + char * xhv_array; /* pointer to malloced string */ + STRLEN xhv_fill; /* how full xhv_array currently is */ + STRLEN xhv_max; /* subscript of last element of xhv_array */ + IV xhv_keys; /* how many elements in the array */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* magic for scalar array */ + HV* xmg_stash; /* class package */ + + I32 xhv_riter; /* current root of iterator */ + HE *xhv_eiter; /* current entry of iterator */ + PMOP *xhv_pmroot; /* list of pm's for this package */ + char *xhv_name; /* name, if a symbol table */ +}; + +#define PERL_HASH(hash,str,len) \ + STMT_START { \ + register char *s_PeRlHaSh = str; \ + register I32 i_PeRlHaSh = len; \ + register U32 hash_PeRlHaSh = 0; \ + while (i_PeRlHaSh--) \ + hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ + (hash) = hash_PeRlHaSh; \ + } STMT_END + + +/* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */ +#define HEf_SVKEY -2 /* hent_key is a SV* */ + + +#define Nullhv Null(HV*) +#define HvARRAY(hv) ((HE**)((XPVHV*) SvANY(hv))->xhv_array) +#define HvFILL(hv) ((XPVHV*) SvANY(hv))->xhv_fill +#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max +#define HvKEYS(hv) ((XPVHV*) SvANY(hv))->xhv_keys +#define HvRITER(hv) ((XPVHV*) SvANY(hv))->xhv_riter +#define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter +#define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot +#define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name + +#define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS) +#define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS) +#define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS) + +#define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL) +#define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL) +#define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL) + +#ifdef OVERLOAD + +/* Maybe amagical: */ +/* #define HV_AMAGICmb(hv) (SvFLAGS(hv) & (SVpgv_badAM | SVpgv_AM)) */ + +#define HV_AMAGIC(hv) (SvFLAGS(hv) & SVpgv_AM) +#define HV_AMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_AM) +#define HV_AMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_AM) + +/* +#define HV_AMAGICbad(hv) (SvFLAGS(hv) & SVpgv_badAM) +#define HV_badAMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_badAM) +#define HV_badAMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_badAM) +*/ + +#endif /* OVERLOAD */ + +#define Nullhe Null(HE*) +#define HeNEXT(he) (he)->hent_next +#define HeKEY_hek(he) (he)->hent_hek +#define HeKEY(he) HEK_KEY(HeKEY_hek(he)) +#define HeKEY_sv(he) (*(SV**)HeKEY(he)) +#define HeKLEN(he) HEK_LEN(HeKEY_hek(he)) +#define HeVAL(he) (he)->hent_val +#define HeHASH(he) HEK_HASH(HeKEY_hek(he)) +#define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \ + SvPV(HeKEY_sv(he),lp) : \ + (((lp = HeKLEN(he)) >= 0) ? \ + HeKEY(he) : Nullch)) + +#define HeSVKEY(he) ((HeKEY(he) && \ + HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : Nullsv) + +#define HeSVKEY_force(he) (HeKEY(he) ? \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : \ + sv_2mortal(newSVpv(HeKEY(he), \ + HeKLEN(he)))) : \ + &PL_sv_undef) +#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv)) + +#define Nullhek Null(HEK*) +#define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0]) +#define HEK_HASH(hek) (hek)->hek_hash +#define HEK_LEN(hek) (hek)->hek_len +#define HEK_KEY(hek) (hek)->hek_key diff --git a/contrib/perl5/installhtml b/contrib/perl5/installhtml new file mode 100755 index 00000000000..fd11ee69f48 --- /dev/null +++ b/contrib/perl5/installhtml @@ -0,0 +1,584 @@ +#!./perl -w + +# This file should really be a extracted from a .PL + +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; +use Pod::Html; + +umask 022; + +=head1 NAME + +installhtml - converts a collection of POD pages to HTML format. + +=head1 SYNOPSIS + + installhtml [--help] [--podpath=:...:] [--podroot=] + [--htmldir=] [--htmlroot=] [--norecurse] [--recurse] + [--splithead=,...,] [--splititem=,...,] + [--libpods=,...,] [--verbose] + +=head1 DESCRIPTION + +I converts a collection of POD pages to a corresponding +collection of HTML pages. This is primarily used to convert the pod +pages found in the perl distribution. + +=head1 OPTIONS + +=over 4 + +=item B<--help> help + +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<--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<--htmldir> HTML destination directory + +The base directory which all HTML files will be written to. This should +be a path relative to the filesystem, not the resulting URL. + +=item B<--htmlroot> URL base directory + +The base directory which all resulting HTML files will be visible at in +a URL. The default is `/'. + +=item B<--splithead> POD files to split on =head directive + +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. +The .pod suffix is optional. I does not do the actual +split, rather it invokes I 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 LEE links + +Colon-separated list of "library" pod files. This is the same list that +will be passed to pod2html when any pod is converted. + +=item B<--verbose> verbose output + +Self-explanatory. + +=back + +=head1 EXAMPLE + +The following command-line is an example of the one we use to convert +perl documentation: + + ./installhtml --podpath=lib:ext:pod:vms \ + --podroot=/usr/src/perl \ + --htmldir=/perl/nmanual \ + --htmlroot=/perl/nmanual \ + --splithead=pod/perlipc \ + --splititem=pod/perlfunc \ + --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \ + --recurse \ + --verbose + +=head1 AUTHOR + +Chris Hall Ehallc@cs.colorado.eduE + +=head1 TODO + +=cut + +$usage =<:...: --podroot= + --htmldir= --htmlroot= --norecurse --recurse + --splithead=,..., --splititem=,..., + --libpods=,..., --verbose + + --help - this message + --podpath - colon-separated list of directories containing .pod and + .pm files to be converted (. by default). + --podroot - filesystem base directory from which all relative paths in + podpath stem (default is .). + --htmldir - directory to store resulting html files in relative + to the filesystem (\$podroot/html by default). + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --libpods - comma-separated list of files to search for =item pod + directives in as targets of C<> and implicit links (empty + by default). + --norecurse - don't recurse on those subdirectories listed in podpath. + (default behavior). + --recurse - recurse on those subdirectories listed in podpath + --splithead - comma-separated list of .pod or .pm files to split. will + split each file into several smaller files at every occurrence + of a pod =head[1-6] directive. + --splititem - comma-separated list of .pod or .pm files to split using + splitpod. + --splitpod - directory where the program splitpod can be found + (\$podroot/pod by default). + --verbose - self-explanatory. + +END_OF_USAGE + +@libpods = (); +@podpath = ( "." ); # colon-separated list of directories containing .pod + # and .pm files to be converted. +$podroot = "."; # assume the pods we want are here +$htmldir = ""; # nothing for now... +$htmlroot = "/"; # default value +$recurse = 0; # default behavior +@splithead = (); # don't split any files by default +@splititem = (); # don't split any files by default +$splitpod = ""; # nothing for now. + +$verbose = 0; # whether or not to print debugging info + +$pod2html = "pod/pod2html"; + +usage("") unless @ARGV; + +# parse the command-line +$result = GetOptions( qw( + help + podpath=s + podroot=s + htmldir=s + htmlroot=s + libpods=s + recurse! + splithead=s + splititem=s + splitpod=s + verbose +)); +usage("invalid parameters") unless $result; +parse_command_line(); + + +# set these variables to appropriate values if the user didn't specify +# values for them. +$htmldir = "$htmlroot/html" unless $htmldir; +$splitpod = "$podroot/pod" unless $splitpod; + + +# make sure that the destination directory exists +(mkdir($htmldir, 0755) || + die "$0: cannot make directory $htmldir: $!\n") if ! -d $htmldir; + + +# the following array will eventually contain files that are to be +# ignored in the conversion process. these are files that have been +# process by splititem or splithead and should not be converted as a +# result. +@ignore = (); + + +# split pods. its important to do this before convert ANY pods because +# 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); + + +# convert the pod pages found in @poddirs +#warn "converting files\n" if $verbose; +#warn "\@ignore\t= @ignore\n" if $verbose; +foreach $dir (@podpath) { + installdir($dir, $recurse, $podroot, \@splitdirs, \@ignore); +} + + +# now go through and create master indices for each pod we split +foreach $dir (@splititem) { + print "creating index $htmldir/$dir.html\n" if $verbose; + create_index("$htmldir/$dir.html", "$htmldir/$dir"); +} + +foreach $dir (@splithead) { + $dir .= ".pod" unless $dir =~ /(\.pod|\.pm)$/; + # let pod2html create the file + runpod2html($dir, 1); + + # now go through and truncate after the index + $dir =~ /^(.*?)(\.pod|\.pm)?$/sm; + $file = "$htmldir/$1"; + print "creating index $file.html\n" if $verbose; + + # read in everything until what would have been the first =head + # directive, patching the index as we go. + open(H, "<$file.html") || + die "$0: error opening $file.html for input: $!\n"; + $/ = ""; + @data = (); + while () { + last if /NAME=/; + s,HREF="#(.*)">,HREF="$file/$1.html">,g; + push @data, $_; + } + close(H); + + # now rewrite the file + open(H, ">$file.html") || + die "$0: error opening $file.html for output: $!\n"; + print H "@data\n"; + close(H); +} + +############################################################################## + + +sub usage { + warn "$0: @_\n" if @_; + die $usage; +} + + +sub parse_command_line { + usage() if defined $opt_help; + $opt_help = ""; # make -w shut up + + # list of directories + @podpath = split(":", $opt_podpath) if defined $opt_podpath; + + # lists of files + @splithead = split(",", $opt_splithead) if defined $opt_splithead; + @splititem = split(",", $opt_splititem) if defined $opt_splititem; + @libpods = split(",", $opt_libpods) if defined $opt_libpods; + + $htmldir = $opt_htmldir if defined $opt_htmldir; + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $podroot = $opt_podroot if defined $opt_podroot; + $splitpod = $opt_splitpod if defined $opt_splitpod; + + $recurse = $opt_recurse if defined $opt_recurse; + $verbose = $opt_verbose if defined $opt_verbose; +} + + +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); + + # get the list of .html files in this directory + opendir(DIR, $dir) || + die "$0: error opening directory $dir for reading: $!\n"; + @files = sort(grep(/\.html?$/, readdir(DIR))); + closedir(DIR); + + open(HTML, ">$html") || + die "$0: error opening $html for output: $!\n"; + + # for each .html file in the directory, extract the index + # embedded in the file and throw it into the big index. + print HTML "
\n"; + foreach $file (@files) { + $/ = ""; + + open(IN, "<$dir/$file") || + die "$0: error opening $dir/$file for input: $!\n"; + @filedata = ; + close(IN); + + # pull out the NAME section + ($name) = grep(/NAME=/, @filedata); + $name =~ m,/H1>\s(\S+)\s[\s-]*(.*?)\s*$,sm; + print HTML qq(); + print HTML "
$1
$2\n" if defined $1; +# print HTML qq($1
\n") if defined $1; + + next; + + @index = grep(/.*/s, + @filedata); + for (@index) { + s/(\s*\s*)/$2/s; + s,#,$dir/$file#,g; + # print HTML "$_\n"; + print HTML "$_\n

\n"; + } + } + print HTML "

\n"; + + close(HTML); +} + + +sub split_on_head { + my($podroot, $htmldir, $splitdirs, $ignore, @splithead) = @_; + my($pod, $dirname, $filename); + + # split the files specified in @splithead on =head[1-6] pod directives + print "splitting files by head.\n" if $verbose && $#splithead >= 0; + foreach $pod (@splithead) { + # figure out the directory name and filename + $pod =~ s,^([^/]*)$,/$1,; + $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $dirname = $1; + $filename = "$2.pod"; + + # since we are splitting this file it shouldn't be converted. + push(@$ignore, "$podroot/$dirname/$filename"); + + # split the pod + splitpod("$podroot/$dirname/$filename", "$podroot/$dirname", $htmldir, + $splitdirs); + } +} + + +sub split_on_item { + my($podroot, $splitdirs, $ignore, @splititem) = @_; + my($pwd, $dirname, $filename); + + 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,; + $pod =~ m,(.*?)/(.*?)(\.pod)?$,; + $dirname = "$1/$2"; + $filename = "$2.pod"; + + # since we are splitting this file it shouldn't be converted. + push(@$ignore, "$podroot/$dirname.pod"); + + # split the pod + push(@$splitdirs, "$podroot/$dirname"); + if (! -d "$podroot/$dirname") { + mkdir("$podroot/$dirname", 0755) || + die "$0: error creating directory $podroot/$dirname: $!\n"; + } + chdir("$podroot/$dirname") || + die "$0: error changing to directory $podroot/$dirname: $!\n"; + 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); +} + + +# +# splitpod - splits a .pod file into several smaller .pod files +# where a new file is started each time a =head[1-6] pod directive +# is encountered in the input file. +# +sub splitpod { + my($pod, $poddir, $htmldir, $splitdirs) = @_; + my(@poddata, @filedata, @heads); + my($file, $i, $j, $prevsec, $section, $nextsec); + + print "splitting $pod\n" if $verbose; + + # read the file in paragraphs + $/ = ""; + open(SPLITIN, "<$pod") || + die "$0: error opening $pod for input: $!\n"; + @filedata = ; + close(SPLITIN) || + die "$0: error closing $pod: $!\n"; + + # restore the file internally by =head[1-6] sections + @poddata = (); + for ($i = 0, $j = -1; $i <= $#filedata; $i++) { + $j++ if ($filedata[$i] =~ /^\s*=head[1-6]/); + if ($j >= 0) { + $poddata[$j] = "" unless defined $poddata[$j]; + $poddata[$j] .= "\n$filedata[$i]" if $j >= 0; + } + } + + # create list of =head[1-6] sections so that we can rewrite + # L<> links as necessary. + %heads = (); + foreach $i (0..$#poddata) { + $heads{htmlize($1)} = 1 if $poddata[$i] =~ /=head[1-6]\s+(.*)/; + } + + # create a directory of a similar name and store all the + # files in there + $pod =~ s,.*/(.*),$1,; # get the last part of the name + $dir = $pod; + $dir =~ s/\.pod//g; + push(@$splitdirs, "$poddir/$dir"); + mkdir("$poddir/$dir", 0755) || + die "$0: could not create directory $poddir/$dir: $!\n" + unless -d "$poddir/$dir"; + + $poddata[0] =~ /^\s*=head[1-6]\s+(.*)/; + $section = ""; + $nextsec = $1; + + # for each section of the file create a separate pod file + for ($i = 0; $i <= $#poddata; $i++) { + # determine the "prev" and "next" links + $prevsec = $section; + $section = $nextsec; + if ($i < $#poddata) { + $poddata[$i+1] =~ /^\s*=head[1-6]\s+(.*)/; + $nextsec = $1; + } else { + $nextsec = ""; + } + + # determine an appropriate filename (this must correspond with + # what pod2html will try and guess) + # $poddata[$i] =~ /^\s*=head[1-6]\s+(.*)/; + $file = "$dir/" . htmlize($section) . ".pod"; + + # create the new .pod file + print "\tcreating $poddir/$file\n" if $verbose; + open(SPLITOUT, ">$poddir/$file") || + die "$0: error opening $poddir/$file for output: $!\n"; + $poddata[$i] =~ s,L<([^<>]*)>, + defined $heads{htmlize($1)} ? "L<$dir/$1>" : "L<$1>" + ,ge; + print SPLITOUT $poddata[$i]."\n\n"; + print SPLITOUT "=over 4\n\n"; + print SPLITOUT "=item *\n\nBack to L<$dir/\"$prevsec\">\n\n" if $prevsec; + print SPLITOUT "=item *\n\nForward to L<$dir/\"$nextsec\">\n\n" if $nextsec; + print SPLITOUT "=item *\n\nUp to L<$dir>\n\n"; + print SPLITOUT "=back\n\n"; + close(SPLITOUT) || + die "$0: error closing $poddir/$file: $!\n"; + } +} + + +# +# installdir - takes care of converting the .pod and .pm files in the +# current directory to .html files and then installing those. +# +sub installdir { + my($dir, $recurse, $podroot, $splitdirs, $ignore) = @_; + my(@dirlist, @podlist, @pmlist, $doindex); + + @dirlist = (); # directories to recurse on + @podlist = (); # .pod files to install + @pmlist = (); # .pm files to install + + # should files in this directory get an index? + $doindex = (grep($_ eq "$podroot/$dir", @$splitdirs) ? 0 : 1); + + opendir(DIR, "$podroot/$dir") + || die "$0: error opening directory $podroot/$dir: $!\n"; + + # find the directories to recurse on + @dirlist = map { "$dir/$_" } + grep(-d "$podroot/$dir/$_" && !/^\.{1,2}/, readdir(DIR)) if $recurse; + rewinddir(DIR); + + # find all the .pod files within the directory + @podlist = map { /^(.*)\.pod$/; "$dir/$1" } + grep(! -d "$podroot/$dir/$_" && /\.pod$/, readdir(DIR)); + rewinddir(DIR); + + # find all the .pm files within the directory + @pmlist = map { /^(.*)\.pm$/; "$dir/$1" } + grep(! -d "$podroot/$dir/$_" && /\.pm$/, readdir(DIR)); + + closedir(DIR); + + # recurse on all subdirectories we kept track of + foreach $dir (@dirlist) { + installdir($dir, $recurse, $podroot, $splitdirs, $ignore); + } + + # install all the pods we found + foreach $pod (@podlist) { + # check if we should ignore it. + next if grep($_ eq "$podroot/$pod.pod", @$ignore); + + # check if a .pm files exists too + if (grep($_ eq "$pod.pm", @pmlist)) { + print "$0: Warning both `$podroot/$pod.pod' and " + . "`$podroot/$pod.pm' exist, using pod\n"; + push(@ignore, "$pod.pm"); + } + runpod2html("$pod.pod", $doindex); + } + + # install all the .pm files we found + foreach $pm (@pmlist) { + # check if we should ignore it. + next if grep($_ eq "$pm.pm", @ignore); + + runpod2html("$pm.pm", $doindex); + } +} + + +# +# runpod2html - invokes pod2html to convert a .pod or .pm file to a .html +# file. +# +sub runpod2html { + my($pod, $doindex) = @_; + my($html, $i, $dir, @dirs); + + $html = $pod; + $html =~ s/\.(pod|pm)$/.html/g; + + # make sure the destination directories exist + @dirs = split("/", $html); + $dir = "$htmldir/"; + for ($i = 0; $i < $#dirs; $i++) { + if (! -d "$dir$dirs[$i]") { + mkdir("$dir$dirs[$i]", 0755) || + die "$0: error creating directory $dir$dirs[$i]: $!\n"; + } + $dir .= "$dirs[$i]/"; + } + + # invoke pod2html + print "$podroot/$pod => $htmldir/$html\n" if $verbose; +#system("./pod2html", + Pod::Html'pod2html( + #Pod::Html'pod2html($pod2html, + "--htmlroot=$htmlroot", + "--podpath=".join(":", @podpath), + "--podroot=$podroot", "--netscape", + ($doindex ? "--index" : "--noindex"), + "--" . ($recurse ? "" : "no") . "recurse", + ($#libpods >= 0) ? "--libpods=" . join(":", @libpods) : "", + "--infile=$podroot/$pod", "--outfile=$htmldir/$html"); + die "$0: error running $pod2html: $!\n" if $?; +} + +sub htmlize { htmlify(0, @_) } diff --git a/contrib/perl5/installman b/contrib/perl5/installman new file mode 100755 index 00000000000..e6377204b15 --- /dev/null +++ b/contrib/perl5/installman @@ -0,0 +1,261 @@ +#!./perl +BEGIN { @INC = ('lib') } +use Config; +use Getopt::Long; +use File::Find; +use File::Copy; +use File::Path qw(mkpath); +use ExtUtils::Packlist; +use subs qw(unlink chmod rename link); +use vars qw($packlist); +require Cwd; + +umask 022; +$ENV{SHELL} = 'sh' if $^O eq 'os2'; + +$ver = $]; +$release = substr($ver,0,3); # Not used presently. +$patchlevel = substr($ver,3,2); +die "Patchlevel of perl ($patchlevel)", + "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n" + if $patchlevel != $Config{'PATCHLEVEL'}; + +$usage = +"Usage: installman --man1dir=/usr/wherever --man1ext=1 + --man3dir=/usr/wherever --man3ext=3 + --notify --help + Defaults are: + man1dir = $Config{'installman1dir'}; + man1ext = $Config{'man1ext'}; + man3dir = $Config{'installman3dir'}; + man3ext = $Config{'man3ext'}; + --notify (or -n) just lists commands that would be executed.\n"; + +GetOptions( qw( man1dir=s man1ext=s man3dir=s man3ext=s notify n help)) + || die $usage; +die $usage if $opt_help; + +# These are written funny to avoid -w typo warnings. +$man1dir = defined($opt_man1dir) ? $opt_man1dir : $Config{'installman1dir'}; +$man1ext = defined($opt_man1ext) ? $opt_man1ext : $Config{'man1ext'}; +$man3dir = defined($opt_man3dir) ? $opt_man3dir : $Config{'installman3dir'}; +$man3ext = defined($opt_man3ext) ? $opt_man3ext : $Config{'man3ext'}; + +$notify = $opt_notify || $opt_n; + +#Sanity checks + +-x "./perl$Config{exe_ext}" + or warn "./perl$Config{exe_ext} not found! Have you run make?\n"; +-d $Config{'installprivlib'} + || warn "Perl library directory $Config{'installprivlib'} not found. + Have you run make install?. (Installing anyway.)\n"; +-x "t/perl$Config{exe_ext}" || warn "WARNING: You've never run 'make test'!!!", + " (Installing anyway.)\n"; + +$packlist = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); + +# Install the main pod pages. +runpod2man('pod', $man1dir, $man1ext); + +# Install the pods for library modules. +runpod2man('lib', $man3dir, $man3ext); + +# Install the pods embedded in the installed scripts +runpod2man('utils', $man1dir, $man1ext, 'c2ph'); +runpod2man('utils', $man1dir, $man1ext, 'h2ph'); +runpod2man('utils', $man1dir, $man1ext, 'h2xs'); +runpod2man('utils', $man1dir, $man1ext, 'perldoc'); +runpod2man('utils', $man1dir, $man1ext, 'perlbug'); +runpod2man('utils', $man1dir, $man1ext, 'pl2pm'); +runpod2man('utils', $man1dir, $man1ext, 'splain'); +runpod2man('x2p', $man1dir, $man1ext, 's2p'); +runpod2man('x2p', $man1dir, $man1ext, 'a2p.pod'); +runpod2man('pod', $man1dir, $man1ext, 'pod2man'); +runpod2man('pod', $man1dir, $man1ext, 'pod2html'); + +# It would probably be better to have this page linked +# to the c2ph man page. Or, this one could say ".so man1/c2ph.1", +# but then it would have to pay attention to $man1dir and $man1ext. +runpod2man('utils', $man1dir, $man1ext, 'pstruct'); + +runpod2man('lib/ExtUtils', $man1dir, $man1ext, 'xsubpp'); + +sub runpod2man { + # $script is script name if we are installing a manpage embedded + # in a script, undef otherwise + my($poddir, $mandir, $manext, $script) = @_; + + my($downdir); # can't just use .. when installing xsubpp manpage + + $downdir = $poddir; + $downdir =~ s:[^/]+:..:g; + my($builddir) = Cwd::getcwd(); + + if ($mandir eq ' ' or $mandir eq '') { + print STDERR "Skipping installation of ", + ($script ? "$poddir/$script man page" : "$poddir man pages"), ".\n"; + return; + } + + print STDERR "chdir $poddir\n"; + chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n"; + + # We insist on using the current version of pod2man in case there + # are enhancements or changes from previous installed versions. + # The error message doesn't include the '..' because the user + # won't be aware that we've chdir to $poddir. + -r "$downdir/pod/pod2man" || die "Executable pod/pod2man not found.\n"; + + # We want to be sure to use the current perl. We can't rely on + # the installed perl because it might not be actually installed + # yet. (The user may have set the $install* Configure variables + # to point to some temporary home, from which the executable gets + # installed by occult means.) + $pod2man = "$downdir/perl -I $downdir/lib $downdir/pod/pod2man --section=$manext --official"; + + mkpath($mandir, 1, 0777) unless $notify; # In File::Path + # Make a list of all the .pm and .pod files in the directory. We will + # always run pod2man from the lib directory and feed it the full pathname + # of the pod. This might be useful for pod2man someday. + if ($script) { + @modpods = ($script); + } else { + @modpods = (); + find(\&lsmodpods, '.'); + } + foreach $mod (@modpods) { + $manpage = $mod; + my $tmp; + # Skip .pm files that have corresponding .pod files, and Functions.pm. + next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp); + next if ($mod eq 'Pod/Functions.pm'); #### Used only by pod itself + + # Convert name from File/Basename.pm to File::Basename.3 format, + # if necessary. + $manpage =~ s#\.p(m|od)$##; + if ($^O eq 'os2' || $^O eq 'amigaos') { + $manpage =~ s#/#.#g; + } else { + $manpage =~ s#/#::#g; + } + $tmp = "${mandir}/${manpage}.tmp"; + $manpage = "${mandir}/${manpage}.${manext}"; + if (&cmd("$pod2man $mod > $tmp") == 0 && !$notify && -s $tmp) { + rename($tmp, $manpage) && next; + } + unless ($notify) { + unlink($tmp); + } + } + chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n"; + print STDERR "chdir $builddir\n"; +} + +sub lsmodpods { + my $dir = $File::Find::dir; + my $name = $File::Find::name; + if (-f $_) { + $name =~ s#^\./##; + push(@modpods, $name) if ($name =~ /\.p(m|od)$/); + } +} + +$packlist->write() unless $notify; +print STDERR " Installation complete\n"; + +exit 0; + + +############################################################################### +# Utility subroutines from installperl + +sub cmd { + local($cmd) = @_; + print STDERR " $cmd\n"; + unless ($notify) { + if ($Config{d_fork}) { + fork ? wait : exec $cmd; # Allow user to ^C out of command. + } + else { + system $cmd; + } + warn "Command failed!!\n" if $?; + } + return $? != 0; +} + +sub unlink { + local(@names) = @_; + my $cnt = 0; + + foreach $name (@names) { +next unless -e $name; +chmod 0777, $name if $^O eq 'os2'; +print STDERR " unlink $name\n"; +( CORE::unlink($name) and ++$cnt + or warn "Couldn't unlink $name: $!\n" ) unless $notify; + } + return $cnt; +} + +sub link { + my($from,$to) = @_; + my($success) = 0; + + print STDERR " ln $from $to\n"; + eval { + CORE::link($from, $to) + ? $success++ + : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) + ? die "AFS" # okay inside eval {} + : warn "Couldn't link $from to $to: $!\n" + unless $notify; + $packlist->{$to} = { type => 'file' }; + }; + if ($@) { + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n" + unless $notify; + $packlist->{$to} = { type => 'file' }; + } + $success; +} + +sub rename { + local($from,$to) = @_; + if (-f $to and not unlink($to)) { +my($i); +for ($i = 1; $i < 50; $i++) { + last if CORE::rename($to, "$to.$i"); +} +warn("Cannot rename to `$to.$i': $!"), return 0 + if $i >= 50; # Give up! + } + link($from,$to) || return 0; + unlink($from); + $packlist->{$to} = { type => 'file' }; +} + +sub chmod { + local($mode,$name) = @_; + + printf STDERR " chmod %o %s\n", $mode, $name; + CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name) + unless $notify; +} + +sub samepath { + local($p1, $p2) = @_; + local($dev1, $ino1, $dev2, $ino2); + + if ($p1 ne $p2) { + ($dev1, $ino1) = stat($p1); + ($dev2, $ino2) = stat($p2); + ($dev1 == $dev2 && $ino1 == $ino2); + } + else { + 1; + } +} diff --git a/contrib/perl5/installperl b/contrib/perl5/installperl new file mode 100755 index 00000000000..2db72d41aee --- /dev/null +++ b/contrib/perl5/installperl @@ -0,0 +1,600 @@ +#!./perl + +BEGIN { + require 5.004; + chdir '..' if !-d 'lib' and -d '..\lib'; + @INC = 'lib'; + $ENV{PERL5LIB} = 'lib'; +} + +use strict; +use vars qw($Is_VMS $Is_W32 $Is_OS2 $nonono $versiononly $depth); + +BEGIN { + $Is_VMS = $^O eq 'VMS'; + $Is_W32 = $^O eq 'MSWin32'; + $Is_OS2 = $^O eq 'os2'; + if ($Is_VMS) { eval 'use VMS::Filespec;' } +} + +my $scr_ext = ($Is_VMS ? '.Com' : $Is_W32 ? '.bat' : ''); + +use File::Find; +use File::Compare; +use File::Copy (); +use File::Path (); +use ExtUtils::Packlist; +use Config; +use subs qw(unlink link chmod); +use vars qw($packlist); + +# override the ones in the rest of the script +sub mkpath { + File::Path::mkpath(@_) unless $nonono; +} + +my $mainperldir = "/usr/bin"; +my $exe_ext = $Config{exe_ext}; + +# Allow ``make install PERLNAME=something_besides_perl'': +my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl'; + +while (@ARGV) { + $nonono = 1 if $ARGV[0] eq '-n'; + $versiononly = 1 if $ARGV[0] eq '-v'; + shift; +} + +umask 022 unless $Is_VMS; + +my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc + utils/pl2pm utils/splain utils/perlcc + x2p/s2p x2p/find2perl + pod/pod2man pod/pod2html pod/pod2latex pod/pod2text); + +if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; } + +my @pods = (); + +# Specify here any .pm files that are actually architecture-dependent. +# (Those included with XS extensions under ext/ are automatically +# added later.) +# Now that the default privlib has the full perl version number included, +# we no longer have to play the trick of sticking version-specific .pm +# files under the archlib directory. +my %archpms = ( + Config => 1, +); + +if ($^O eq 'dos') { + push(@scripts,'djgpp/fixpmain'); + $archpms{config} = $archpms{filehand} = 1; +} + +if ((-e "testcompile") && (defined($ENV{'COMPILE'}))) +{ + push(@scripts, map("$_.exe", @scripts)); +} + +find(sub { + if ("$File::Find::dir/$_" =~ m{^ext/[^/]+/(.*)\.pm$}) { + (my $pm = $1) =~ s{^lib/}{}; + $archpms{$pm} = 1; + } + }, 'ext'); + +my $ver = $]; +my $release = substr($ver,0,3); # Not used presently. +my $patchlevel = substr($ver,3,2); +die "Patchlevel of perl ($patchlevel)", + "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n" + if $patchlevel != $Config{'PATCHLEVEL'}; + +# Fetch some frequently-used items from %Config +my $installbin = $Config{installbin}; +my $installscript = $Config{installscript}; +my $installprivlib = $Config{installprivlib}; +my $installarchlib = $Config{installarchlib}; +my $installsitelib = $Config{installsitelib}; +my $installsitearch = $Config{installsitearch}; +my $installman1dir = $Config{installman1dir}; +my $man1ext = $Config{man1ext}; +my $libperl = $Config{libperl}; +# Shared library and dynamic loading suffixes. +my $so = $Config{so}; +my $dlext = $Config{dlext}; + +my $d_dosuid = $Config{d_dosuid}; +my $binexp = $Config{binexp}; + +if ($Is_VMS) { # Hang in there until File::Spec hits the big time + foreach ( \$installbin, \$installscript, \$installprivlib, + \$installarchlib, \$installsitelib, \$installsitearch, + \$installman1dir ) { + $$_ = unixify($$_); $$_ =~ s:/$::; + } +} + +# Do some quick sanity checks. + +if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } + + $installbin || die "No installbin directory in config.sh\n"; +-d $installbin || mkpath($installbin, 1, 0777); +-d $installbin || $nonono || die "$installbin is not a directory\n"; +-w $installbin || $nonono || die "$installbin is not writable by you\n" + unless $installbin =~ m#^/afs/# || $nonono; + +-x 'perl' . $exe_ext || die "perl isn't executable!\n"; +-x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid; + +-x 't/TEST' || $Is_W32 + || warn "WARNING: You've never run 'make test'!!!", + " (Installing anyway.)\n"; + +if ($Is_W32) { + +my $perldll = 'perl.' . $dlext; +$perldll = 'perlcore.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i; + +-f $perldll || die "No perl DLL built\n"; + +# Install the DLL + +safe_unlink("$installbin/$perldll"); +copy("$perldll", "$installbin/$perldll"); +chmod(0755, "$installbin/$perldll"); +} + +# This will be used to store the packlist +my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist"); + +# First we install the version-numbered executables. + +if ($Is_VMS) { + safe_unlink("$installbin/$perl$exe_ext"); + copy("perl$exe_ext", "$installbin/$perl$exe_ext"); + chmod(0755, "$installbin/$perl$exe_ext"); + safe_unlink("$installbin/${perl}shr$exe_ext"); + copy("perlshr$exe_ext", "$installbin/${perl}shr$exe_ext"); + chmod(0755, "$installbin/${perl}shr$exe_ext"); +} +elsif ($^O eq 'mpeix') { + # MPE lacks hard links and requires that executables with special + # capabilities reside in the MPE namespace. + safe_unlink("$installbin/perl$ver$exe_ext", $Config{perlpath}); + # Install the primary executable into the MPE namespace as perlpath. + copy("perl$exe_ext", $Config{perlpath}); + chmod(0755, $Config{perlpath}); + # Create a backup copy with the version number. + link($Config{perlpath}, "$installbin/perl$ver$exe_ext"); +} +elsif ($^O ne 'dos') { + safe_unlink("$installbin/$perl$ver$exe_ext"); + copy("perl$exe_ext", "$installbin/$perl$ver$exe_ext"); + chmod(0755, "$installbin/$perl$ver$exe_ext"); +} +else { + safe_unlink("$installbin/$perl.exe"); + copy("perl.exe", "$installbin/$perl.exe"); +} + +safe_unlink("$installbin/s$perl$ver$exe_ext"); +if ($d_dosuid) { + copy("suidperl$exe_ext", "$installbin/s$perl$ver$exe_ext"); + chmod(04711, "$installbin/s$perl$ver$exe_ext"); +} + +# Install library files. + +my ($do_installarchlib, $do_installprivlib) = (0, 0); + +mkpath($installprivlib, 1, 0777); +mkpath($installarchlib, 1, 0777); +mkpath($installsitelib, 1, 0777) if ($installsitelib); +mkpath($installsitearch, 1, 0777) if ($installsitearch); + +if (chdir "lib") { + $do_installarchlib = ! samepath($installarchlib, '.'); + $do_installprivlib = ! samepath($installprivlib, '.'); + $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$]/); + + if ($do_installarchlib || $do_installprivlib) { + find(\&installlib, '.'); + } + chdir ".." || die "Can't cd back to source directory: $!\n"; +} +else { + warn "Can't cd to lib to install lib files: $!\n"; +} + +# Install header files and libraries. +mkpath("$installarchlib/CORE", 1, 0777); +my @corefiles; +if ($Is_VMS) { # We did core file selection during build + my $coredir = "lib/$Config{'arch'}/$]"; + $coredir =~ tr/./_/; + @corefiles = <$coredir/*.*>; +} +else { + @corefiles = <*.h libperl*.*>; + # AIX needs perl.exp installed as well. + push(@corefiles,'perl.exp') if $^O eq 'aix'; + # If they have built sperl.o... + push(@corefiles,'sperl.o') if -f 'sperl.o'; +} +foreach my $file (@corefiles) { + # HP-UX (at least) needs to maintain execute permissions + # on dynamically-loadable libraries. So we do it for all. + copy_if_diff($file,"$installarchlib/CORE/$file") + and chmod($file =~ /\.(so|\Q$dlext\E)$/ ? 0555 : 0444, + "$installarchlib/CORE/$file"); +} + +# Install main perl executables +# Make links to ordinary names if installbin directory isn't current directory. + +if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos') && ! $Is_VMS) { + safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext"); + if ($^O eq 'mpeix') { + # MPE doesn't support hard links, so use a symlink. + # We don't want another cloned copy. + symlink($Config{perlpath}, "$installbin/perl$exe_ext"); + } else { + link("$installbin/$perl$ver$exe_ext", "$installbin/$perl$exe_ext"); + } + link("$installbin/s$perl$ver$exe_ext", "$installbin/suid$perl$exe_ext") + if $d_dosuid; +} + +# Offer to install perl in a "standard" location + +my $mainperl_is_instperl = 0; + +if (!$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR + && -w $mainperldir && ! samepath($mainperldir, $installbin)) { + my($usrbinperl) = "$mainperldir/$perl$exe_ext"; + my($instperl) = "$installbin/$perl$exe_ext"; + my($expinstperl) = "$binexp/$perl$exe_ext"; + + # First make sure $usrbinperl is not already the same as the perl we + # just installed. + if (-x $usrbinperl) { + # Try to be clever about mainperl being a symbolic link + # to binexp/perl if binexp and installbin are different. + $mainperl_is_instperl = + samepath($usrbinperl, $instperl) || + samepath($usrbinperl, $expinstperl) || + (($binexp ne $installbin) && + (-l $usrbinperl) && + ((readlink $usrbinperl) eq $expinstperl)); + } + if ((! $mainperl_is_instperl) && + (yn("Many scripts expect perl to be installed as $usrbinperl.\n" . + "Do you wish to have $usrbinperl be the same as\n" . + "$expinstperl? [y] "))) + { + unlink($usrbinperl); + ( $Config{'d_link'} eq 'define' && + eval { CORE::link $instperl, $usrbinperl } ) || + eval { symlink $expinstperl, $usrbinperl } || + copy($instperl, $usrbinperl); + + $mainperl_is_instperl = 1; + } +} + +# Make links to ordinary names if installbin directory isn't current directory. + +if (!$versiononly && ! samepath($installbin, 'x2p')) { + safe_unlink("$installbin/a2p$exe_ext"); + copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext"); + chmod(0755, "$installbin/a2p$exe_ext"); +} + +# cppstdin is just a script, but it is architecture-dependent, so +# it can't safely be shared. Place it in $installbin. +# Note that Configure doesn't build cppstin if it isn't needed, so +# we skip this if cppstdin doesn't exist. +if (! $versiononly && (-f 'cppstdin') && (! samepath($installbin, '.'))) { + safe_unlink("$installbin/cppstdin"); + copy("cppstdin", "$installbin/cppstdin"); + chmod(0755, "$installbin/cppstdin"); +} + +# Install scripts. + +mkpath($installscript, 1, 0777); + +if (! $versiononly) { + for (@scripts) { + (my $base = $_) =~ s#.*/##; + copy($_, "$installscript/$base"); + chmod(0755, "$installscript/$base"); + } +} + +# pstruct should be a link to c2ph + +if (! $versiononly) { + safe_unlink("$installscript/pstruct$scr_ext"); + if ($^O eq 'dos' or $Is_VMS) { + copy("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext"); + } else { + link("$installscript/c2ph$scr_ext", "$installscript/pstruct$scr_ext"); + } +} + +# Install pod pages. Where? I guess in $installprivlib/pod. + +if (! $versiononly || !($installprivlib =~ m/\Q$]/)) { + mkpath("${installprivlib}/pod", 1, 0777); + + # If Perl 5.003's perldiag.pod is there, rename it. + if (open POD, "${installprivlib}/pod/perldiag.pod") { + read POD, $_, 4000; + close POD; + # Some of Perl 5.003's diagnostic messages ended with periods. + if (/^=.*\.$/m) { + my ($from, $to) = ("${installprivlib}/pod/perldiag.pod", + "${installprivlib}/pod/perldiag-5.003.pod"); + print STDERR " rename $from $to"; + rename($from, $to) + or warn "Couldn't rename $from to $to: $!\n" + unless $nonono; + } + } + + foreach my $file (@pods) { + # $file is a name like pod/perl.pod + copy_if_diff($file, "${installprivlib}/${file}"); + } + +} + +# Check to make sure there aren't other perls around in installer's +# path. This is probably UNIX-specific. Check all absolute directories +# in the path except for where public executables are supposed to live. +# Also skip $mainperl if the user opted to have it be a link to the +# installed perl. + +if (!$versiononly) { + my ($path, @path); + my $dirsep = ($Is_OS2 || $Is_W32) ? ';' : ':' ; + ($path = $ENV{"PATH"}) =~ s:\\:/:g ; + @path = split(/$dirsep/, $path); + if ($Is_VMS) { + my $i = 0; + while (exists $ENV{'DCL$PATH' . $i}) { + my $dir = unixpath($ENV{'DCL$PATH' . $i}); $dir =~ s-/$--; + push(@path,$dir); + } + } + my @otherperls; + for (@path) { + next unless m,^/,; + # Use &samepath here because some systems have other dirs linked + # to $mainperldir (like SunOS) + next if samepath($_, $binexp); + next if ($mainperl_is_instperl && samepath($_, $mainperldir)); + push(@otherperls, "$_/$perl$exe_ext") + if (-x "$_/$perl$exe_ext" && ! -d "$_/$perl$exe_ext"); + } + if (@otherperls) { + print STDERR "\nWarning: $perl appears in your path in the following " . + "locations beyond where\nwe just installed it:\n"; + for (@otherperls) { + print STDERR " ", $_, "\n"; + } + print STDERR "\n"; + } + +} + +$packlist->write() unless $nonono; +print STDERR " Installation complete\n"; + +exit 0; + +############################################################################### + +sub yn { + my($prompt) = @_; + my($answer); + my($default) = $prompt =~ m/\[([yn])\]\s*$/i; + print STDERR $prompt; + chop($answer = ); + $answer = $default if $answer =~ m/^\s*$/; + ($answer =~ m/^[yY]/); +} + +sub unlink { + my(@names) = @_; + my($cnt) = 0; + + return scalar(@names) if $Is_VMS; + + foreach my $name (@names) { + next unless -e $name; + chmod 0777, $name if ($Is_OS2 || $Is_W32); + print STDERR " unlink $name\n"; + ( CORE::unlink($name) and ++$cnt + or warn "Couldn't unlink $name: $!\n" ) unless $nonono; + } + return $cnt; +} + +sub safe_unlink { + return if $nonono or $Is_VMS; + my @names = @_; + foreach my $name (@names) { + next unless -e $name; + chmod 0777, $name if ($Is_OS2 || $Is_W32); + print STDERR " unlink $name\n"; + next if CORE::unlink($name); + warn "Couldn't unlink $name: $!\n"; + if ($! =~ /busy/i) { + print STDERR " mv $name $name.old\n"; + safe_rename($name, "$name.old") + or warn "Couldn't rename $name: $!\n"; + } + } +} + +sub safe_rename { + my($from,$to) = @_; + if (-f $to and not unlink($to)) { + my($i); + for ($i = 1; $i < 50; $i++) { + last if rename($to, "$to.$i"); + } + warn("Cannot rename to `$to.$i': $!"), return 0 + if $i >= 50; # Give up! + } + link($from,$to) || return 0; + unlink($from); +} + +sub link { + my($from,$to) = @_; + my($success) = 0; + + print STDERR " ln $from $to\n"; + eval { + CORE::link($from, $to) + ? $success++ + : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) + ? die "AFS" # okay inside eval {} + : warn "Couldn't link $from to $to: $!\n" + unless $nonono; + $packlist->{$to} = { from => $from, type => 'link' }; + }; + if ($@) { + print STDERR " creating new version of $to\n" if $Is_VMS and -e $to; + File::Copy::copy($from, $to) + ? $success++ + : warn "Couldn't copy $from to $to: $!\n" + unless $nonono; + $packlist->{$to} = { type => 'file' }; + } + $success; +} + +sub chmod { + my($mode,$name) = @_; + + return if ($^O eq 'dos'); + printf STDERR " chmod %o %s\n", $mode, $name; + CORE::chmod($mode,$name) + || warn sprintf("Couldn't chmod %o %s: $!\n", $mode, $name) + unless $nonono; +} + +sub copy { + my($from,$to) = @_; + + print STDERR " cp $from $to\n"; + print STDERR " creating new version of $to\n" if $Is_VMS and -e $to; + File::Copy::copy($from, $to) + || warn "Couldn't copy $from to $to: $!\n" + unless $nonono; + $packlist->{$to} = { type => 'file' }; +} + +sub samepath { + my($p1, $p2) = @_; + + return (lc($p1) eq lc($p2)) if $Is_W32; + + if ($p1 ne $p2) { + my($dev1, $ino1, $dev2, $ino2); + ($dev1, $ino1) = stat($p1); + ($dev2, $ino2) = stat($p2); + ($dev1 == $dev2 && $ino1 == $ino2); + } + else { + 1; + } +} + +sub installlib { + my $dir = $File::Find::dir; + $dir =~ s#^\.(?![^/])/?##; + local($depth) = $dir ? "lib/$dir" : "lib"; + + my $name = $_; + + if ($name eq 'CVS' && -d $name) { + $File::Find::prune = 1; + return; + } + + # ignore patch backups and the .exists files. + return if $name =~ m{\.orig$|~$|^\.exists}; + + $name = "$dir/$name" if $dir ne ''; + + my $installlib = $installprivlib; + if ($dir =~ /^auto/ || + ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) || + ($name =~ /^(.*)\.(?:h|lib)$/i && $Is_W32) + ) { + $installlib = $installarchlib; + return unless $do_installarchlib; + } else { + return unless $do_installprivlib; + } + + if (-f $_) { + if (/\.(?:al|ix)$/ && !($dir =~ m[^auto/(.*)$] && $archpms{$1})) { + $installlib = $installprivlib; + #We're installing *.al and *.ix files into $installprivlib, + #but we have to delete old *.al and *.ix files from the 5.000 + #distribution: + #This might not work because $archname might have changed. + unlink("$installarchlib/$name"); + } + $packlist->{"$installlib/$name"} = { type => 'file' }; + if (compare($_, "$installlib/$name") || $nonono) { + unlink("$installlib/$name"); + mkpath("$installlib/$dir", 1, 0777); + # HP-UX (at least) needs to maintain execute permissions + # on dynamically-loaded libraries. + copy_if_diff($_, "$installlib/$name") + and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444, + "$installlib/$name"); + } + } elsif (-d $_) { + mkpath("$installlib/$name", 1, 0777); + } +} + +# Copy $from to $to, only if $from is different than $to. +# Also preserve modification times for .a libraries. +# On some systems, if you do +# ranlib libperl.a +# cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a +# and then try to link against the installed libperl.a, you might +# get an error message to the effect that the symbol table is older +# than the library. +# Return true if copying occurred. + +sub copy_if_diff { + my($from,$to)=@_; + return 1 if (($^O eq 'VMS') && (-d $from)); + -f $from || die "$0: $from not found"; + $packlist->{$to} = { type => 'file' }; + if (compare($from, $to) || $nonono) { + safe_unlink($to); # In case we don't have write permissions. + if ($nonono) { + $from = $depth . "/" . $from if $depth; + } + copy($from, $to); + # Restore timestamps if it's a .a library or for OS/2. + if (!$nonono && ($Is_OS2 || $to =~ /\.a$/)) { + my ($atime, $mtime) = (stat $from)[8,9]; + utime $atime, $mtime, $to; + } + 1; + } +} diff --git a/contrib/perl5/interp.sym b/contrib/perl5/interp.sym new file mode 100644 index 00000000000..fbbe2a7c9c6 --- /dev/null +++ b/contrib/perl5/interp.sym @@ -0,0 +1,211 @@ +Argv +Cmd +DBcv +DBgv +DBline +DBsignal +DBsingle +DBsub +DBtrace +ampergv +archpat_auto +argvgv +argvoutgv +basetime +beginav +bodytarget +bostr +cddir +chopset +colors +colorset +compcv +compiling +comppad +comppad_name +comppad_name_fill +comppad_name_floor +copline +curcop +curcopdb +curpm +curstack +curstash +curstname +dbargs +debdelim +debname +debstash +defgv +defoutgv +defstash +delaymagic +diehook +dirty +dlevel +dlmax +doextract +doswitches +dowarn +dumplvl +e_script +endav +envgv +errgv +eval_root +eval_start +exitlist +exitlistlen +extralen +fdpid +filemode +firstgv +forkprocess +formfeed +formtarget +generation +gensym +globalstash +hintgv +in_clean_all +in_clean_objs +in_eval +incgv +initav +inplace +bytecode_iv_overflows +sys_intern +last_in_gv +last_proto +lastfd +lastgotoprobe +lastscream +lastsize +lastspbase +laststatval +laststype +leftgv +lineary +linestart +localizing +localpatches +main_cv +main_root +main_start +mainstack +maxscream +maxsysfd +mess_sv +minus_F +minus_a +minus_c +minus_l +minus_n +minus_p +modglobal +modcount +multiline +mystrk +nrs +bytecode_obj_list +bytecode_obj_list_fill +ofmt +ofs +ofslen +oldlastpm +oldname +op_mask +origargc +origargv +origfilename +ors +orslen +parsehook +patchlevel +pending_ident +perldb +perl_destruct_level +preambled +preambleav +preprocess +profiledata +bytecode_pv +reg_eval_set +reg_flags +reg_start_tmp +reg_start_tmpl +regbol +regcc +regcode +regcompp +regexecp +regdata +regdummy +regendp +regeol +regflags +regindent +reginput +reginterp_cnt +reglastparen +regnarrate +regnaughty +regnpar +regcomp_parse +regprecomp +regprev +regprogram +regsawback +regseen +regsize +regstartp +regtill +regxend +replgv +restartop +rightgv +rs +rsfp +rsfp_filters +regcomp_rx +sawampersand +sawstudy +sawvec +screamfirst +screamnext +secondgv +seen_zerolen +seen_evals +siggv +sortcop +sortcxix +sortstash +splitstr +start_env +statcache +statgv +statname +statusvalue +statusvalue_vms +stdingv +strchop +strtab +sub_generation +sublex_info +bytecode_sv +sv_count +sv_objcount +sv_root +sv_arenaroot +tainted +tainting +threadnum +thrsv +tmps_floor +tmps_ix +tmps_max +tmps_stack +top_env +toptarget +unsafe +warnhook diff --git a/contrib/perl5/intrpvar.h b/contrib/perl5/intrpvar.h new file mode 100644 index 00000000000..dfdcca8e1c4 --- /dev/null +++ b/contrib/perl5/intrpvar.h @@ -0,0 +1,218 @@ +/***********************************************/ +/* Global only to current interpreter instance */ +/***********************************************/ + +/* Don't forget to re-run embed.pl to propagate changes! */ + +/* The 'I' prefix is only needed for vars that need appropriate #defines + * generated when built with or without MULTIPLICITY. It is also used + * to generate the appropriate export list for win32. + * + * When building without MULTIPLICITY, these variables will be truly global. + * + * Avoid build-specific #ifdefs here, like DEBUGGING. That way, + * we can keep binary compatibility of the curinterp structure */ + +/* pseudo environmental stuff */ +PERLVAR(Iorigargc, int) +PERLVAR(Iorigargv, char **) +PERLVAR(Ienvgv, GV *) +PERLVAR(Isiggv, GV *) +PERLVAR(Iincgv, GV *) +PERLVAR(Ihintgv, GV *) +PERLVAR(Iorigfilename, char *) +PERLVAR(Idiehook, SV *) +PERLVAR(Iwarnhook, SV *) +PERLVAR(Iparsehook, SV *) +PERLVAR(Icddir, char *) /* switches */ +PERLVAR(Iminus_c, bool) +PERLVAR(Ipatchlevel[10],char) +PERLVAR(Ilocalpatches, char **) +PERLVARI(Isplitstr, char *, " ") +PERLVAR(Ipreprocess, bool) +PERLVAR(Iminus_n, bool) +PERLVAR(Iminus_p, bool) +PERLVAR(Iminus_l, bool) +PERLVAR(Iminus_a, bool) +PERLVAR(Iminus_F, bool) +PERLVAR(Idoswitches, bool) +PERLVAR(Idowarn, bool) +PERLVAR(Idoextract, bool) +PERLVAR(Isawampersand, bool) /* must save all match strings */ +PERLVAR(Isawstudy, bool) /* do fbm_instr on all strings */ +PERLVAR(Isawvec, bool) +PERLVAR(Iunsafe, bool) +PERLVAR(Iinplace, char *) +PERLVAR(Ie_script, SV *) +PERLVAR(Iperldb, U32) + +/* This value may be raised by extensions for testing purposes */ +/* 0=none, 1=full, 2=full with checks */ +PERLVARI(Iperl_destruct_level, int, 0) + +/* magical thingies */ +PERLVAR(Ibasetime, Time_t) /* $^T */ +PERLVAR(Iformfeed, SV *) /* $^L */ + + +PERLVARI(Imaxsysfd, I32, MAXSYSFD) + /* top fd to pass to subprocesses */ +PERLVAR(Imultiline, int) /* $*--do strings hold >1 line? */ +PERLVAR(Istatusvalue, I32) /* $? */ +#ifdef VMS +PERLVAR(Istatusvalue_vms,U32) +#endif + +/* shortcuts to various I/O objects */ +PERLVAR(Istdingv, GV *) +PERLVAR(Idefgv, GV *) +PERLVAR(Iargvgv, GV *) +PERLVAR(Iargvoutgv, GV *) + +/* shortcuts to regexp stuff */ +/* XXX these three aren't used anywhere */ +PERLVAR(Ileftgv, GV *) +PERLVAR(Iampergv, GV *) +PERLVAR(Irightgv, GV *) + +/* this one needs to be moved to thrdvar.h and accessed via + * find_threadsv() when USE_THREADS */ +PERLVAR(Ireplgv, GV *) + +/* shortcuts to misc objects */ +PERLVAR(Ierrgv, GV *) + +/* shortcuts to debugging objects */ +PERLVAR(IDBgv, GV *) +PERLVAR(IDBline, GV *) +PERLVAR(IDBsub, GV *) +PERLVAR(IDBsingle, SV *) +PERLVAR(IDBtrace, SV *) +PERLVAR(IDBsignal, SV *) +PERLVAR(Ilineary, AV *) /* lines of script for debugger */ +PERLVAR(Idbargs, AV *) /* args to call listed by caller function */ + +/* symbol tables */ +PERLVAR(Idebstash, HV *) /* symbol table for perldb package */ +PERLVAR(Iglobalstash, HV *) /* global keyword overrides imported here */ +PERLVAR(Icurstname, SV *) /* name of current package */ +PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */ +PERLVAR(Iendav, AV *) /* names of END subroutines */ +PERLVAR(Iinitav, AV *) /* names of INIT subroutines */ +PERLVAR(Istrtab, HV *) /* shared string table */ +PERLVARI(Isub_generation,U32,1) /* incr to invalidate method cache */ + +/* memory management */ +PERLVAR(Isv_count, I32) /* how many SV* are currently allocated */ +PERLVAR(Isv_objcount, I32) /* how many objects are currently allocated */ +PERLVAR(Isv_root, SV*) /* storage for SVs belonging to interp */ +PERLVAR(Isv_arenaroot, SV*) /* list of areas for garbage collection */ + +/* funky return mechanisms */ +PERLVAR(Ilastspbase, I32) +PERLVAR(Ilastsize, I32) +PERLVAR(Iforkprocess, int) /* so do_open |- can return proc# */ + +/* subprocess state */ +PERLVAR(Ifdpid, AV *) /* keep fd-to-pid mappings for my_popen */ + +/* internal state */ +PERLVAR(Itainting, bool) /* doing taint checks */ +PERLVARI(Iop_mask, char *, NULL) /* masked operations for safe evals */ +PERLVAR(Ilast_proto, char *) /* Prototype of last sub seen. */ + +/* trace state */ +PERLVAR(Idlevel, I32) +PERLVARI(Idlmax, I32, 128) +PERLVAR(Idebname, char *) +PERLVAR(Idebdelim, char *) + +/* current interpreter roots */ +PERLVAR(Imain_cv, CV *) +PERLVAR(Imain_root, OP *) +PERLVAR(Imain_start, OP *) +PERLVAR(Ieval_root, OP *) +PERLVAR(Ieval_start, OP *) + +/* runtime control stuff */ +PERLVARI(Icurcopdb, COP *, NULL) +PERLVARI(Icopline, line_t, NOLINE) + +/* statics moved here for shared library purposes */ +PERLVAR(Istrchop, SV) /* return value from chop */ +PERLVAR(Ifilemode, int) /* so nextargv() can preserve mode */ +PERLVAR(Ilastfd, int) /* what to preserve mode on */ +PERLVAR(Ioldname, char *) /* what to preserve mode on */ +PERLVAR(IArgv, char **) /* stuff to free from do_aexec, vfork safe */ +PERLVAR(ICmd, char *) /* stuff to free from do_aexec, vfork safe */ +PERLVAR(Imystrk, SV *) /* temp key string for do_each() */ +PERLVAR(Idumplvl, I32) /* indentation level on syntax tree dump */ +PERLVAR(Ioldlastpm, PMOP *) /* for saving regexp context in debugger */ +PERLVAR(Igensym, I32) /* next symbol for getsym() to define */ +PERLVAR(Ipreambled, bool) +PERLVAR(Ipreambleav, AV *) +PERLVARI(Ilaststatval, int, -1) +PERLVARI(Ilaststype, I32, OP_STAT) +PERLVAR(Imess_sv, SV *) + +/* XXX shouldn't these be per-thread? --GSAR */ +PERLVAR(Iors, char *) /* output record separator $\ */ +PERLVAR(Iorslen, STRLEN) +PERLVAR(Iofmt, char *) /* output format for numbers $# */ + +/* interpreter atexit processing */ +PERLVARI(Iexitlist, PerlExitListEntry *, NULL) + /* list of exit functions */ +PERLVARI(Iexitlistlen, I32, 0) /* length of same */ +PERLVAR(Imodglobal, HV *) /* per-interp module data */ + +/* these used to be in global before 5.004_68 */ +PERLVARI(Iprofiledata, U32 *, NULL) /* table of ops, counts */ +PERLVARI(Irsfp, PerlIO * VOL, Nullfp) /* current source file pointer */ +PERLVARI(Irsfp_filters, AV *, Nullav) /* keeps active source filters */ + +PERLVAR(Icompiling, COP) /* compiling/done executing marker */ + +PERLVAR(Icompcv, CV *) /* currently compiling subroutine */ +PERLVAR(Icomppad, AV *) /* storage for lexically scoped temporaries */ +PERLVAR(Icomppad_name, AV *) /* variable names for "my" variables */ +PERLVAR(Icomppad_name_fill, I32) /* last "introduced" variable offset */ +PERLVAR(Icomppad_name_floor, I32) /* start of vars in innermost block */ + +#ifdef HAVE_INTERP_INTERN +PERLVAR(Isys_intern, struct interp_intern) + /* platform internals */ +#endif + +/* more statics moved here */ +PERLVARI(Igeneration, int, 100) /* from op.c */ +PERLVAR(IDBcv, CV *) /* from perl.c */ +PERLVAR(Iarchpat_auto, char*) /* from perl.c */ + +PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */ +PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */ + +PERLVAR(Ilinestart, char *) /* beg. of most recently read line */ +PERLVAR(Ipending_ident, char) /* pending identifier lookup */ +PERLVAR(Isublex_info, SUBLEXINFO) /* from toke.c */ + +#ifdef USE_THREADS +PERLVAR(Ithrsv, SV *) /* struct perl_thread for main thread */ +PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ +#endif /* USE_THREADS */ + +PERLVARI(Ibytecode_iv_overflows,int, 0) /* from bytecode.h */ +PERLVAR(Ibytecode_sv, SV *) +PERLVAR(Ibytecode_pv, XPV) +PERLVAR(Ibytecode_obj_list, void **) +PERLVARI(Ibytecode_obj_list_fill, I32, -1) + +#ifdef PERL_OBJECT +PERLVARI(piMem, IPerlMem*, NULL) +PERLVARI(piENV, IPerlEnv*, NULL) +PERLVARI(piStdIO, IPerlStdIO*, NULL) +PERLVARI(piLIO, IPerlLIO*, NULL) +PERLVARI(piDir, IPerlDir*, NULL) +PERLVARI(piSock, IPerlSock*, NULL) +PERLVARI(piProc, IPerlProc*, NULL) +#endif diff --git a/contrib/perl5/iperlsys.h b/contrib/perl5/iperlsys.h new file mode 100644 index 00000000000..91389a2b7b5 --- /dev/null +++ b/contrib/perl5/iperlsys.h @@ -0,0 +1,930 @@ +/* + * iperlsys.h - Perl's interface to the system + * + * This file defines the system level functionality that perl needs. + * + * When using C, this definition is in the form of a set of macros + * that can be #defined to the system-level function (or a wrapper + * provided elsewhere). + * + * When using C++ with -DPERL_OBJECT, this definition is in the + * form of a set of virtual base classes which must be subclassed to + * provide a real implementation. The Perl Object will use instances + * of this implementation to use the system-level functionality. + * + * GSAR 21-JUN-98 + */ + +#ifndef __Inc__IPerl___ +#define __Inc__IPerl___ + +/* + * PerlXXX_YYY explained - DickH and DougL @ ActiveState.com + * + * XXX := functional group + * YYY := stdlib/OS function name + * + * Continuing with the theme of PerlIO, all OS functionality was + * encapsulated into one of several interfaces. + * + * PerlIO - stdio + * PerlLIO - low level I/O + * PerlMem - malloc, realloc, free + * PerlDir - directory related + * PerlEnv - process environment handling + * PerlProc - process control + * PerlSock - socket functions + * + * + * The features of this are: + * 1. All OS dependant code is in the Perl Host and not the Perl Core. + * (At least this is the holy grail goal of this work) + * 2. The Perl Host (see perl.h for description) can provide a new and + * improved interface to OS functionality if required. + * 3. Developers can easily hook into the OS calls for instrumentation + * or diagnostic purposes. + * + * What was changed to do this: + * 1. All calls to OS functions were replaced with PerlXXX_YYY + * + */ + + +/* + Interface for perl stdio functions +*/ + + +/* Clean up (or at least document) the various possible #defines. + This section attempts to match the 5.003_03 Configure variables + onto the 5.003_02 header file values. + I can't figure out where USE_STDIO was supposed to be set. + --AD +*/ +#ifndef USE_PERLIO +# define PERLIO_IS_STDIO +#endif + +/* Below is the 5.003_02 stuff. */ +#ifdef USE_STDIO +# ifndef PERLIO_IS_STDIO +# define PERLIO_IS_STDIO +# endif +#else +extern void PerlIO_init _((void)); +#endif + +#ifdef PERL_OBJECT + +#ifndef PerlIO +typedef struct _PerlIO PerlIO; +#endif + +class IPerlStdIO +{ +public: + virtual PerlIO * Stdin(void) = 0; + virtual PerlIO * Stdout(void) = 0; + virtual PerlIO * Stderr(void) = 0; + virtual PerlIO * Open(const char *, const char *, int &err) = 0; + virtual int Close(PerlIO*, int &err) = 0; + virtual int Eof(PerlIO*, int &err) = 0; + virtual int Error(PerlIO*, int &err) = 0; + virtual void Clearerr(PerlIO*, int &err) = 0; + virtual int Getc(PerlIO*, int &err) = 0; + virtual char * GetBase(PerlIO *, int &err) = 0; + virtual int GetBufsiz(PerlIO *, int &err) = 0; + virtual int GetCnt(PerlIO *, int &err) = 0; + virtual char * GetPtr(PerlIO *, int &err) = 0; + virtual char * Gets(PerlIO*, char*, int, int& err) = 0; + virtual int Putc(PerlIO*, int, int &err) = 0; + virtual int Puts(PerlIO*, const char *, int &err) = 0; + virtual int Flush(PerlIO*, int &err) = 0; + virtual int Ungetc(PerlIO*,int, int &err) = 0; + virtual int Fileno(PerlIO*, int &err) = 0; + virtual PerlIO * Fdopen(int, const char *, int &err) = 0; + virtual PerlIO * Reopen(const char*, const char*, PerlIO*, int &err) = 0; + virtual SSize_t Read(PerlIO*,void *,Size_t, int &err) = 0; + virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err) = 0; + virtual void SetBuf(PerlIO *, char*, int &err) = 0; + virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err) = 0; + virtual void SetCnt(PerlIO *, int, int &err) = 0; + virtual void SetPtrCnt(PerlIO *, char *, int, int& err) = 0; + virtual void Setlinebuf(PerlIO*, int &err) = 0; + virtual int Printf(PerlIO*, int &err, const char *,...) = 0; + virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0; + virtual long Tell(PerlIO*, int &err) = 0; + virtual int Seek(PerlIO*, off_t, int, int &err) = 0; + virtual void Rewind(PerlIO*, int &err) = 0; + virtual PerlIO * Tmpfile(int &err) = 0; + virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0; + virtual int Setpos(PerlIO*, const Fpos_t *, int &err) = 0; + virtual void Init(int &err) = 0; + virtual void InitOSExtras(void* p) = 0; +#ifdef WIN32 + virtual int OpenOSfhandle(long osfhandle, int flags) = 0; + virtual int GetOSfhandle(int filenum) = 0; +#endif +}; + + + +#ifdef USE_STDIO_PTR +# define PerlIO_has_cntptr(f) 1 +# ifdef STDIO_CNT_LVALUE +# define PerlIO_canset_cnt(f) 1 +# ifdef STDIO_PTR_LVALUE +# define PerlIO_fast_gets(f) 1 +# endif +# else +# define PerlIO_canset_cnt(f) 0 +# endif +#else /* USE_STDIO_PTR */ +# define PerlIO_has_cntptr(f) 0 +# define PerlIO_canset_cnt(f) 0 +#endif /* USE_STDIO_PTR */ + +#ifndef PerlIO_fast_gets +#define PerlIO_fast_gets(f) 0 +#endif + +#ifdef FILE_base +#define PerlIO_has_base(f) 1 +#else +#define PerlIO_has_base(f) 0 +#endif + +#define PerlIO_stdin() PL_piStdIO->Stdin() +#define PerlIO_stdout() PL_piStdIO->Stdout() +#define PerlIO_stderr() PL_piStdIO->Stderr() +#define PerlIO_open(x,y) PL_piStdIO->Open((x),(y), ErrorNo()) +#define PerlIO_close(f) PL_piStdIO->Close((f), ErrorNo()) +#define PerlIO_eof(f) PL_piStdIO->Eof((f), ErrorNo()) +#define PerlIO_error(f) PL_piStdIO->Error((f), ErrorNo()) +#define PerlIO_clearerr(f) PL_piStdIO->Clearerr((f), ErrorNo()) +#define PerlIO_getc(f) PL_piStdIO->Getc((f), ErrorNo()) +#define PerlIO_get_base(f) PL_piStdIO->GetBase((f), ErrorNo()) +#define PerlIO_get_bufsiz(f) PL_piStdIO->GetBufsiz((f), ErrorNo()) +#define PerlIO_get_cnt(f) PL_piStdIO->GetCnt((f), ErrorNo()) +#define PerlIO_get_ptr(f) PL_piStdIO->GetPtr((f), ErrorNo()) +#define PerlIO_putc(f,c) PL_piStdIO->Putc((f),(c), ErrorNo()) +#define PerlIO_puts(f,s) PL_piStdIO->Puts((f),(s), ErrorNo()) +#define PerlIO_flush(f) PL_piStdIO->Flush((f), ErrorNo()) +#define PerlIO_gets(s, n, fp) PL_piStdIO->Gets((fp), s, n, ErrorNo()) +#define PerlIO_ungetc(f,c) PL_piStdIO->Ungetc((f),(c), ErrorNo()) +#define PerlIO_fileno(f) PL_piStdIO->Fileno((f), ErrorNo()) +#define PerlIO_fdopen(f, s) PL_piStdIO->Fdopen((f),(s), ErrorNo()) +#define PerlIO_reopen(p, m, f) PL_piStdIO->Reopen((p), (m), (f), ErrorNo()) +#define PerlIO_read(f,buf,count) \ + (SSize_t)PL_piStdIO->Read((f), (buf), (count), ErrorNo()) +#define PerlIO_write(f,buf,count) \ + PL_piStdIO->Write((f), (buf), (count), ErrorNo()) +#define PerlIO_setbuf(f,b) PL_piStdIO->SetBuf((f), (b), ErrorNo()) +#define PerlIO_setvbuf(f,b,t,s) PL_piStdIO->SetVBuf((f), (b), (t), (s), ErrorNo()) +#define PerlIO_set_cnt(f,c) PL_piStdIO->SetCnt((f), (c), ErrorNo()) +#define PerlIO_set_ptrcnt(f,p,c) \ + PL_piStdIO->SetPtrCnt((f), (p), (c), ErrorNo()) +#define PerlIO_setlinebuf(f) PL_piStdIO->Setlinebuf((f), ErrorNo()) +#define PerlIO_printf fprintf +#define PerlIO_stdoutf PL_piStdIO->Printf +#define PerlIO_vprintf(f,fmt,a) PL_piStdIO->Vprintf((f), ErrorNo(), (fmt),a) +#define PerlIO_tell(f) PL_piStdIO->Tell((f), ErrorNo()) +#define PerlIO_seek(f,o,w) PL_piStdIO->Seek((f),(o),(w), ErrorNo()) +#define PerlIO_getpos(f,p) PL_piStdIO->Getpos((f),(p), ErrorNo()) +#define PerlIO_setpos(f,p) PL_piStdIO->Setpos((f),(p), ErrorNo()) +#define PerlIO_rewind(f) PL_piStdIO->Rewind((f), ErrorNo()) +#define PerlIO_tmpfile() PL_piStdIO->Tmpfile(ErrorNo()) +#define PerlIO_init() PL_piStdIO->Init(ErrorNo()) +#undef init_os_extras +#define init_os_extras() PL_piStdIO->InitOSExtras(this) + +#else /* PERL_OBJECT */ + +#include "perlsdio.h" + +#endif /* PERL_OBJECT */ + +#ifndef PERLIO_IS_STDIO +#ifdef USE_SFIO +#include "perlsfio.h" +#endif /* USE_SFIO */ +#endif /* PERLIO_IS_STDIO */ + +#ifndef EOF +#define EOF (-1) +#endif + +/* This is to catch case with no stdio */ +#ifndef BUFSIZ +#define BUFSIZ 1024 +#endif + +#ifndef SEEK_SET +#define SEEK_SET 0 +#endif + +#ifndef SEEK_CUR +#define SEEK_CUR 1 +#endif + +#ifndef SEEK_END +#define SEEK_END 2 +#endif + +#ifndef PerlIO +struct _PerlIO; +#define PerlIO struct _PerlIO +#endif /* No PerlIO */ + +#ifndef Fpos_t +#define Fpos_t long +#endif + +#ifndef NEXT30_NO_ATTRIBUTE +#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ +#ifdef __attribute__ /* Avoid possible redefinition errors */ +#undef __attribute__ +#endif +#define __attribute__(attr) +#endif +#endif + +#ifndef PerlIO_stdoutf +extern int PerlIO_stdoutf _((const char *,...)) + __attribute__((format (printf, 1, 2))); +#endif +#ifndef PerlIO_puts +extern int PerlIO_puts _((PerlIO *,const char *)); +#endif +#ifndef PerlIO_open +extern PerlIO * PerlIO_open _((const char *,const char *)); +#endif +#ifndef PerlIO_close +extern int PerlIO_close _((PerlIO *)); +#endif +#ifndef PerlIO_eof +extern int PerlIO_eof _((PerlIO *)); +#endif +#ifndef PerlIO_error +extern int PerlIO_error _((PerlIO *)); +#endif +#ifndef PerlIO_clearerr +extern void PerlIO_clearerr _((PerlIO *)); +#endif +#ifndef PerlIO_getc +extern int PerlIO_getc _((PerlIO *)); +#endif +#ifndef PerlIO_putc +extern int PerlIO_putc _((PerlIO *,int)); +#endif +#ifndef PerlIO_flush +extern int PerlIO_flush _((PerlIO *)); +#endif +#ifndef PerlIO_ungetc +extern int PerlIO_ungetc _((PerlIO *,int)); +#endif +#ifndef PerlIO_fileno +extern int PerlIO_fileno _((PerlIO *)); +#endif +#ifndef PerlIO_fdopen +extern PerlIO * PerlIO_fdopen _((int, const char *)); +#endif +#ifndef PerlIO_importFILE +extern PerlIO * PerlIO_importFILE _((FILE *,int)); +#endif +#ifndef PerlIO_exportFILE +extern FILE * PerlIO_exportFILE _((PerlIO *,int)); +#endif +#ifndef PerlIO_findFILE +extern FILE * PerlIO_findFILE _((PerlIO *)); +#endif +#ifndef PerlIO_releaseFILE +extern void PerlIO_releaseFILE _((PerlIO *,FILE *)); +#endif +#ifndef PerlIO_read +extern SSize_t PerlIO_read _((PerlIO *,void *,Size_t)); +#endif +#ifndef PerlIO_write +extern SSize_t PerlIO_write _((PerlIO *,const void *,Size_t)); +#endif +#ifndef PerlIO_setlinebuf +extern void PerlIO_setlinebuf _((PerlIO *)); +#endif +#ifndef PerlIO_printf +extern int PerlIO_printf _((PerlIO *, const char *,...)) + __attribute__((format (printf, 2, 3))); +#endif +#ifndef PerlIO_sprintf +extern int PerlIO_sprintf _((char *, int, const char *,...)) + __attribute__((format (printf, 3, 4))); +#endif +#ifndef PerlIO_vprintf +extern int PerlIO_vprintf _((PerlIO *, const char *, va_list)); +#endif +#ifndef PerlIO_tell +extern long PerlIO_tell _((PerlIO *)); +#endif +#ifndef PerlIO_seek +extern int PerlIO_seek _((PerlIO *,off_t,int)); +#endif +#ifndef PerlIO_rewind +extern void PerlIO_rewind _((PerlIO *)); +#endif +#ifndef PerlIO_has_base +extern int PerlIO_has_base _((PerlIO *)); +#endif +#ifndef PerlIO_has_cntptr +extern int PerlIO_has_cntptr _((PerlIO *)); +#endif +#ifndef PerlIO_fast_gets +extern int PerlIO_fast_gets _((PerlIO *)); +#endif +#ifndef PerlIO_canset_cnt +extern int PerlIO_canset_cnt _((PerlIO *)); +#endif +#ifndef PerlIO_get_ptr +extern STDCHAR * PerlIO_get_ptr _((PerlIO *)); +#endif +#ifndef PerlIO_get_cnt +extern int PerlIO_get_cnt _((PerlIO *)); +#endif +#ifndef PerlIO_set_cnt +extern void PerlIO_set_cnt _((PerlIO *,int)); +#endif +#ifndef PerlIO_set_ptrcnt +extern void PerlIO_set_ptrcnt _((PerlIO *,STDCHAR *,int)); +#endif +#ifndef PerlIO_get_base +extern STDCHAR * PerlIO_get_base _((PerlIO *)); +#endif +#ifndef PerlIO_get_bufsiz +extern int PerlIO_get_bufsiz _((PerlIO *)); +#endif +#ifndef PerlIO_tmpfile +extern PerlIO * PerlIO_tmpfile _((void)); +#endif +#ifndef PerlIO_stdin +extern PerlIO * PerlIO_stdin _((void)); +#endif +#ifndef PerlIO_stdout +extern PerlIO * PerlIO_stdout _((void)); +#endif +#ifndef PerlIO_stderr +extern PerlIO * PerlIO_stderr _((void)); +#endif +#ifndef PerlIO_getpos +extern int PerlIO_getpos _((PerlIO *,Fpos_t *)); +#endif +#ifndef PerlIO_setpos +extern int PerlIO_setpos _((PerlIO *,const Fpos_t *)); +#endif + + +/* + * Interface for directory functions + */ + +#ifdef PERL_OBJECT + +class IPerlDir +{ +public: + virtual int Makedir(const char *dirname, int mode, int &err) = 0; + virtual int Chdir(const char *dirname, int &err) = 0; + virtual int Rmdir(const char *dirname, int &err) = 0; + virtual int Close(DIR *dirp, int &err) = 0; + virtual DIR * Open(char *filename, int &err) = 0; + virtual struct direct *Read(DIR *dirp, int &err) = 0; + virtual void Rewind(DIR *dirp, int &err) = 0; + virtual void Seek(DIR *dirp, long loc, int &err) = 0; + virtual long Tell(DIR *dirp, int &err) = 0; +}; + +#define PerlDir_mkdir(name, mode) \ + PL_piDir->Makedir((name), (mode), ErrorNo()) +#define PerlDir_chdir(name) \ + PL_piDir->Chdir((name), ErrorNo()) +#define PerlDir_rmdir(name) \ + PL_piDir->Rmdir((name), ErrorNo()) +#define PerlDir_close(dir) \ + PL_piDir->Close((dir), ErrorNo()) +#define PerlDir_open(name) \ + PL_piDir->Open((name), ErrorNo()) +#define PerlDir_read(dir) \ + PL_piDir->Read((dir), ErrorNo()) +#define PerlDir_rewind(dir) \ + PL_piDir->Rewind((dir), ErrorNo()) +#define PerlDir_seek(dir, loc) \ + PL_piDir->Seek((dir), (loc), ErrorNo()) +#define PerlDir_tell(dir) \ + PL_piDir->Tell((dir), ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlDir_mkdir(name, mode) Mkdir((name), (mode)) +#ifdef VMS +# define PerlDir_chdir(n) chdir(((n) && *(n)) ? (n) : "SYS$LOGIN") +#else +# define PerlDir_chdir(name) chdir((name)) +#endif +#define PerlDir_rmdir(name) rmdir((name)) +#define PerlDir_close(dir) closedir((dir)) +#define PerlDir_open(name) opendir((name)) +#define PerlDir_read(dir) readdir((dir)) +#define PerlDir_rewind(dir) rewinddir((dir)) +#define PerlDir_seek(dir, loc) seekdir((dir), (loc)) +#define PerlDir_tell(dir) telldir((dir)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl environment functions +*/ + +#ifdef PERL_OBJECT + +class IPerlEnv +{ +public: + virtual char * Getenv(const char *varname, int &err) = 0; + virtual int Putenv(const char *envstring, int &err) = 0; + virtual char * LibPath(char *patchlevel) =0; + virtual char * SiteLibPath(char *patchlevel) =0; +}; + +#define PerlEnv_putenv(str) PL_piENV->Putenv((str), ErrorNo()) +#define PerlEnv_getenv(str) PL_piENV->Getenv((str), ErrorNo()) +#ifdef WIN32 +#define PerlEnv_lib_path(str) PL_piENV->LibPath((str)) +#define PerlEnv_sitelib_path(str) PL_piENV->SiteLibPath((str)) +#endif + +#else /* PERL_OBJECT */ + +#define PerlEnv_putenv(str) putenv((str)) +#define PerlEnv_getenv(str) getenv((str)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl low-level IO functions +*/ + +#ifdef PERL_OBJECT + +class IPerlLIO +{ +public: + virtual int Access(const char *path, int mode, int &err) = 0; + virtual int Chmod(const char *filename, int pmode, int &err) = 0; + virtual int Chown(const char *filename, uid_t owner, + gid_t group, int &err) = 0; + virtual int Chsize(int handle, long size, int &err) = 0; + virtual int Close(int handle, int &err) = 0; + virtual int Dup(int handle, int &err) = 0; + virtual int Dup2(int handle1, int handle2, int &err) = 0; + virtual int Flock(int fd, int oper, int &err) = 0; + virtual int FileStat(int handle, struct stat *buffer, int &err) = 0; + virtual int IOCtl(int i, unsigned int u, char *data, int &err) = 0; + virtual int Isatty(int handle, int &err) = 0; + virtual long Lseek(int handle, long offset, int origin, int &err) = 0; + virtual int Lstat(const char *path, struct stat *buffer, int &err) = 0; + virtual char * Mktemp(char *Template, int &err) = 0; + virtual int Open(const char *filename, int oflag, int &err) = 0; + virtual int Open(const char *filename, int oflag, + int pmode, int &err) = 0; + virtual int Read(int handle, void *buffer, + unsigned int count, int &err) = 0; + virtual int Rename(const char *oname, + const char *newname, int &err) = 0; + virtual int Setmode(int handle, int mode, int &err) = 0; + virtual int NameStat(const char *path, + struct stat *buffer, int &err) = 0; + virtual char * Tmpnam(char *string, int &err) = 0; + virtual int Umask(int pmode, int &err) = 0; + virtual int Unlink(const char *filename, int &err) = 0; + virtual int Utime(char *filename, struct utimbuf *times, int &err) = 0; + virtual int Write(int handle, const void *buffer, + unsigned int count, int &err) = 0; +}; + +#define PerlLIO_access(file, mode) \ + PL_piLIO->Access((file), (mode), ErrorNo()) +#define PerlLIO_chmod(file, mode) \ + PL_piLIO->Chmod((file), (mode), ErrorNo()) +#define PerlLIO_chown(file, owner, group) \ + PL_piLIO->Chown((file), (owner), (group), ErrorNo()) +#define PerlLIO_chsize(fd, size) \ + PL_piLIO->Chsize((fd), (size), ErrorNo()) +#define PerlLIO_close(fd) \ + PL_piLIO->Close((fd), ErrorNo()) +#define PerlLIO_dup(fd) \ + PL_piLIO->Dup((fd), ErrorNo()) +#define PerlLIO_dup2(fd1, fd2) \ + PL_piLIO->Dup2((fd1), (fd2), ErrorNo()) +#define PerlLIO_flock(fd, op) \ + PL_piLIO->Flock((fd), (op), ErrorNo()) +#define PerlLIO_fstat(fd, buf) \ + PL_piLIO->FileStat((fd), (buf), ErrorNo()) +#define PerlLIO_ioctl(fd, u, buf) \ + PL_piLIO->IOCtl((fd), (u), (buf), ErrorNo()) +#define PerlLIO_isatty(fd) \ + PL_piLIO->Isatty((fd), ErrorNo()) +#define PerlLIO_lseek(fd, offset, mode) \ + PL_piLIO->Lseek((fd), (offset), (mode), ErrorNo()) +#define PerlLIO_lstat(name, buf) \ + PL_piLIO->Lstat((name), (buf), ErrorNo()) +#define PerlLIO_mktemp(file) \ + PL_piLIO->Mktemp((file), ErrorNo()) +#define PerlLIO_open(file, flag) \ + PL_piLIO->Open((file), (flag), ErrorNo()) +#define PerlLIO_open3(file, flag, perm) \ + PL_piLIO->Open((file), (flag), (perm), ErrorNo()) +#define PerlLIO_read(fd, buf, count) \ + PL_piLIO->Read((fd), (buf), (count), ErrorNo()) +#define PerlLIO_rename(oname, newname) \ + PL_piLIO->Rename((oname), (newname), ErrorNo()) +#define PerlLIO_setmode(fd, mode) \ + PL_piLIO->Setmode((fd), (mode), ErrorNo()) +#define PerlLIO_stat(name, buf) \ + PL_piLIO->NameStat((name), (buf), ErrorNo()) +#define PerlLIO_tmpnam(str) \ + PL_piLIO->Tmpnam((str), ErrorNo()) +#define PerlLIO_umask(mode) \ + PL_piLIO->Umask((mode), ErrorNo()) +#define PerlLIO_unlink(file) \ + PL_piLIO->Unlink((file), ErrorNo()) +#define PerlLIO_utime(file, time) \ + PL_piLIO->Utime((file), (time), ErrorNo()) +#define PerlLIO_write(fd, buf, count) \ + PL_piLIO->Write((fd), (buf), (count), ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlLIO_access(file, mode) access((file), (mode)) +#define PerlLIO_chmod(file, mode) chmod((file), (mode)) +#define PerlLIO_chown(file, owner, grp) chown((file), (owner), (grp)) +#define PerlLIO_chsize(fd, size) chsize((fd), (size)) +#define PerlLIO_close(fd) close((fd)) +#define PerlLIO_dup(fd) dup((fd)) +#define PerlLIO_dup2(fd1, fd2) dup2((fd1), (fd2)) +#define PerlLIO_flock(fd, op) FLOCK((fd), (op)) +#define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) +#define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) +#define PerlLIO_isatty(fd) isatty((fd)) +#define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) +#define PerlLIO_lstat(name, buf) lstat((name), (buf)) +#define PerlLIO_mktemp(file) mktemp((file)) +#define PerlLIO_mkstemp(file) mkstemp((file)) +#define PerlLIO_open(file, flag) open((file), (flag)) +#define PerlLIO_open3(file, flag, perm) open((file), (flag), (perm)) +#define PerlLIO_read(fd, buf, count) read((fd), (buf), (count)) +#define PerlLIO_rename(old, new) rename((old), (new)) +#define PerlLIO_setmode(fd, mode) setmode((fd), (mode)) +#define PerlLIO_stat(name, buf) Stat((name), (buf)) +#define PerlLIO_tmpnam(str) tmpnam((str)) +#define PerlLIO_umask(mode) umask((mode)) +#define PerlLIO_unlink(file) unlink((file)) +#define PerlLIO_utime(file, time) utime((file), (time)) +#define PerlLIO_write(fd, buf, count) write((fd), (buf), (count)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl memory allocation +*/ + +#ifdef PERL_OBJECT + +class IPerlMem +{ +public: + virtual void * Malloc(size_t) = 0; + virtual void * Realloc(void*, size_t) = 0; + virtual void Free(void*) = 0; +}; + +#define PerlMem_malloc(size) PL_piMem->Malloc((size)) +#define PerlMem_realloc(buf, size) PL_piMem->Realloc((buf), (size)) +#define PerlMem_free(buf) PL_piMem->Free((buf)) + +#else /* PERL_OBJECT */ + +#define PerlMem_malloc(size) malloc((size)) +#define PerlMem_realloc(buf, size) realloc((buf), (size)) +#define PerlMem_free(buf) free((buf)) + +#endif /* PERL_OBJECT */ + +/* + Interface for perl process functions +*/ + + +#ifdef PERL_OBJECT + +#ifndef Sighandler_t +typedef Signal_t (*Sighandler_t) _((int)); +#endif +#ifndef jmp_buf +#include +#endif + +class IPerlProc +{ +public: + virtual void Abort(void) = 0; + virtual char * Crypt(const char* clear, const char* salt) = 0; + virtual void Exit(int status) = 0; + virtual void _Exit(int status) = 0; + virtual int Execl(const char *cmdname, const char *arg0, + const char *arg1, const char *arg2, + const char *arg3) = 0; + virtual int Execv(const char *cmdname, const char *const *argv) = 0; + virtual int Execvp(const char *cmdname, const char *const *argv) = 0; + virtual uid_t Getuid(void) = 0; + virtual uid_t Geteuid(void) = 0; + virtual gid_t Getgid(void) = 0; + virtual gid_t Getegid(void) = 0; + virtual char * Getlogin(void) = 0; + virtual int Kill(int pid, int sig) = 0; + virtual int Killpg(int pid, int sig) = 0; + virtual int PauseProc(void) = 0; + virtual PerlIO * Popen(const char *command, const char *mode) = 0; + virtual int Pclose(PerlIO *stream) = 0; + virtual int Pipe(int *phandles) = 0; + virtual int Setuid(uid_t uid) = 0; + virtual int Setgid(gid_t gid) = 0; + virtual int Sleep(unsigned int) = 0; + virtual int Times(struct tms *timebuf) = 0; + virtual int Wait(int *status) = 0; + virtual int Waitpid(int pid, int *status, int flags) = 0; + virtual Sighandler_t Signal(int sig, Sighandler_t subcode) = 0; +#ifdef WIN32 + virtual void GetSysMsg(char*& msg, DWORD& dwLen, DWORD dwErr) = 0; + virtual void FreeBuf(char* msg) = 0; + virtual BOOL DoCmd(char *cmd) = 0; + virtual int Spawn(char*cmds) = 0; + virtual int Spawnvp(int mode, const char *cmdname, + const char *const *argv) = 0; + virtual int ASpawn(void *vreally, void **vmark, void **vsp) = 0; +#endif +}; + +#define PerlProc_abort() PL_piProc->Abort() +#define PerlProc_crypt(c,s) PL_piProc->Crypt((c), (s)) +#define PerlProc_exit(s) PL_piProc->Exit((s)) +#define PerlProc__exit(s) PL_piProc->_Exit((s)) +#define PerlProc_execl(c, w, x, y, z) \ + PL_piProc->Execl((c), (w), (x), (y), (z)) + +#define PerlProc_execv(c, a) PL_piProc->Execv((c), (a)) +#define PerlProc_execvp(c, a) PL_piProc->Execvp((c), (a)) +#define PerlProc_getuid() PL_piProc->Getuid() +#define PerlProc_geteuid() PL_piProc->Geteuid() +#define PerlProc_getgid() PL_piProc->Getgid() +#define PerlProc_getegid() PL_piProc->Getegid() +#define PerlProc_getlogin() PL_piProc->Getlogin() +#define PerlProc_kill(i, a) PL_piProc->Kill((i), (a)) +#define PerlProc_killpg(i, a) PL_piProc->Killpg((i), (a)) +#define PerlProc_pause() PL_piProc->PauseProc() +#define PerlProc_popen(c, m) PL_piProc->Popen((c), (m)) +#define PerlProc_pclose(f) PL_piProc->Pclose((f)) +#define PerlProc_pipe(fd) PL_piProc->Pipe((fd)) +#define PerlProc_setuid(u) PL_piProc->Setuid((u)) +#define PerlProc_setgid(g) PL_piProc->Setgid((g)) +#define PerlProc_sleep(t) PL_piProc->Sleep((t)) +#define PerlProc_times(t) PL_piProc->Times((t)) +#define PerlProc_wait(t) PL_piProc->Wait((t)) +#define PerlProc_waitpid(p,s,f) PL_piProc->Waitpid((p), (s), (f)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) PL_piProc->Signal((n), (h)) + +#ifdef WIN32 +#define PerlProc_GetSysMsg(s,l,e) \ + PL_piProc->GetSysMsg((s), (l), (e)) + +#define PerlProc_FreeBuf(s) PL_piProc->FreeBuf((s)) +#define PerlProc_Cmd(s) PL_piProc->DoCmd((s)) +#define do_spawn(s) PL_piProc->Spawn((s)) +#define do_spawnvp(m, c, a) PL_piProc->Spawnvp((m), (c), (a)) +#define PerlProc_aspawn(m,c,a) PL_piProc->ASpawn((m), (c), (a)) +#endif + +#else /* PERL_OBJECT */ + +#define PerlProc_abort() abort() +#define PerlProc_crypt(c,s) crypt((c), (s)) +#define PerlProc_exit(s) exit((s)) +#define PerlProc__exit(s) _exit((s)) +#define PerlProc_execl(c,w,x,y,z) \ + execl((c), (w), (x), (y), (z)) +#define PerlProc_execv(c, a) execv((c), (a)) +#define PerlProc_execvp(c, a) execvp((c), (a)) +#define PerlProc_getuid() getuid() +#define PerlProc_geteuid() geteuid() +#define PerlProc_getgid() getgid() +#define PerlProc_getegid() getegid() +#define PerlProc_getlogin() getlogin() +#define PerlProc_kill(i, a) kill((i), (a)) +#define PerlProc_killpg(i, a) killpg((i), (a)) +#define PerlProc_pause() Pause() +#define PerlProc_popen(c, m) my_popen((c), (m)) +#define PerlProc_pclose(f) my_pclose((f)) +#define PerlProc_pipe(fd) pipe((fd)) +#define PerlProc_setuid(u) setuid((u)) +#define PerlProc_setgid(g) setgid((g)) +#define PerlProc_sleep(t) sleep((t)) +#define PerlProc_times(t) times((t)) +#define PerlProc_wait(t) wait((t)) +#define PerlProc_waitpid(p,s,f) waitpid((p), (s), (f)) +#define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) +#define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) +#define PerlProc_signal(n, h) signal((n), (h)) + + +#endif /* PERL_OBJECT */ + +/* + Interface for perl socket functions +*/ + +#ifdef PERL_OBJECT + +class IPerlSock +{ +public: + virtual u_long Htonl(u_long hostlong) = 0; + virtual u_short Htons(u_short hostshort) = 0; + virtual u_long Ntohl(u_long netlong) = 0; + virtual u_short Ntohs(u_short netshort) = 0; + virtual SOCKET Accept(SOCKET s, struct sockaddr* addr, + int* addrlen, int &err) = 0; + virtual int Bind(SOCKET s, const struct sockaddr* name, + int namelen, int &err) = 0; + virtual int Connect(SOCKET s, const struct sockaddr* name, + int namelen, int &err) = 0; + virtual void Endhostent(int &err) = 0; + virtual void Endnetent(int &err) = 0; + virtual void Endprotoent(int &err) = 0; + virtual void Endservent(int &err) = 0; + virtual int Gethostname(char* name, int namelen, int &err) = 0; + virtual int Getpeername(SOCKET s, struct sockaddr* name, + int* namelen, int &err) = 0; + virtual struct hostent * Gethostbyaddr(const char* addr, int len, + int type, int &err) = 0; + virtual struct hostent * Gethostbyname(const char* name, int &err) = 0; + virtual struct hostent * Gethostent(int &err) = 0; + virtual struct netent * Getnetbyaddr(long net, int type, int &err) = 0; + virtual struct netent * Getnetbyname(const char *, int &err) = 0; + virtual struct netent * Getnetent(int &err) = 0; + virtual struct protoent * Getprotobyname(const char* name, int &err) = 0; + virtual struct protoent * Getprotobynumber(int number, int &err) = 0; + virtual struct protoent * Getprotoent(int &err) = 0; + virtual struct servent * Getservbyname(const char* name, + const char* proto, int &err) = 0; + virtual struct servent * Getservbyport(int port, const char* proto, + int &err) = 0; + virtual struct servent * Getservent(int &err) = 0; + virtual int Getsockname(SOCKET s, struct sockaddr* name, + int* namelen, int &err) = 0; + virtual int Getsockopt(SOCKET s, int level, int optname, + char* optval, int* optlen, int &err) = 0; + virtual unsigned long InetAddr(const char* cp, int &err) = 0; + virtual char * InetNtoa(struct in_addr in, int &err) = 0; + virtual int Listen(SOCKET s, int backlog, int &err) = 0; + virtual int Recv(SOCKET s, char* buf, int len, + int flags, int &err) = 0; + virtual int Recvfrom(SOCKET s, char* buf, int len, int flags, + struct sockaddr* from, int* fromlen, int &err) = 0; + virtual int Select(int nfds, char* readfds, char* writefds, + char* exceptfds, const struct timeval* timeout, + int &err) = 0; + virtual int Send(SOCKET s, const char* buf, int len, + int flags, int &err) = 0; + virtual int Sendto(SOCKET s, const char* buf, int len, int flags, + const struct sockaddr* to, int tolen, int &err) = 0; + virtual void Sethostent(int stayopen, int &err) = 0; + virtual void Setnetent(int stayopen, int &err) = 0; + virtual void Setprotoent(int stayopen, int &err) = 0; + virtual void Setservent(int stayopen, int &err) = 0; + virtual int Setsockopt(SOCKET s, int level, int optname, + const char* optval, int optlen, int &err) = 0; + virtual int Shutdown(SOCKET s, int how, int &err) = 0; + virtual SOCKET Socket(int af, int type, int protocol, int &err) = 0; + virtual int Socketpair(int domain, int type, int protocol, + int* fds, int &err) = 0; +#ifdef WIN32 + virtual int Closesocket(SOCKET s, int& err) = 0; + virtual int Ioctlsocket(SOCKET s, long cmd, u_long *argp, + int& err) = 0; +#endif +}; + +#define PerlSock_htonl(x) PL_piSock->Htonl(x) +#define PerlSock_htons(x) PL_piSock->Htons(x) +#define PerlSock_ntohl(x) PL_piSock->Ntohl(x) +#define PerlSock_ntohs(x) PL_piSock->Ntohs(x) +#define PerlSock_accept(s, a, l) PL_piSock->Accept(s, a, l, ErrorNo()) +#define PerlSock_bind(s, n, l) PL_piSock->Bind(s, n, l, ErrorNo()) +#define PerlSock_connect(s, n, l) PL_piSock->Connect(s, n, l, ErrorNo()) +#define PerlSock_endhostent() PL_piSock->Endhostent(ErrorNo()) +#define PerlSock_endnetent() PL_piSock->Endnetent(ErrorNo()) +#define PerlSock_endprotoent() PL_piSock->Endprotoent(ErrorNo()) +#define PerlSock_endservent() PL_piSock->Endservent(ErrorNo()) +#define PerlSock_gethostbyaddr(a, l, t) PL_piSock->Gethostbyaddr(a, l, t, ErrorNo()) +#define PerlSock_gethostbyname(n) PL_piSock->Gethostbyname(n, ErrorNo()) +#define PerlSock_gethostent() PL_piSock->Gethostent(ErrorNo()) +#define PerlSock_gethostname(n, l) PL_piSock->Gethostname(n, l, ErrorNo()) +#define PerlSock_getnetbyaddr(n, t) PL_piSock->Getnetbyaddr(n, t, ErrorNo()) +#define PerlSock_getnetbyname(c) PL_piSock->Getnetbyname(c, ErrorNo()) +#define PerlSock_getnetent() PL_piSock->Getnetent(ErrorNo()) +#define PerlSock_getpeername(s, n, l) PL_piSock->Getpeername(s, n, l, ErrorNo()) +#define PerlSock_getprotobyname(n) PL_piSock->Getprotobyname(n, ErrorNo()) +#define PerlSock_getprotobynumber(n) PL_piSock->Getprotobynumber(n, ErrorNo()) +#define PerlSock_getprotoent() PL_piSock->Getprotoent(ErrorNo()) +#define PerlSock_getservbyname(n, p) PL_piSock->Getservbyname(n, p, ErrorNo()) +#define PerlSock_getservbyport(port, p) PL_piSock->Getservbyport(port, p, ErrorNo()) +#define PerlSock_getservent() PL_piSock->Getservent(ErrorNo()) +#define PerlSock_getsockname(s, n, l) PL_piSock->Getsockname(s, n, l, ErrorNo()) +#define PerlSock_getsockopt(s,l,n,v,i) PL_piSock->Getsockopt(s, l, n, v, i, ErrorNo()) +#define PerlSock_inet_addr(c) PL_piSock->InetAddr(c, ErrorNo()) +#define PerlSock_inet_ntoa(i) PL_piSock->InetNtoa(i, ErrorNo()) +#define PerlSock_listen(s, b) PL_piSock->Listen(s, b, ErrorNo()) +#define PerlSock_recv(s, b, l, f) PL_piSock->Recv(s, b, l, f, ErrorNo()) +#define PerlSock_recvfrom(s,b,l,f,from,fromlen) \ + PL_piSock->Recvfrom(s, b, l, f, from, fromlen, ErrorNo()) +#define PerlSock_select(n, r, w, e, t) \ + PL_piSock->Select(n, (char*)r, (char*)w, (char*)e, t, ErrorNo()) +#define PerlSock_send(s, b, l, f) PL_piSock->Send(s, b, l, f, ErrorNo()) +#define PerlSock_sendto(s, b, l, f, t, tlen) \ + PL_piSock->Sendto(s, b, l, f, t, tlen, ErrorNo()) +#define PerlSock_sethostent(f) PL_piSock->Sethostent(f, ErrorNo()) +#define PerlSock_setnetent(f) PL_piSock->Setnetent(f, ErrorNo()) +#define PerlSock_setprotoent(f) PL_piSock->Setprotoent(f, ErrorNo()) +#define PerlSock_setservent(f) PL_piSock->Setservent(f, ErrorNo()) +#define PerlSock_setsockopt(s, l, n, v, len) \ + PL_piSock->Setsockopt(s, l, n, v, len, ErrorNo()) +#define PerlSock_shutdown(s, h) PL_piSock->Shutdown(s, h, ErrorNo()) +#define PerlSock_socket(a, t, p) PL_piSock->Socket(a, t, p, ErrorNo()) +#define PerlSock_socketpair(a, t, p, f) PL_piSock->Socketpair(a, t, p, f, ErrorNo()) + +#else /* PERL_OBJECT */ + +#define PerlSock_htonl(x) htonl(x) +#define PerlSock_htons(x) htons(x) +#define PerlSock_ntohl(x) ntohl(x) +#define PerlSock_ntohs(x) ntohs(x) +#define PerlSock_accept(s, a, l) accept(s, a, l) +#define PerlSock_bind(s, n, l) bind(s, n, l) +#define PerlSock_connect(s, n, l) connect(s, n, l) + +#define PerlSock_gethostbyaddr(a, l, t) gethostbyaddr(a, l, t) +#define PerlSock_gethostbyname(n) gethostbyname(n) +#define PerlSock_gethostent gethostent +#define PerlSock_endhostent endhostent +#define PerlSock_gethostname(n, l) gethostname(n, l) + +#define PerlSock_getnetbyaddr(n, t) getnetbyaddr(n, t) +#define PerlSock_getnetbyname(n) getnetbyname(n) +#define PerlSock_getnetent getnetent +#define PerlSock_endnetent endnetent +#define PerlSock_getpeername(s, n, l) getpeername(s, n, l) + +#define PerlSock_getprotobyname(n) getprotobyname(n) +#define PerlSock_getprotobynumber(n) getprotobynumber(n) +#define PerlSock_getprotoent getprotoent +#define PerlSock_endprotoent endprotoent + +#define PerlSock_getservbyname(n, p) getservbyname(n, p) +#define PerlSock_getservbyport(port, p) getservbyport(port, p) +#define PerlSock_getservent getservent +#define PerlSock_endservent endservent + +#define PerlSock_getsockname(s, n, l) getsockname(s, n, l) +#define PerlSock_getsockopt(s,l,n,v,i) getsockopt(s, l, n, v, i) +#define PerlSock_inet_addr(c) inet_addr(c) +#define PerlSock_inet_ntoa(i) inet_ntoa(i) +#define PerlSock_listen(s, b) listen(s, b) +#define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ + recvfrom(s, b, l, f, from, fromlen) +#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) +#define PerlSock_send(s, b, l, f) send(s, b, l, f) +#define PerlSock_sendto(s, b, l, f, t, tlen) \ + sendto(s, b, l, f, t, tlen) +#define PerlSock_sethostent(f) sethostent(f) +#define PerlSock_setnetent(f) setnetent(f) +#define PerlSock_setprotoent(f) setprotoent(f) +#define PerlSock_setservent(f) setservent(f) +#define PerlSock_setsockopt(s, l, n, v, len) \ + setsockopt(s, l, n, v, len) +#define PerlSock_shutdown(s, h) shutdown(s, h) +#define PerlSock_socket(a, t, p) socket(a, t, p) +#define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) + + +#endif /* PERL_OBJECT */ + +#endif /* __Inc__IPerl___ */ + diff --git a/contrib/perl5/keywords.h b/contrib/perl5/keywords.h new file mode 100644 index 00000000000..e8188311488 --- /dev/null +++ b/contrib/perl5/keywords.h @@ -0,0 +1,250 @@ +#define KEY_NULL 0 +#define KEY___FILE__ 1 +#define KEY___LINE__ 2 +#define KEY___PACKAGE__ 3 +#define KEY___DATA__ 4 +#define KEY___END__ 5 +#define KEY_AUTOLOAD 6 +#define KEY_BEGIN 7 +#define KEY_CORE 8 +#define KEY_DESTROY 9 +#define KEY_END 10 +#define KEY_EQ 11 +#define KEY_GE 12 +#define KEY_GT 13 +#define KEY_INIT 14 +#define KEY_LE 15 +#define KEY_LT 16 +#define KEY_NE 17 +#define KEY_abs 18 +#define KEY_accept 19 +#define KEY_alarm 20 +#define KEY_and 21 +#define KEY_atan2 22 +#define KEY_bind 23 +#define KEY_binmode 24 +#define KEY_bless 25 +#define KEY_caller 26 +#define KEY_chdir 27 +#define KEY_chmod 28 +#define KEY_chomp 29 +#define KEY_chop 30 +#define KEY_chown 31 +#define KEY_chr 32 +#define KEY_chroot 33 +#define KEY_close 34 +#define KEY_closedir 35 +#define KEY_cmp 36 +#define KEY_connect 37 +#define KEY_continue 38 +#define KEY_cos 39 +#define KEY_crypt 40 +#define KEY_dbmclose 41 +#define KEY_dbmopen 42 +#define KEY_defined 43 +#define KEY_delete 44 +#define KEY_die 45 +#define KEY_do 46 +#define KEY_dump 47 +#define KEY_each 48 +#define KEY_else 49 +#define KEY_elsif 50 +#define KEY_endgrent 51 +#define KEY_endhostent 52 +#define KEY_endnetent 53 +#define KEY_endprotoent 54 +#define KEY_endpwent 55 +#define KEY_endservent 56 +#define KEY_eof 57 +#define KEY_eq 58 +#define KEY_eval 59 +#define KEY_exec 60 +#define KEY_exists 61 +#define KEY_exit 62 +#define KEY_exp 63 +#define KEY_fcntl 64 +#define KEY_fileno 65 +#define KEY_flock 66 +#define KEY_for 67 +#define KEY_foreach 68 +#define KEY_fork 69 +#define KEY_format 70 +#define KEY_formline 71 +#define KEY_ge 72 +#define KEY_getc 73 +#define KEY_getgrent 74 +#define KEY_getgrgid 75 +#define KEY_getgrnam 76 +#define KEY_gethostbyaddr 77 +#define KEY_gethostbyname 78 +#define KEY_gethostent 79 +#define KEY_getlogin 80 +#define KEY_getnetbyaddr 81 +#define KEY_getnetbyname 82 +#define KEY_getnetent 83 +#define KEY_getpeername 84 +#define KEY_getpgrp 85 +#define KEY_getppid 86 +#define KEY_getpriority 87 +#define KEY_getprotobyname 88 +#define KEY_getprotobynumber 89 +#define KEY_getprotoent 90 +#define KEY_getpwent 91 +#define KEY_getpwnam 92 +#define KEY_getpwuid 93 +#define KEY_getservbyname 94 +#define KEY_getservbyport 95 +#define KEY_getservent 96 +#define KEY_getsockname 97 +#define KEY_getsockopt 98 +#define KEY_glob 99 +#define KEY_gmtime 100 +#define KEY_goto 101 +#define KEY_grep 102 +#define KEY_gt 103 +#define KEY_hex 104 +#define KEY_if 105 +#define KEY_index 106 +#define KEY_int 107 +#define KEY_ioctl 108 +#define KEY_join 109 +#define KEY_keys 110 +#define KEY_kill 111 +#define KEY_last 112 +#define KEY_lc 113 +#define KEY_lcfirst 114 +#define KEY_le 115 +#define KEY_length 116 +#define KEY_link 117 +#define KEY_listen 118 +#define KEY_local 119 +#define KEY_localtime 120 +#define KEY_lock 121 +#define KEY_log 122 +#define KEY_lstat 123 +#define KEY_lt 124 +#define KEY_m 125 +#define KEY_map 126 +#define KEY_mkdir 127 +#define KEY_msgctl 128 +#define KEY_msgget 129 +#define KEY_msgrcv 130 +#define KEY_msgsnd 131 +#define KEY_my 132 +#define KEY_ne 133 +#define KEY_next 134 +#define KEY_no 135 +#define KEY_not 136 +#define KEY_oct 137 +#define KEY_open 138 +#define KEY_opendir 139 +#define KEY_or 140 +#define KEY_ord 141 +#define KEY_pack 142 +#define KEY_package 143 +#define KEY_pipe 144 +#define KEY_pop 145 +#define KEY_pos 146 +#define KEY_print 147 +#define KEY_printf 148 +#define KEY_prototype 149 +#define KEY_push 150 +#define KEY_q 151 +#define KEY_qq 152 +#define KEY_qr 153 +#define KEY_quotemeta 154 +#define KEY_qw 155 +#define KEY_qx 156 +#define KEY_rand 157 +#define KEY_read 158 +#define KEY_readdir 159 +#define KEY_readline 160 +#define KEY_readlink 161 +#define KEY_readpipe 162 +#define KEY_recv 163 +#define KEY_redo 164 +#define KEY_ref 165 +#define KEY_rename 166 +#define KEY_require 167 +#define KEY_reset 168 +#define KEY_return 169 +#define KEY_reverse 170 +#define KEY_rewinddir 171 +#define KEY_rindex 172 +#define KEY_rmdir 173 +#define KEY_s 174 +#define KEY_scalar 175 +#define KEY_seek 176 +#define KEY_seekdir 177 +#define KEY_select 178 +#define KEY_semctl 179 +#define KEY_semget 180 +#define KEY_semop 181 +#define KEY_send 182 +#define KEY_setgrent 183 +#define KEY_sethostent 184 +#define KEY_setnetent 185 +#define KEY_setpgrp 186 +#define KEY_setpriority 187 +#define KEY_setprotoent 188 +#define KEY_setpwent 189 +#define KEY_setservent 190 +#define KEY_setsockopt 191 +#define KEY_shift 192 +#define KEY_shmctl 193 +#define KEY_shmget 194 +#define KEY_shmread 195 +#define KEY_shmwrite 196 +#define KEY_shutdown 197 +#define KEY_sin 198 +#define KEY_sleep 199 +#define KEY_socket 200 +#define KEY_socketpair 201 +#define KEY_sort 202 +#define KEY_splice 203 +#define KEY_split 204 +#define KEY_sprintf 205 +#define KEY_sqrt 206 +#define KEY_srand 207 +#define KEY_stat 208 +#define KEY_study 209 +#define KEY_sub 210 +#define KEY_substr 211 +#define KEY_symlink 212 +#define KEY_syscall 213 +#define KEY_sysopen 214 +#define KEY_sysread 215 +#define KEY_sysseek 216 +#define KEY_system 217 +#define KEY_syswrite 218 +#define KEY_tell 219 +#define KEY_telldir 220 +#define KEY_tie 221 +#define KEY_tied 222 +#define KEY_time 223 +#define KEY_times 224 +#define KEY_tr 225 +#define KEY_truncate 226 +#define KEY_uc 227 +#define KEY_ucfirst 228 +#define KEY_umask 229 +#define KEY_undef 230 +#define KEY_unless 231 +#define KEY_unlink 232 +#define KEY_unpack 233 +#define KEY_unshift 234 +#define KEY_untie 235 +#define KEY_until 236 +#define KEY_use 237 +#define KEY_utime 238 +#define KEY_values 239 +#define KEY_vec 240 +#define KEY_wait 241 +#define KEY_waitpid 242 +#define KEY_wantarray 243 +#define KEY_warn 244 +#define KEY_while 245 +#define KEY_write 246 +#define KEY_x 247 +#define KEY_xor 248 +#define KEY_y 249 diff --git a/contrib/perl5/keywords.pl b/contrib/perl5/keywords.pl new file mode 100755 index 00000000000..f907e3f115c --- /dev/null +++ b/contrib/perl5/keywords.pl @@ -0,0 +1,276 @@ +#!/usr/bin/perl + +unlink "keywords.h"; +open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n"; +select KW; + +# Read & print data. + +$keynum = 0; +while () { + chop; + next unless $_; + next if /^#/; + ($keyword) = split; + print &tab(5, "#define KEY_$keyword"), $keynum++, "\n"; +} + +########################################################################### +sub tab { + local($l, $t) = @_; + $t .= "\t" x ($l - (length($t) + 1) / 8); + $t; +} +########################################################################### +__END__ + +NULL +__FILE__ +__LINE__ +__PACKAGE__ +__DATA__ +__END__ +AUTOLOAD +BEGIN +CORE +DESTROY +END +EQ +GE +GT +INIT +LE +LT +NE +abs +accept +alarm +and +atan2 +bind +binmode +bless +caller +chdir +chmod +chomp +chop +chown +chr +chroot +close +closedir +cmp +connect +continue +cos +crypt +dbmclose +dbmopen +defined +delete +die +do +dump +each +else +elsif +endgrent +endhostent +endnetent +endprotoent +endpwent +endservent +eof +eq +eval +exec +exists +exit +exp +fcntl +fileno +flock +for +foreach +fork +format +formline +ge +getc +getgrent +getgrgid +getgrnam +gethostbyaddr +gethostbyname +gethostent +getlogin +getnetbyaddr +getnetbyname +getnetent +getpeername +getpgrp +getppid +getpriority +getprotobyname +getprotobynumber +getprotoent +getpwent +getpwnam +getpwuid +getservbyname +getservbyport +getservent +getsockname +getsockopt +glob +gmtime +goto +grep +gt +hex +if +index +int +ioctl +join +keys +kill +last +lc +lcfirst +le +length +link +listen +local +localtime +lock +log +lstat +lt +m +map +mkdir +msgctl +msgget +msgrcv +msgsnd +my +ne +next +no +not +oct +open +opendir +or +ord +pack +package +pipe +pop +pos +print +printf +prototype +push +q +qq +qr +quotemeta +qw +qx +rand +read +readdir +readline +readlink +readpipe +recv +redo +ref +rename +require +reset +return +reverse +rewinddir +rindex +rmdir +s +scalar +seek +seekdir +select +semctl +semget +semop +send +setgrent +sethostent +setnetent +setpgrp +setpriority +setprotoent +setpwent +setservent +setsockopt +shift +shmctl +shmget +shmread +shmwrite +shutdown +sin +sleep +socket +socketpair +sort +splice +split +sprintf +sqrt +srand +stat +study +sub +substr +symlink +syscall +sysopen +sysread +sysseek +system +syswrite +tell +telldir +tie +tied +time +times +tr +truncate +uc +ucfirst +umask +undef +unless +unlink +unpack +unshift +untie +until +use +utime +values +vec +wait +waitpid +wantarray +warn +while +write +x +xor +y diff --git a/contrib/perl5/lib/AnyDBM_File.pm b/contrib/perl5/lib/AnyDBM_File.pm new file mode 100644 index 00000000000..aff3c7cdec9 --- /dev/null +++ b/contrib/perl5/lib/AnyDBM_File.pm @@ -0,0 +1,92 @@ +package AnyDBM_File; + +use vars qw(@ISA); +@ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA; + +my $mod; +for $mod (@ISA) { + if (eval "require $mod") { + @ISA = ($mod); # if we leave @ISA alone, warnings abound + return 1; + } +} + +die "No DBM package was successfully found or installed"; +#return 0; + +=head1 NAME + +AnyDBM_File - provide framework for multiple DBMs + +NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations + +=head1 SYNOPSIS + + use AnyDBM_File; + +=head1 DESCRIPTION + +This module is a "pure virtual base class"--it has nothing of its own. +It's just there to inherit from one of the various DBM packages. It +prefers ndbm for compatibility reasons with Perl 4, then Berkeley DB (See +L), GDBM, SDBM (which is always there--it comes with Perl), and +finally ODBM. This way old programs that used to use NDBM via dbmopen() +can still do so, but new ones can reorder @ISA: + + BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } + use AnyDBM_File; + +Having multiple DBM implementations makes it trivial to copy database formats: + + use POSIX; use NDBM_File; use DB_File; + tie %newhash, 'DB_File', $new_filename, O_CREAT|O_RDWR; + tie %oldhash, 'NDBM_File', $old_filename, 1, 0; + %newhash = %oldhash; + +=head2 DBM Comparisons + +Here's a partial table of features the different packages offer: + + odbm ndbm sdbm gdbm bsd-db + ---- ---- ---- ---- ------ + Linkage comes w/ perl yes yes yes yes yes + Src comes w/ perl no no yes no no + Comes w/ many unix os yes yes[0] no no no + Builds ok on !unix ? ? yes yes ? + Code Size ? ? small big big + Database Size ? ? small big? ok[1] + Speed ? ? slow ok fast + FTPable no no yes yes yes + Easy to build N/A N/A yes yes ok[2] + Size limits 1k 4k 1k[3] none none + Byte-order independent no no no no yes + Licensing restrictions ? ? no yes no + + +=over 4 + +=item [0] + +on mixed universe machines, may be in the bsd compat library, +which is often shunned. + +=item [1] + +Can be trimmed if you compile for one access method. + +=item [2] + +See L. +Requires symbolic links. + +=item [3] + +By default, but can be redefined. + +=back + +=head1 SEE ALSO + +dbm(3), ndbm(3), DB_File(3) + +=cut diff --git a/contrib/perl5/lib/AutoLoader.pm b/contrib/perl5/lib/AutoLoader.pm new file mode 100644 index 00000000000..666c6cacf92 --- /dev/null +++ b/contrib/perl5/lib/AutoLoader.pm @@ -0,0 +1,295 @@ +package AutoLoader; + +use vars qw(@EXPORT @EXPORT_OK); + +my $is_dosish; +my $is_vms; + +BEGIN { + require Exporter; + @EXPORT = (); + @EXPORT_OK = qw(AUTOLOAD); + $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32'; + $is_vms = $^O eq 'VMS'; +} + +AUTOLOAD { + my $name; + # Braces used to preserve $1 et al. + { + # Try to find the autoloaded file from the package-qualified + # name of the sub. e.g., if the sub needed is + # Getopt::Long::GetOptions(), then $INC{Getopt/Long.pm} is + # something like '/usr/lib/perl5/Getopt/Long.pm', and the + # autoload file is '/usr/lib/perl5/auto/Getopt/Long/GetOptions.al'. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then $INC{Getopt/Long.pm} is + # 'lib/Getopt/Long.pm', and we want to require + # 'auto/Getopt/Long/GetOptions.al' (without the leading 'lib'). + # In this case, we simple prepend the 'auto/' and let the + # C take care of the searching for us. + + my ($pkg,$func) = $AUTOLOAD =~ /(.*)::([^:]+)$/; + $pkg =~ s#::#/#g; + if (defined($name=$INC{"$pkg.pm"})) { + $name =~ s#^(.*)$pkg\.pm$#$1auto/$pkg/$func.al#; + + # if the file exists, then make sure that it is a + # a fully anchored path (i.e either '/usr/lib/auto/foo/bar.al', + # or './lib/auto/foo/bar.al'. This avoids C searching + # (and failing) to find the 'lib/auto/foo/bar.al' because it + # looked for 'lib/lib/auto/foo/bar.al', given @INC = ('lib'). + + if (-r $name) { + unless ($name =~ m|^/|) { + if ($is_dosish) { + unless ($name =~ m{^([a-z]:)?[\\/]}i) { + $name = "./$name"; + } + } + elsif ($is_vms) { + # XXX todo by VMSmiths + $name = "./$name"; + } + else { + $name = "./$name"; + } + } + } + else { + $name = undef; + } + } + unless (defined $name) { + # let C do the searching + $name = "auto/$AUTOLOAD.al"; + $name =~ s#::#/#g; + } + } + my $save = $@; + eval { local $SIG{__DIE__}; require $name }; + if ($@) { + if (substr($AUTOLOAD,-9) eq '::DESTROY') { + *$AUTOLOAD = sub {}; + } else { + # The load might just have failed because the filename was too + # long for some old SVR3 systems which treat long names as errors. + # If we can succesfully truncate a long name then it's worth a go. + # There is a slight risk that we could pick up the wrong file here + # but autosplit should have warned about that when splitting. + if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ + eval {local $SIG{__DIE__};require $name}; + } + if ($@){ + $@ =~ s/ at .*\n//; + my $error = $@; + require Carp; + Carp::croak($error); + } + } + } + $@ = $save; + goto &$AUTOLOAD; +} + +sub import { + my $pkg = shift; + my $callpkg = caller; + + # + # Export symbols, but not by accident of inheritance. + # + + Exporter::export $pkg, $callpkg, @_ if $pkg eq 'AutoLoader'; + + # + # Try to find the autosplit index file. Eg., if the call package + # is POSIX, then $INC{POSIX.pm} is something like + # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in + # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then + # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require + # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). + # + + (my $calldir = $callpkg) =~ s#::#/#g; + my $path = $INC{$calldir . '.pm'}; + if (defined($path)) { + # Try absolute path name. + $path =~ s#^(.*)$calldir\.pm$#$1auto/$calldir/autosplit.ix#; + eval { require $path; }; + # If that failed, try relative path with normal @INC searching. + if ($@) { + $path ="auto/$calldir/autosplit.ix"; + eval { require $path; }; + } + if ($@) { + my $error = $@; + require Carp; + Carp::carp($error); + } + } +} + +1; + +__END__ + +=head1 NAME + +AutoLoader - load subroutines only on demand + +=head1 SYNOPSIS + + package Foo; + use AutoLoader 'AUTOLOAD'; # import the default AUTOLOAD subroutine + + package Bar; + use AutoLoader; # don't import AUTOLOAD, define our own + sub AUTOLOAD { + ... + $AutoLoader::AUTOLOAD = "..."; + goto &AutoLoader::AUTOLOAD; + } + +=head1 DESCRIPTION + +The B module works with the B module and the +C<__END__> token to defer the loading of some subroutines until they are +used rather than loading them all at once. + +To use B, the author of a module has to place the +definitions of subroutines to be autoloaded after an C<__END__> token. +(See L.) The B module can then be run manually to +extract the definitions into individual files F. + +B implements an AUTOLOAD subroutine. When an undefined +subroutine in is called in a client module of B, +B's AUTOLOAD subroutine attempts to locate the subroutine in a +file with a name related to the location of the file from which the +client module was read. As an example, if F is located in +F, B will look for perl +subroutines B in F, where +the C<.al> file has the same name as the subroutine, sans package. If +such a file exists, AUTOLOAD will read and evaluate it, +thus (presumably) defining the needed subroutine. AUTOLOAD will then +C the newly defined subroutine. + +Once this process completes for a given funtion, it is defined, so +future calls to the subroutine will bypass the AUTOLOAD mechanism. + +=head2 Subroutine Stubs + +In order for object method lookup and/or prototype checking to operate +correctly even when methods have not yet been defined it is necessary to +"forward declare" each subroutine (as in C). See +L. Such forward declaration creates "subroutine +stubs", which are place holders with no code. + +The AutoSplit and B modules automate the creation of forward +declarations. The AutoSplit module creates an 'index' file containing +forward declarations of all the AutoSplit subroutines. When the +AutoLoader module is 'use'd it loads these declarations into its callers +package. + +Because of this mechanism it is important that B is always +Cd and not Cd. + +=head2 Using B's AUTOLOAD Subroutine + +In order to use B's AUTOLOAD subroutine you I +explicitly import it: + + use AutoLoader 'AUTOLOAD'; + +=head2 Overriding B's AUTOLOAD Subroutine + +Some modules, mainly extensions, provide their own AUTOLOAD subroutines. +They typically need to check for some special cases (such as constants) +and then fallback to B's AUTOLOAD for the rest. + +Such modules should I import B's AUTOLOAD subroutine. +Instead, they should define their own AUTOLOAD subroutines along these +lines: + + use AutoLoader; + use Carp; + + sub AUTOLOAD { + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined constant $constname"; + } + } + *$AUTOLOAD = sub { $val }; # same as: eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; + } + +If any module's own AUTOLOAD subroutine has no need to fallback to the +AutoLoader's AUTOLOAD subroutine (because it doesn't have any AutoSplit +subroutines), then that module should not use B at all. + +=head2 Package Lexicals + +Package lexicals declared with C in the main block of a package +using B will not be visible to auto-loaded subroutines, due to +the fact that the given scope ends at the C<__END__> marker. A module +using such variables as package globals will not work properly under the +B. + +The C pragma (see L) may be used in such +situations as an alternative to explicitly qualifying all globals with +the package namespace. Variables pre-declared with this pragma will be +visible to any autoloaded routines (but will not be invisible outside +the package, unfortunately). + +=head2 B vs. B + +The B is similar in purpose to B: both delay the +loading of subroutines. + +B uses the C<__DATA__> marker rather than C<__END__>. +While this avoids the use of a hierarchy of disk files and the +associated open/close for each routine loaded, B suffers a +startup speed disadvantage in the one-time parsing of the lines after +C<__DATA__>, after which routines are cached. B can also +handle multiple packages in a file. + +B only reads code as it is requested, and in many cases +should be faster, but requires a machanism like B be used to +create the individual files. L will invoke +B automatically if B is used in a module source +file. + +=head1 CAVEATS + +AutoLoaders prior to Perl 5.002 had a slightly different interface. Any +old modules which use B should be changed to the new calling +style. Typically this just means changing a require to a use, adding +the explicit C<'AUTOLOAD'> import if needed, and removing B +from C<@ISA>. + +On systems with restrictions on file name length, the file corresponding +to a subroutine may have a shorter name that the routine itself. This +can lead to conflicting file names. The I package warns of +these potential conflicts when used to split a module. + +AutoLoader may fail to find the autosplit files (or even find the wrong +ones) in cases where C<@INC> contains relative paths, B the program +does C. + +=head1 SEE ALSO + +L - an autoloader that doesn't use external files. + +=cut diff --git a/contrib/perl5/lib/AutoSplit.pm b/contrib/perl5/lib/AutoSplit.pm new file mode 100644 index 00000000000..121d26154d3 --- /dev/null +++ b/contrib/perl5/lib/AutoSplit.pm @@ -0,0 +1,461 @@ +package AutoSplit; + +use Exporter (); +use Config qw(%Config); +use Carp qw(carp); +use File::Basename (); +use File::Path qw(mkpath); +use strict; +use vars qw( + $VERSION @ISA @EXPORT @EXPORT_OK + $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime + ); + +$VERSION = "1.0302"; +@ISA = qw(Exporter); +@EXPORT = qw(&autosplit &autosplit_lib_modules); +@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime); + +=head1 NAME + +AutoSplit - split a package for autoloading + +=head1 SYNOPSIS + + autosplit($file, $dir, $keep, $check, $modtime); + + autosplit_lib_modules(@modules); + +=head1 DESCRIPTION + +This function will split up your program into files that the AutoLoader +module can handle. It is used by both the standard perl libraries and by +the MakeMaker utility, to automatically configure libraries for autoloading. + +The C interface splits the specified file into a hierarchy +rooted at the directory C<$dir>. It creates directories as needed to reflect +class hierarchy, and creates the file F. This file acts as +both forward declaration of all package routines, and as timestamp for the +last update of the hierarchy. + +The remaining three arguments to C govern other options to +the autosplitter. + +=over 2 + +=item $keep + +If the third argument, I<$keep>, is false, then any +pre-existing C<*.al> files in the autoload directory are removed if +they are no longer part of the module (obsoleted functions). +$keep defaults to 0. + +=item $check + +The +fourth argument, I<$check>, instructs C to check the module +currently being split to ensure that it does include a C +specification for the AutoLoader module, and skips the module if +AutoLoader is not detected. +$check defaults to 1. + +=item $modtime + +Lastly, the I<$modtime> argument specifies +that C is to check the modification time of the module +against that of the C file, and only split the module if +it is newer. +$modtime defaults to 1. + +=back + +Typical use of AutoSplit in the perl MakeMaker utility is via the command-line +with: + + perl -e 'use AutoSplit; autosplit($ARGV[0], $ARGV[1], 0, 1, 1)' + +Defined as a Make macro, it is invoked with file and directory arguments; +C will split the specified file into the specified directory and +delete obsolete C<.al> files, after checking first that the module does use +the AutoLoader, and ensuring that the module is not already currently split +in its current form (the modtime test). + +The C form is used in the building of perl. It takes +as input a list of files (modules) that are assumed to reside in a directory +B relative to the current directory. Each file is sent to the +autosplitter one at a time, to be split into the directory B. + +In both usages of the autosplitter, only subroutines defined following the +perl I<__END__> token are split out into separate files. Some +routines may be placed prior to this marker to force their immediate loading +and parsing. + +=head2 Multiple packages + +As of version 1.01 of the AutoSplit module it is possible to have +multiple packages within a single file. Both of the following cases +are supported: + + package NAME; + __END__ + sub AAA { ... } + package NAME::option1; + sub BBB { ... } + package NAME::option2; + sub BBB { ... } + + package NAME; + __END__ + sub AAA { ... } + sub NAME::option1::BBB { ... } + sub NAME::option2::BBB { ... } + +=head1 DIAGNOSTICS + +C will inform the user if it is necessary to create the +top-level directory specified in the invocation. It is preferred that +the script or installation process that invokes C have +created the full directory path ahead of time. This warning may +indicate that the module is being split into an incorrect path. + +C will warn the user of all subroutines whose name causes +potential file naming conflicts on machines with drastically limited +(8 characters or less) file name length. Since the subroutine name is +used as the file name, these warnings can aid in portability to such +systems. + +Warnings are issued and the file skipped if C cannot locate +either the I<__END__> marker or a "package Name;"-style specification. + +C will also emit general diagnostics for inability to +create directories or files. + +=cut + +# for portability warn about names longer than $maxlen +$Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 +$Verbose = 1; # 0=none, 1=minimal, 2=list .al files +$Keep = 0; +$CheckForAutoloader = 1; +$CheckModTime = 1; + +my $IndexFile = "autosplit.ix"; # file also serves as timestamp +my $maxflen = 255; +$maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; +if (defined (&Dos::UseLFN)) { + $maxflen = Dos::UseLFN() ? 255 : 11; +} +my $Is_VMS = ($^O eq 'VMS'); + + +sub autosplit{ + my($file, $autodir, $keep, $ckal, $ckmt) = @_; + # $file - the perl source file to be split (after __END__) + # $autodir - the ".../auto" dir below which to write split subs + # Handle optional flags: + $keep = $Keep unless defined $keep; + $ckal = $CheckForAutoloader unless defined $ckal; + $ckmt = $CheckModTime unless defined $ckmt; + autosplit_file($file, $autodir, $keep, $ckal, $ckmt); +} + + +# This function is used during perl building/installation +# ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ... + +sub autosplit_lib_modules{ + my(@modules) = @_; # list of Module names + + 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 + if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs + my ($dir,$name) = (/(.*])(.*)/); + $dir =~ s/.*lib[\.\]]//; + $dir =~ s#[\.\]]#/#g; + $_ = $dir . $name; + } + autosplit_file("lib/$_", "lib/auto", + $Keep, $CheckForAutoloader, $CheckModTime); + } + 0; +} + + +# private functions + +sub autosplit_file { + my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) + = @_; + my(@outfiles); + local($_); + local($/) = "\n"; + + # where to write output files + $autodir ||= "lib/auto"; + if ($Is_VMS) { + ($autodir = VMS::Filespec::unixpath($autodir)) =~ s|/$||; + $filename = VMS::Filespec::unixify($filename); # may have dirs + } + unless (-d $autodir){ + mkpath($autodir,0,0755); + # We should never need to create the auto dir + # here. installperl (or similar) should have done + # it. Expecting it to exist is a valuable sanity check against + # autosplitting into some random directory by mistake. + print "Warning: AutoSplit had to create top-level " . + "$autodir unexpectedly.\n"; + } + + # allow just a package name to be used + $filename .= ".pm" unless ($filename =~ m/\.pm$/); + + open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n"; + my($pm_mod_time) = (stat($filename))[9]; + my($autoloader_seen) = 0; + my($in_pod) = 0; + my($def_package,$last_package,$this_package,$fnr); + while () { + # Skip pod text. + $fnr++; + $in_pod = 1 if /^=/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + + # record last package name seen + $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); + ++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/; + ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; + last if /^__END__/; + } + if ($check_for_autoloader && !$autoloader_seen){ + print "AutoSplit skipped $filename: no AutoLoader used\n" + if ($Verbose>=2); + return 0; + } + $_ or die "Can't find __END__ in $filename\n"; + + $def_package or die "Can't find 'package Name;' in $filename\n"; + + my($modpname) = _modpname($def_package); + + # this _has_ to match so we have a reasonable timestamp file + die "Package $def_package ($modpname.pm) does not ". + "match filename $filename" + unless ($filename =~ m/\Q$modpname.pm\E$/ or + ($^O eq 'dos') or ($^O eq 'MSWin32') or + $Is_VMS && $filename =~ m/$modpname.pm/i); + + my($al_idx_file) = "$autodir/$modpname/$IndexFile"; + + if ($check_mod_time){ + my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; + if ($al_ts_time >= $pm_mod_time){ + print "AutoSplit skipped ($al_idx_file newer than $filename)\n" + if ($Verbose >= 2); + return undef; # one undef, not a list + } + } + + print "AutoSplitting $filename ($autodir/$modpname)\n" + if $Verbose; + + unless (-d "$autodir/$modpname"){ + mkpath("$autodir/$modpname",0,0777); + } + + # We must try to deal with some SVR3 systems with a limit of 14 + # characters for file names. Sadly we *cannot* simply truncate all + # file names to 14 characters on these systems because we *must* + # create filenames which exactly match the names used by AutoLoader.pm. + # This is a problem because some systems silently truncate the file + # names while others treat long file names as an error. + + my $Is83 = $maxflen==11; # plain, case INSENSITIVE dos filenames + + my(@subnames, $subname, %proto, %package); + my @cache = (); + my $caching = 1; + $last_package = ''; + while () { + $fnr++; + $in_pod = 1 if /^=/; + $in_pod = 0 if /^=cut/; + next if ($in_pod || /^=cut/); + # the following (tempting) old coding gives big troubles if a + # cut is forgotten at EOF: + # next if /^=\w/ .. /^=cut/; + if (/^package\s+([\w:]+)\s*;/) { + $this_package = $def_package = $1; + } + if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) { + print OUT "# end of $last_package\::$subname\n1;\n" + if $last_package; + $subname = $1; + my $proto = $2 || ''; + if ($subname =~ s/(.*):://){ + $this_package = $1; + } else { + $this_package = $def_package; + } + my $fq_subname = "$this_package\::$subname"; + $package{$fq_subname} = $this_package; + $proto{$fq_subname} = $proto; + push(@subnames, $fq_subname); + my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); + $modpname = _modpname($this_package); + mkpath("$autodir/$modpname",0,0777); + my($lpath) = "$autodir/$modpname/$lname.al"; + my($spath) = "$autodir/$modpname/$sname.al"; + my $path; + if (!$Is83 and open(OUT, ">$lpath")){ + $path=$lpath; + print " writing $lpath\n" if ($Verbose>=2); + } else { + open(OUT, ">$spath") or die "Can't create $spath: $!\n"; + $path=$spath; + print " writing $spath (with truncated name)\n" + if ($Verbose>=1); + } + push(@outfiles, $path); + print OUT < lc($_) } @outfiles; + } else { + @outfiles{@outfiles} = @outfiles; + } + my(%outdirs,@outdirs); + for (@outfiles) { + $outdirs{File::Basename::dirname($_)}||=1; + } + for my $dir (keys %outdirs) { + opendir(OUTDIR,$dir); + foreach (sort readdir(OUTDIR)){ + next unless /\.al$/; + my($file) = "$dir/$_"; + $file = lc $file if $Is83 or $Is_VMS; + next if $outfiles{$file}; + print " deleting $file\n" if ($Verbose>=2); + my($deleted,$thistime); # catch all versions on VMS + do { $deleted += ($thistime = unlink $file) } while ($thistime); + carp "Unable to delete $file: $!" unless $deleted; + } + closedir(OUTDIR); + } + } + + open(TS,">$al_idx_file") or + carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; + print TS "# Index created by AutoSplit for $filename\n"; + print TS "# (file acts as timestamp)\n"; + $last_package = ''; + for my $fqs (@subnames) { + my($subname) = $fqs; + $subname =~ s/.*:://; + print TS "package $package{$fqs};\n" + unless $last_package eq $package{$fqs}; + print TS "sub $subname $proto{$fqs};\n"; + $last_package = $package{$fqs}; + } + print TS "1;\n"; + close(TS); + + _check_unique($filename, $Maxlen, 1, @outfiles); + + @outfiles; +} + +sub _modpname ($) { + my($package) = @_; + my $modpname = $package; + if ($^O eq 'MSWin32') { + $modpname =~ s#::#\\#g; + } else { + $modpname =~ s#::#/#g; + } + $modpname; +} + +sub _check_unique { + my($filename, $maxlen, $warn, @outfiles) = @_; + my(%notuniq) = (); + my(%shorts) = (); + my(@toolong) = grep( + length(File::Basename::basename($_)) + > $maxlen, + @outfiles + ); + + foreach (@toolong){ + my($dir) = File::Basename::dirname($_); + my($file) = File::Basename::basename($_); + my($trunc) = substr($file,0,$maxlen); + $notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc}; + $shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ? + "$shorts{$dir}{$trunc}, $file" : $file; + } + if (%notuniq && $warn){ + print "$filename: some names are not unique when " . + "truncated to $maxlen characters:\n"; + foreach my $dir (sort keys %notuniq){ + print " directory $dir:\n"; + foreach my $trunc (sort keys %{$notuniq{$dir}}) { + print " $shorts{$dir}{$trunc} truncate to $trunc\n"; + } + } + } +} + +1; +__END__ + +# test functions so AutoSplit.pm can be applied to itself: +sub test1 ($) { "test 1\n"; } +sub test2 ($$) { "test 2\n"; } +sub test3 ($$$) { "test 3\n"; } +sub testtesttesttest4_1 { "test 4\n"; } +sub testtesttesttest4_2 { "duplicate test 4\n"; } +sub Just::Another::test5 { "another test 5\n"; } +sub test6 { return join ":", __FILE__,__LINE__; } +package Yet::Another::AutoSplit; +sub testtesttesttest4_1 ($) { "another test 4\n"; } +sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; } diff --git a/contrib/perl5/lib/Benchmark.pm b/contrib/perl5/lib/Benchmark.pm new file mode 100644 index 00000000000..a28f510d112 --- /dev/null +++ b/contrib/perl5/lib/Benchmark.pm @@ -0,0 +1,515 @@ +package Benchmark; + +=head1 NAME + +Benchmark - benchmark running times of code + +timethis - run a chunk of code several times + +timethese - run several chunks of code several times + +timeit - run a chunk of code and see how long it goes + +=head1 SYNOPSIS + + timethis ($count, "code"); + + # Use Perl code in strings... + timethese($count, { + 'Name1' => '...code1...', + 'Name2' => '...code2...', + }); + + # ... or use subroutine references. + timethese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + + $t = timeit($count, '...other code...') + print "$count loops of other code took:",timestr($t),"\n"; + +=head1 DESCRIPTION + +The Benchmark module encapsulates a number of routines to help you +figure out how long it takes to execute some code. + +=head2 Methods + +=over 10 + +=item new + +Returns the current time. Example: + + use Benchmark; + $t0 = new Benchmark; + # ... your code here ... + $t1 = new Benchmark; + $td = timediff($t1, $t0); + print "the code took:",timestr($td),"\n"; + +=item debug + +Enables or disable debugging by setting the C<$Benchmark::Debug> flag: + + debug Benchmark 1; + $t = timeit(10, ' 5 ** $Global '); + debug Benchmark 0; + +=back + +=head2 Standard Exports + +The following routines will be exported into your namespace +if you use the Benchmark module: + +=over 10 + +=item timeit(COUNT, CODE) + +Arguments: COUNT is the number of times to run the loop, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +Returns: a Benchmark object. + +=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ) + +Time COUNT iterations of CODE. CODE may be a string to eval or a +code reference; either way the CODE will run in the caller's package. +Results will be printed to STDOUT as TITLE followed by the times. +TITLE defaults to "timethis COUNT" if none is provided. STYLE +determines the format of the output, as described for timestr() below. + +The COUNT can be zero or negative: this means the I to run. A zero signifies the default of 3 seconds. For +example to run at least for 10 seconds: + + timethis(-10, $code) + +or to run two pieces of code tests for at least 3 seconds: + + timethese(0, { test1 => '...', test2 => '...'}) + +CPU seconds is, in UNIX terms, the user time plus the system time of +the process itself, as opposed to the real (wallclock) time and the +time spent by the child processes. Less than 0.1 seconds is not +accepted (-0.01 as the count, for example, will cause a fatal runtime +exception). + +Note that the CPU seconds is the B time: CPU scheduling and +other operating system factors may complicate the attempt so that a +little bit more time is spent. The benchmark output will, however, +also tell the number of C<$code> runs/second, which should be a more +interesting number than the actually spent seconds. + +Returns a Benchmark object. + +=item timethese ( COUNT, CODEHASHREF, [ STYLE ] ) + +The CODEHASHREF is a reference to a hash containing names as keys +and either a string to eval or a code reference for each value. +For each (KEY, VALUE) pair in the CODEHASHREF, this routine will +call + + timethis(COUNT, VALUE, KEY, STYLE) + +The routines are called in string comparison order of KEY. + +The COUNT can be zero or negative, see timethis(). + +=item timediff ( T1, T2 ) + +Returns the difference between two Benchmark times as a Benchmark +object suitable for passing to timestr(). + +=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) + +Returns a string that formats the times in the TIMEDIFF object in +the requested STYLE. TIMEDIFF is expected to be a Benchmark object +similar to that returned by timediff(). + +STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each +of the 5 times available ('wallclock' time, user time, system time, +user time of children, and system time of children). 'noc' shows all +except the two children times. 'nop' shows only wallclock and the +two children times. 'auto' (the default) will act as 'all' unless +the children times are both zero, in which case it acts as 'noc'. + +FORMAT is the L-style format specifier (without the +leading '%') to use to print the times. It defaults to '5.2f'. + +=back + +=head2 Optional Exports + +The following routines will be exported into your namespace +if you specifically ask that they be imported: + +=over 10 + +=item clearcache ( COUNT ) + +Clear the cached time for COUNT rounds of the null loop. + +=item clearallcache ( ) + +Clear all cached times. + +=item disablecache ( ) + +Disable caching of timings for the null loop. This will force Benchmark +to recalculate these timings for each new piece of code timed. + +=item enablecache ( ) + +Enable caching of timings for the null loop. The time taken for COUNT +rounds of the null loop will be calculated only once for each +different COUNT used. + +=back + +=head1 NOTES + +The data is stored as a list of values from the time and times +functions: + + ($real, $user, $system, $children_user, $children_system) + +in seconds for the whole loop (not divided by the number of rounds). + +The timing is done using time(3) and times(3). + +Code is executed in the caller's package. + +The time of the null loop (a loop with the same +number of rounds but empty loop body) is subtracted +from the time of the real loop. + +The null loop times are cached, the key being the +number of rounds. The caching can be controlled using +calls like these: + + clearcache($key); + clearallcache(); + + disablecache(); + enablecache(); + +=head1 INHERITANCE + +Benchmark inherits from no other class, except of course +for Exporter. + +=head1 CAVEATS + +Comparing eval'd strings with code references will give you +inaccurate results: a code reference will show a slower +execution time than the equivalent eval'd string. + +The real time timing is done using time(2) and +the granularity is therefore only one second. + +Short tests may produce negative figures because perl +can appear to take longer to execute the empty loop +than a short test; try: + + timethis(100,'1'); + +The system time of the null loop might be slightly +more than the system time of the loop with the actual +code and therefore the difference might end up being E 0. + +=head1 AUTHORS + +Jarkko Hietaniemi >, Tim Bunce > + +=head1 MODIFICATION HISTORY + +September 8th, 1994; by Tim Bunce. + +March 28th, 1997; by Hugo van der Sanden: added support for code +references and the already documented 'debug' method; revamped +documentation. + +April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time +functionality. + +=cut + +# evaluate something in a clean lexical environment +sub _doeval { eval shift } + +# +# put any lexicals at file scope AFTER here +# + +use Carp; +use Exporter; +@ISA=(Exporter); +@EXPORT=qw(timeit timethis timethese timediff timestr); +@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache); + +&init; + +sub init { + $debug = 0; + $min_count = 4; + $min_cpu = 0.4; + $defaultfmt = '5.2f'; + $defaultstyle = 'auto'; + # The cache can cause a slight loss of sys time accuracy. If a + # user does many tests (>10) with *very* large counts (>10000) + # or works on a very slow machine the cache may be useful. + &disablecache; + &clearallcache; +} + +sub debug { $debug = ($_[1] != 0); } + +sub clearcache { delete $cache{$_[0]}; } +sub clearallcache { %cache = (); } +sub enablecache { $cache = 1; } +sub disablecache { $cache = 0; } + +# --- Functions to process the 'time' data type + +sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0); + print "new=@t\n" if $debug; + bless \@t; } + +sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } +sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } +sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; } +sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; } + +sub timediff { + my($a, $b) = @_; + my @r; + for (my $i=0; $i < @$a; ++$i) { + push(@r, $a->[$i] - $b->[$i]); + } + bless \@r; +} + +sub timestr { + my($tr, $style, $f) = @_; + my @t = @$tr; + warn "bad time value (@t)" unless @t==6; + my($r, $pu, $ps, $cu, $cs, $n) = @t; + my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); + $f = $defaultfmt unless defined $f; + # format a time in the required style, other formats may be added here + $style ||= $defaultstyle; + $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto'; + my $s = "@t $style"; # default for unknown style + $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)", + @t,$t) if $style eq 'all'; + $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)", + $r,$pu,$ps,$pt) if $style eq 'noc'; + $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)", + $r,$cu,$cs,$ct) if $style eq 'nop'; + $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n; + $s; +} + +sub timedebug { + my($msg, $t) = @_; + print STDERR "$msg",timestr($t),"\n" if $debug; +} + +# --- Functions implementing low-level support for timing loops + +sub runloop { + my($n, $c) = @_; + + $n+=0; # force numeric now, so garbage won't creep into the eval + croak "negative loopcount $n" if $n<0; + confess "Usage: runloop(number, [string | coderef])" unless defined $c; + my($t0, $t1, $td); # before, after, difference + + # find package of caller so we can execute code there + my($curpack) = caller(0); + my($i, $pack)= 0; + while (($pack) = caller(++$i)) { + last if $pack ne $curpack; + } + + my ($subcode, $subref); + if (ref $c eq 'CODE') { + $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }"; + $subref = eval $subcode; + } + else { + $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }"; + $subref = _doeval($subcode); + } + croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; + print STDERR "runloop $n '$subcode'\n" if $debug; + + $t0 = Benchmark->new(0); + &$subref; + $t1 = Benchmark->new($n); + $td = &timediff($t1, $t0); + + timedebug("runloop:",$td); + $td; +} + + +sub timeit { + my($n, $code) = @_; + my($wn, $wc, $wd); + + printf STDERR "timeit $n $code\n" if $debug; + + if ($cache && exists $cache{$n}) { + $wn = $cache{$n}; + } else { + $wn = &runloop($n, ''); + $cache{$n} = $wn; + } + + $wc = &runloop($n, $code); + + $wd = timediff($wc, $wn); + + timedebug("timeit: ",$wc); + timedebug(" - ",$wn); + timedebug(" = ",$wd); + + $wd; +} + + +my $default_for = 3; +my $min_for = 0.1; + +sub runfor { + my ($code, $tmax) = @_; + + if ( not defined $tmax or $tmax == 0 ) { + $tmax = $default_for; + } elsif ( $tmax < 0 ) { + $tmax = -$tmax; + } + + die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n" + if $tmax < $min_for; + + my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot ); + + # First find the minimum $n that gives a non-zero timing. + + my $nmin; + + for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->[1] + $td->[2]; + } + + $nmin = $n; + + my $ttot = 0; + my $tpra = 0.05 * $tmax; # Target/time practice. + + # Double $n until we have think we have practiced enough. + for ( $n = 1; $ttot < $tpra; $n *= 2 ) { + $td = timeit($n, $code); + $tc = $td->cpu_p; + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + my $r; + + # Then iterate towards the $tmax. + while ( $ttot < $tmax ) { + $r = $tmax / $ttot - 1; # Linear approximation. + $n = int( $r * $n ); + $n = $nmin if $n < $nmin; + $td = timeit($n, $code); + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; + $ttot = $utot + $stot; + $cutot += $td->[3]; + $cstot += $td->[4]; + } + + return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ]; +} + +# --- Functions implementing high-level time-then-print utilities + +sub n_to_for { + my $n = shift; + return $n == 0 ? $default_for : $n < 0 ? -$n : undef; +} + +sub timethis{ + my($n, $code, $title, $style) = @_; + my($t, $for, $forn); + + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + $t = timeit($n, $code); + $title = "timethis $n" unless defined $title; + } else { + $fort = n_to_for( $n ); + $t = runfor($code, $fort); + $title = "timethis for $fort" unless defined $title; + $forn = $t->[-1]; + } + local $| = 1; + $style = "" unless defined $style; + printf("%10s: ", $title); + print timestr($t, $style, $defaultfmt),"\n"; + + $n = $forn if defined $forn; + + # A conservative warning to spot very silly tests. + # Don't assume that your benchmark is ok simply because + # you don't get this warning! + print " (warning: too few iterations for a reliable count)\n" + if $n < $min_count + || ($t->real < 1 && $n < 1000) + || $t->cpu_a < $min_cpu; + $t; +} + +sub timethese{ + my($n, $alt, $style) = @_; + die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" + unless ref $alt eq HASH; + my @names = sort keys %$alt; + $style = "" unless defined $style; + print "Benchmark: "; + if ( $n > 0 ) { + croak "non-integer loopcount $n, stopped" if int($n)<$n; + print "timing $n iterations of"; + } else { + print "running"; + } + print " ", join(', ',@names); + unless ( $n > 0 ) { + my $for = n_to_for( $n ); + print ", each for at least $for CPU seconds"; + } + print "...\n"; + + # we could save the results in an array and produce a summary here + # sum, min, max, avg etc etc + foreach my $name (@names) { + timethis ($n, $alt -> {$name}, $name, $style); + } +} + +1; diff --git a/contrib/perl5/lib/CGI.pm b/contrib/perl5/lib/CGI.pm new file mode 100644 index 00000000000..22d91a46c7c --- /dev/null +++ b/contrib/perl5/lib/CGI.pm @@ -0,0 +1,6102 @@ +package CGI; +require 5.004; + +# See the bottom of this file for the POD documentation. Search for the +# string '=head'. + +# You can run this file through either pod2man or pod2html to produce pretty +# documentation in manual or html file format (these utilities are part of the +# Perl 5 distribution). + +# Copyright 1995-1998 Lincoln D. Stein. All rights reserved. +# It may be used and modified freely, but I do request that this copyright +# notice remain attached to the file. You may modify this module as you +# wish, but if you redistribute a modified version, please attach a note +# listing the modifications you have made. + +# The most recent version and complete docs are available at: +# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html +# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ + +$CGI::revision = '$Id: CGI.pm,v 1.32 1998/05/28 21:55:43 lstein Exp lstein $'; +$CGI::VERSION='2.42'; + +# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. +# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. +# $TempFile::TMPDIRECTORY = '/usr/tmp'; + +# >>>>> Here are some globals that you might want to adjust <<<<<< +sub initialize_globals { + # Set this to 1 to enable copious autoloader debugging messages + $AUTOLOAD_DEBUG = 0; + + # Change this to the preferred DTD to print in start_html() + # or use default_dtd('text of DTD to use'); + $DEFAULT_DTD = '-//IETF//DTD HTML//EN'; + + # Set this to 1 to enable NPH scripts + # or: + # 1) use CGI qw(-nph) + # 2) $CGI::nph(1) + # 3) print header(-nph=>1) + $NPH = 0; + + # Set this to 1 to disable debugging from the + # command line + $NO_DEBUG = 0; + + # Set this to 1 to make the temporary files created + # during file uploads safe from prying eyes + # or do... + # 1) use CGI qw(:private_tempfiles) + # 2) $CGI::private_tempfiles(1); + $PRIVATE_TEMPFILES = 0; + + # Set this to a positive value to limit the size of a POSTing + # to a certain number of bytes: + $POST_MAX = -1; + + # Change this to 1 to disable uploads entirely: + $DISABLE_UPLOADS = 0; + + # Other globals that you shouldn't worry about. + undef $Q; + $BEEN_THERE = 0; + undef @QUERY_PARAM; + undef %EXPORT; + + # prevent complaints by mod_perl + 1; +} + +# ------------------ START OF THE LIBRARY ------------ + +# make mod_perlhappy +initialize_globals(); + +# FIGURE OUT THE OS WE'RE RUNNING UNDER +# Some systems support the $^O variable. If not +# available then require() the Config library +unless ($OS) { + unless ($OS = $^O) { + require Config; + $OS = $Config::Config{'osname'}; + } +} +if ($OS=~/Win/i) { + $OS = 'WINDOWS'; +} elsif ($OS=~/vms/i) { + $OS = 'VMS'; +} elsif ($OS=~/^MacOS$/i) { + $OS = 'MACINTOSH'; +} elsif ($OS=~/os2/i) { + $OS = 'OS2'; +} else { + $OS = 'UNIX'; +} + +# Some OS logic. Binary mode enabled on DOS, NT and VMS +$needs_binmode = $OS=~/^(WINDOWS|VMS|OS2)/; + +# This is the default class for the CGI object to use when all else fails. +$DefaultClass = 'CGI' unless defined $CGI::DefaultClass; + +# This is where to look for autoloaded routines. +$AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass; + +# The path separator is a slash, backslash or semicolon, depending +# on the paltform. +$SL = { + UNIX=>'/', OS2=>'\\', WINDOWS=>'\\', MACINTOSH=>':', VMS=>'/' + }->{$OS}; + +# This no longer seems to be necessary +# Turn on NPH scripts by default when running under IIS server! +# $NPH++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; +$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; + +# Turn on special checking for Doug MacEachern's modperl +if (defined($ENV{'GATEWAY_INTERFACE'}) && + ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) +{ + $| = 1; + require Apache; +} +# Turn on special checking for ActiveState's PerlEx +$PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; + +# Define the CRLF sequence. I can't use a simple "\r\n" because the meaning +# of "\n" is different on different OS's (sometimes it generates CRLF, sometimes LF +# and sometimes CR). The most popular VMS web server +# doesn't accept CRLF -- instead it wants a LR. EBCDIC machines don't +# use ASCII, so \015\012 means something different. I find this all +# really annoying. +$EBCDIC = "\t" ne "\011"; +if ($OS eq 'VMS') { + $CRLF = "\n"; +} elsif ($EBCDIC) { + $CRLF= "\r\n"; +} else { + $CRLF = "\015\012"; +} + +if ($needs_binmode) { + $CGI::DefaultClass->binmode(main::STDOUT); + $CGI::DefaultClass->binmode(main::STDIN); + $CGI::DefaultClass->binmode(main::STDERR); +} + +%EXPORT_TAGS = ( + ':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em + tt u i b blockquote pre img a address cite samp dfn html head + base body Link nextid title meta kbd start_html end_html + input Select option comment/], + ':html3'=>[qw/div table caption th td TR Tr sup sub strike applet Param + embed basefont style span layer ilayer font frameset frame script small big/], + ':netscape'=>[qw/blink fontsize center/], + ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group + submit reset defaults radio_group popup_menu button autoEscape + scrolling_list image_button start_form end_form startform endform + start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/], + ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump + raw_cookie request_method query_string accept user_agent remote_host + remote_addr referer server_name server_software server_port server_protocol + virtual_host remote_ident auth_type http use_named_parameters + save_parameters restore_parameters param_fetch + remote_user user_name header redirect import_names put Delete Delete_all url_param/], + ':ssl' => [qw/https/], + ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/], + ':html' => [qw/:html2 :html3 :netscape/], + ':standard' => [qw/:html2 :html3 :form :cgi/], + ':push' => [qw/multipart_init multipart_start multipart_end/], + ':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/] + ); + +# to import symbols into caller +sub import { + my $self = shift; + +# This causes modules to clash. +# undef %EXPORT_OK; +# undef %EXPORT; + + $self->_setup_symbols(@_); + my ($callpack, $callfile, $callline) = caller; + + # To allow overriding, search through the packages + # Till we find one in which the correct subroutine is defined. + my @packages = ($self,@{"$self\:\:ISA"}); + foreach $sym (keys %EXPORT) { + my $pck; + my $def = ${"$self\:\:AutoloadClass"} || $DefaultClass; + foreach $pck (@packages) { + if (defined(&{"$pck\:\:$sym"})) { + $def = $pck; + last; + } + } + *{"${callpack}::$sym"} = \&{"$def\:\:$sym"}; + } +} + +sub compile { + my $pack = shift; + $pack->_setup_symbols('-compile',@_); +} + +sub expand_tags { + my($tag) = @_; + my(@r); + return ($tag) unless $EXPORT_TAGS{$tag}; + foreach (@{$EXPORT_TAGS{$tag}}) { + push(@r,&expand_tags($_)); + } + return @r; +} + +#### Method: new +# The new routine. This will check the current environment +# for an existing query string, and initialize itself, if so. +#### +sub new { + my($class,$initializer) = @_; + my $self = {}; + bless $self,ref $class || $class || $DefaultClass; + if ($MOD_PERL) { + Apache->request->register_cleanup(\&CGI::_reset_globals); + undef $NPH; + } + $self->_reset_globals if $PERLEX; + $self->init($initializer); + return $self; +} + +# We provide a DESTROY method so that the autoloader +# doesn't bother trying to find it. +sub DESTROY { } + +#### Method: param +# Returns the value(s)of a named parameter. +# If invoked in a list context, returns the +# entire list. Otherwise returns the first +# member of the list. +# If name is not provided, return a list of all +# the known parameters names available. +# If more than one argument is provided, the +# second and subsequent arguments are used to +# set the value of the parameter. +#### +sub param { + my($self,@p) = self_or_default(@_); + return $self->all_parameters unless @p; + my($name,$value,@other); + + # For compatibility between old calling style and use_named_parameters() style, + # we have to special case for a single parameter present. + if (@p > 1) { + ($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p); + my(@values); + + if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) { + @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : (); + } else { + foreach ($value,@other) { + push(@values,$_) if defined($_); + } + } + # If values is provided, then we set it. + if (@values) { + $self->add_parameter($name); + $self->{$name}=[@values]; + } + } else { + $name = $p[0]; + } + + return () unless defined($name) && $self->{$name}; + return wantarray ? @{$self->{$name}} : $self->{$name}->[0]; +} + +sub self_or_default { + return @_ if defined($_[0]) && (!ref($_[0])) &&($_[0] eq 'CGI'); + unless (defined($_[0]) && + (ref($_[0]) eq 'CGI' || UNIVERSAL::isa($_[0],'CGI')) # slightly optimized for common case + ) { + $Q = $CGI::DefaultClass->new unless defined($Q); + unshift(@_,$Q); + } + return @_; +} + +sub self_or_CGI { + local $^W=0; # prevent a warning + if (defined($_[0]) && + (substr(ref($_[0]),0,3) eq 'CGI' + || UNIVERSAL::isa($_[0],'CGI'))) { + return @_; + } else { + return ($DefaultClass,@_); + } +} + +######################################## +# THESE METHODS ARE MORE OR LESS PRIVATE +# GO TO THE __DATA__ SECTION TO SEE MORE +# PUBLIC METHODS +######################################## + +# Initialize the query object from the environment. +# If a parameter list is found, this object will be set +# to an associative array in which parameter names are keys +# and the values are stored as lists +# If a keyword list is found, this method creates a bogus +# parameter list with the single parameter 'keywords'. + +sub init { + my($self,$initializer) = @_; + my($query_string,$meth,$content_length,$fh,@lines) = ('','','',''); + + # if we get called more than once, we want to initialize + # ourselves from the original query (which may be gone + # if it was read from STDIN originally.) + if (defined(@QUERY_PARAM) && !defined($initializer)) { + foreach (@QUERY_PARAM) { + $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_}); + } + return; + } + + $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'}); + $content_length = defined($ENV{'CONTENT_LENGTH'}) ? $ENV{'CONTENT_LENGTH'} : 0; + die "Client attempted to POST $content_length bytes, but POSTs are limited to $POST_MAX" + if ($POST_MAX > 0) && ($content_length > $POST_MAX); + $fh = to_filehandle($initializer) if $initializer; + + METHOD: { + + # Process multipart postings, but only if the initializer is + # not defined. + if ($meth eq 'POST' + && defined($ENV{'CONTENT_TYPE'}) + && $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data| + && !defined($initializer) + ) { + my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";]+)\"?/; + $self->read_multipart($boundary,$content_length); + last METHOD; + } + + # If initializer is defined, then read parameters + # from it. + if (defined($initializer)) { + if (UNIVERSAL::isa($initializer,'CGI')) { + $query_string = $initializer->query_string; + last METHOD; + } + if (ref($initializer) && ref($initializer) eq 'HASH') { + foreach (keys %$initializer) { + $self->param('-name'=>$_,'-value'=>$initializer->{$_}); + } + last METHOD; + } + + if (defined($fh) && ($fh ne '')) { + while (<$fh>) { + chomp; + last if /^=/; + push(@lines,$_); + } + # massage back into standard format + if ("@lines" =~ /=/) { + $query_string=join("&",@lines); + } else { + $query_string=join("+",@lines); + } + last METHOD; + } + + # last chance -- treat it as a string + $initializer = $$initializer if ref($initializer) eq 'SCALAR'; + $query_string = $initializer; + + last METHOD; + } + + # If method is GET or HEAD, fetch the query from + # the environment. + if ($meth=~/^(GET|HEAD)$/) { + $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; + last METHOD; + } + + if ($meth eq 'POST') { + $self->read_from_client(\*STDIN,\$query_string,$content_length,0) + if $content_length > 0; + # Some people want to have their cake and eat it too! + # Uncomment this line to have the contents of the query string + # APPENDED to the POST data. + # $query_string .= (length($query_string) ? '&' : '') . $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'}; + last METHOD; + } + + # If $meth is not of GET, POST or HEAD, assume we're being debugged offline. + # Check the command line and then the standard input for data. + # We use the shellwords package in order to behave the way that + # UN*X programmers expect. + $query_string = read_from_cmdline() unless $NO_DEBUG; + } + + # We now have the query string in hand. We do slightly + # different things for keyword lists and parameter lists. + if ($query_string ne '') { + if ($query_string =~ /=/) { + $self->parse_params($query_string); + } else { + $self->add_parameter('keywords'); + $self->{'keywords'} = [$self->parse_keywordlist($query_string)]; + } + } + + # Special case. Erase everything if there is a field named + # .defaults. + if ($self->param('.defaults')) { + undef %{$self}; + } + + # Associative array containing our defined fieldnames + $self->{'.fieldnames'} = {}; + foreach ($self->param('.cgifields')) { + $self->{'.fieldnames'}->{$_}++; + } + + # Clear out our default submission button flag if present + $self->delete('.submit'); + $self->delete('.cgifields'); + $self->save_request unless $initializer; +} + +# FUNCTIONS TO OVERRIDE: +# Turn a string into a filehandle +sub to_filehandle { + my $thingy = shift; + return undef unless $thingy; + return $thingy if UNIVERSAL::isa($thingy,'GLOB'); + return $thingy if UNIVERSAL::isa($thingy,'FileHandle'); + if (!ref($thingy)) { + my $caller = 1; + while (my $package = caller($caller++)) { + my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; + return $tmp if defined(fileno($tmp)); + } + } + return undef; +} + +# send output to the browser +sub put { + my($self,@p) = self_or_default(@_); + $self->print(@p); +} + +# print to standard output (for overriding in mod_perl) +sub print { + shift; + CORE::print(@_); +} + +# unescape URL-encoded data +sub unescape { + shift() if ref($_[0]); + my $todecode = shift; + return undef unless defined($todecode); + $todecode =~ tr/+/ /; # pluses become spaces + $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; + return $todecode; +} + +# URL-encode data +sub escape { + shift() if ref($_[0]) || $_[0] eq $DefaultClass; + my $toencode = shift; + return undef unless defined($toencode); + $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg; + return $toencode; +} + +sub save_request { + my($self) = @_; + # We're going to play with the package globals now so that if we get called + # again, we initialize ourselves in exactly the same way. This allows + # us to have several of these objects. + @QUERY_PARAM = $self->param; # save list of parameters + foreach (@QUERY_PARAM) { + $QUERY_PARAM{$_}=$self->{$_}; + } +} + +sub parse_params { + my($self,$tosplit) = @_; + my(@pairs) = split('&',$tosplit); + my($param,$value); + foreach (@pairs) { + ($param,$value) = split('=',$_,2); + $param = unescape($param); + $value = unescape($value); + $self->add_parameter($param); + push (@{$self->{$param}},$value); + } +} + +sub add_parameter { + my($self,$param)=@_; + push (@{$self->{'.parameters'}},$param) + unless defined($self->{$param}); +} + +sub all_parameters { + my $self = shift; + return () unless defined($self) && $self->{'.parameters'}; + return () unless @{$self->{'.parameters'}}; + return @{$self->{'.parameters'}}; +} + +# put a filehandle into binary mode (DOS) +sub binmode { + CORE::binmode($_[1]); +} + +sub _make_tag_func { + my $tagname = shift; + return qq{ + sub $tagname { + # handle various cases in which we're called + # most of this bizarre stuff is to avoid -w errors + shift if \$_[0] && + (!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) || + (ref(\$_[0]) && + (substr(ref(\$_[0]),0,3) eq 'CGI' || + UNIVERSAL::isa(\$_[0],'CGI'))); + + my(\$attr) = ''; + if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { + my(\@attr) = make_attributes( '',shift() ); + \$attr = " \@attr" if \@attr; + } + my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U\E"); + return \$tag unless \@_; + my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; + return "\@result"; + } +} +} + +sub AUTOLOAD { + print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG; + my $func = &_compile; + goto &$func; +} + +# PRIVATE SUBROUTINE +# Smart rearrangement of parameters to allow named parameter +# calling. We do the rearangement if: +# 1. The first parameter begins with a - +# 2. The use_named_parameters() method returns true +sub rearrange { + my($self,$order,@param) = @_; + return () unless @param; + + if (ref($param[0]) eq 'HASH') { + @param = %{$param[0]}; + } else { + return @param + unless (defined($param[0]) && substr($param[0],0,1) eq '-') + || $self->use_named_parameters; + } + + # map parameters into positional indices + my ($i,%pos); + $i = 0; + foreach (@$order) { + foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; } + $i++; + } + + my (@result,%leftover); + $#result = $#$order; # preextend + while (@param) { + my $key = uc(shift(@param)); + $key =~ s/^\-//; + if (exists $pos{$key}) { + $result[$pos{$key}] = shift(@param); + } else { + $leftover{$key} = shift(@param); + } + } + + push (@result,$self->make_attributes(\%leftover)) if %leftover; + @result; +} + +sub _compile { + my($func) = $AUTOLOAD; + my($pack,$func_name); + { + local($1,$2); # this fixes an obscure variable suicide problem. + $func=~/(.+)::([^:]+)$/; + ($pack,$func_name) = ($1,$2); + $pack=~s/::SUPER$//; # fix another obscure problem + $pack = ${"$pack\:\:AutoloadClass"} || $CGI::DefaultClass + unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"}); + + my($sub) = \%{"$pack\:\:SUBS"}; + unless (%$sub) { + my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"}; + eval "package $pack; $$auto"; + die $@ if $@; + $$auto = ''; # Free the unneeded storage (but don't undef it!!!) + } + my($code) = $sub->{$func_name}; + + $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY'); + if (!$code) { + if ($EXPORT{':any'} || + $EXPORT{'-any'} || + $EXPORT{$func_name} || + (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html'))) + && $EXPORT_OK{$func_name}) { + $code = _make_tag_func($func_name); + } + } + die "Undefined subroutine $AUTOLOAD\n" unless $code; + eval "package $pack; $code"; + if ($@) { + $@ =~ s/ at .*\n//; + die $@; + } + } + delete($sub->{$func_name}); #free storage + return "$pack\:\:$func_name"; +} + +sub _reset_globals { initialize_globals(); } + +sub _setup_symbols { + my $self = shift; + my $compile = 0; + foreach (@_) { + $NPH++, next if /^[:-]nph$/; + $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/; + $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; + $EXPORT{$_}++, next if /^[:-]any$/; + $compile++, next if /^[:-]compile$/; + + # This is probably extremely evil code -- to be deleted + # some day. + if (/^[-]autoload$/) { + my($pkg) = caller(1); + *{"${pkg}::AUTOLOAD"} = sub { + my($routine) = $AUTOLOAD; + $routine =~ s/^.*::/CGI::/; + &$routine; + }; + next; + } + + foreach (&expand_tags($_)) { + tr/a-zA-Z0-9_//cd; # don't allow weird function names + $EXPORT{$_}++; + } + } + _compile_all(keys %EXPORT) if $compile; +} + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # get rid of -w warning +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; + +%SUBS = ( + +'URL_ENCODED'=> <<'END_OF_FUNC', +sub URL_ENCODED { 'application/x-www-form-urlencoded'; } +END_OF_FUNC + +'MULTIPART' => <<'END_OF_FUNC', +sub MULTIPART { 'multipart/form-data'; } +END_OF_FUNC + +'SERVER_PUSH' => <<'END_OF_FUNC', +sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; } +END_OF_FUNC + +'use_named_parameters' => <<'END_OF_FUNC', +#### Method: use_named_parameters +# Force CGI.pm to use named parameter-style method calls +# rather than positional parameters. The same effect +# will happen automatically if the first parameter +# begins with a -. +sub use_named_parameters { + my($self,$use_named) = self_or_default(@_); + return $self->{'.named'} unless defined ($use_named); + + # stupidity to avoid annoying warnings + return $self->{'.named'}=$use_named; +} +END_OF_FUNC + +'new_MultipartBuffer' => <<'END_OF_FUNC', +# Create a new multipart buffer +sub new_MultipartBuffer { + my($self,$boundary,$length,$filehandle) = @_; + return MultipartBuffer->new($self,$boundary,$length,$filehandle); +} +END_OF_FUNC + +'read_from_client' => <<'END_OF_FUNC', +# Read data from a file handle +sub read_from_client { + my($self, $fh, $buff, $len, $offset) = @_; + local $^W=0; # prevent a warning + return undef unless defined($fh); + return read($fh, $$buff, $len, $offset); +} +END_OF_FUNC + +'delete' => <<'END_OF_FUNC', +#### Method: delete +# Deletes the named parameter entirely. +#### +sub delete { + my($self,$name) = self_or_default(@_); + delete $self->{$name}; + delete $self->{'.fieldnames'}->{$name}; + @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); + return wantarray ? () : undef; +} +END_OF_FUNC + +#### Method: import_names +# Import all parameters into the given namespace. +# Assumes namespace 'Q' if not specified +#### +'import_names' => <<'END_OF_FUNC', +sub import_names { + my($self,$namespace,$delete) = self_or_default(@_); + $namespace = 'Q' unless defined($namespace); + die "Can't import names into \"main\"\n" if \%{"${namespace}::"} == \%::; + if ($delete || $MOD_PERL) { + # can anyone find an easier way to do this? + foreach (keys %{"${namespace}::"}) { + local *symbol = "${namespace}::${_}"; + undef $symbol; + undef @symbol; + undef %symbol; + } + } + my($param,@value,$var); + foreach $param ($self->param) { + # protect against silly names + ($var = $param)=~tr/a-zA-Z0-9_/_/c; + $var =~ s/^(?=\d)/_/; + local *symbol = "${namespace}::$var"; + @value = $self->param($param); + @symbol = @value; + $symbol = $value[0]; + } +} +END_OF_FUNC + +#### Method: keywords +# Keywords acts a bit differently. Calling it in a list context +# returns the list of keywords. +# Calling it in a scalar context gives you the size of the list. +#### +'keywords' => <<'END_OF_FUNC', +sub keywords { + my($self,@values) = self_or_default(@_); + # If values is provided, then we set it. + $self->{'keywords'}=[@values] if defined(@values); + my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : (); + @result; +} +END_OF_FUNC + +# These are some tie() interfaces for compatibility +# with Steve Brenner's cgi-lib.pl routines +'ReadParse' => <<'END_OF_FUNC', +sub ReadParse { + local(*in); + if (@_) { + *in = $_[0]; + } else { + my $pkg = caller(); + *in=*{"${pkg}::in"}; + } + tie(%in,CGI); + return scalar(keys %in); +} +END_OF_FUNC + +'PrintHeader' => <<'END_OF_FUNC', +sub PrintHeader { + my($self) = self_or_default(@_); + return $self->header(); +} +END_OF_FUNC + +'HtmlTop' => <<'END_OF_FUNC', +sub HtmlTop { + my($self,@p) = self_or_default(@_); + return $self->start_html(@p); +} +END_OF_FUNC + +'HtmlBot' => <<'END_OF_FUNC', +sub HtmlBot { + my($self,@p) = self_or_default(@_); + return $self->end_html(@p); +} +END_OF_FUNC + +'SplitParam' => <<'END_OF_FUNC', +sub SplitParam { + my ($param) = @_; + my (@params) = split ("\0", $param); + return (wantarray ? @params : $params[0]); +} +END_OF_FUNC + +'MethGet' => <<'END_OF_FUNC', +sub MethGet { + return request_method() eq 'GET'; +} +END_OF_FUNC + +'MethPost' => <<'END_OF_FUNC', +sub MethPost { + return request_method() eq 'POST'; +} +END_OF_FUNC + +'TIEHASH' => <<'END_OF_FUNC', +sub TIEHASH { + return $Q || new CGI; +} +END_OF_FUNC + +'STORE' => <<'END_OF_FUNC', +sub STORE { + $_[0]->param($_[1],split("\0",$_[2])); +} +END_OF_FUNC + +'FETCH' => <<'END_OF_FUNC', +sub FETCH { + return $_[0] if $_[1] eq 'CGI'; + return undef unless defined $_[0]->param($_[1]); + return join("\0",$_[0]->param($_[1])); +} +END_OF_FUNC + +'FIRSTKEY' => <<'END_OF_FUNC', +sub FIRSTKEY { + $_[0]->{'.iterator'}=0; + $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++]; +} +END_OF_FUNC + +'NEXTKEY' => <<'END_OF_FUNC', +sub NEXTKEY { + $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++]; +} +END_OF_FUNC + +'EXISTS' => <<'END_OF_FUNC', +sub EXISTS { + exists $_[0]->{$_[1]}; +} +END_OF_FUNC + +'DELETE' => <<'END_OF_FUNC', +sub DELETE { + $_[0]->delete($_[1]); +} +END_OF_FUNC + +'CLEAR' => <<'END_OF_FUNC', +sub CLEAR { + %{$_[0]}=(); +} +#### +END_OF_FUNC + +#### +# Append a new value to an existing query +#### +'append' => <<'EOF', +sub append { + my($self,@p) = @_; + my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p); + my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : (); + if (@values) { + $self->add_parameter($name); + push(@{$self->{$name}},@values); + } + return $self->param($name); +} +EOF + +#### Method: delete_all +# Delete all parameters +#### +'delete_all' => <<'EOF', +sub delete_all { + my($self) = self_or_default(@_); + undef %{$self}; +} +EOF + +'Delete' => <<'EOF', +sub Delete { + my($self,@p) = self_or_default(@_); + $self->delete(@p); +} +EOF + +'Delete_all' => <<'EOF', +sub Delete_all { + my($self,@p) = self_or_default(@_); + $self->delete_all(@p); +} +EOF + +#### Method: autoescape +# If you want to turn off the autoescaping features, +# call this method with undef as the argument +'autoEscape' => <<'END_OF_FUNC', +sub autoEscape { + my($self,$escape) = self_or_default(@_); + $self->{'dontescape'}=!$escape; +} +END_OF_FUNC + + +#### Method: version +# Return the current version +#### +'version' => <<'END_OF_FUNC', +sub version { + return $VERSION; +} +END_OF_FUNC + +'make_attributes' => <<'END_OF_FUNC', +sub make_attributes { + my($self,$attr) = @_; + return () unless $attr && ref($attr) && ref($attr) eq 'HASH'; + my(@att); + foreach (keys %{$attr}) { + my($key) = $_; + $key=~s/^\-//; # get rid of initial - if present + $key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes + push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/); + } + return @att; +} +END_OF_FUNC + +#### Method: url_param +# Return a parameter in the QUERY_STRING, regardless of +# whether this was a POST or a GET +#### +'url_param' => <<'END_OF_FUNC', +sub url_param { + my ($self,@p) = self_or_default(@_); + my $name = shift(@p); + return undef unless exists($ENV{QUERY_STRING}); + unless (exists($self->{'.url_param'})) { + $self->{'.url_param'}={}; # empty hash + if ($ENV{QUERY_STRING} =~ /=/) { + my(@pairs) = split('&',$ENV{QUERY_STRING}); + my($param,$value); + foreach (@pairs) { + ($param,$value) = split('=',$_,2); + $param = unescape($param); + $value = unescape($value); + push(@{$self->{'.url_param'}->{$param}},$value); + } + } else { + $self->{'.url_param'}->{'keywords'} = [$self->parse_keywordlist($ENV{QUERY_STRING})]; + } + } + return keys %{$self->{'.url_param'}} unless defined($name); + return () unless $self->{'.url_param'}->{$name}; + return wantarray ? @{$self->{'.url_param'}->{$name}} + : $self->{'.url_param'}->{$name}->[0]; +} +END_OF_FUNC + +#### Method: dump +# Returns a string in which all the known parameter/value +# pairs are represented as nested lists, mainly for the purposes +# of debugging. +#### +'dump' => <<'END_OF_FUNC', +sub dump { + my($self) = self_or_default(@_); + my($param,$value,@result); + return '
    ' unless $self->param; + push(@result,"
      "); + foreach $param ($self->param) { + my($name)=$self->escapeHTML($param); + push(@result,"
    • $param"); + push(@result,"
        "); + foreach $value ($self->param($param)) { + $value = $self->escapeHTML($value); + push(@result,"
      • $value"); + } + push(@result,"
      "); + } + push(@result,"
    \n"); + return join("\n",@result); +} +END_OF_FUNC + +#### Method as_string +# +# synonym for "dump" +#### +'as_string' => <<'END_OF_FUNC', +sub as_string { + &dump(@_); +} +END_OF_FUNC + +#### Method: save +# Write values out to a filehandle in such a way that they can +# be reinitialized by the filehandle form of the new() method +#### +'save' => <<'END_OF_FUNC', +sub save { + my($self,$filehandle) = self_or_default(@_); + $filehandle = to_filehandle($filehandle); + my($param); + local($,) = ''; # set print field separator back to a sane value + foreach $param ($self->param) { + my($escaped_param) = escape($param); + my($value); + foreach $value ($self->param($param)) { + print $filehandle "$escaped_param=",escape($value),"\n"; + } + } + print $filehandle "=\n"; # end of record +} +END_OF_FUNC + + +#### Method: save_parameters +# An alias for save() that is a better name for exportation. +# Only intended to be used with the function (non-OO) interface. +#### +'save_parameters' => <<'END_OF_FUNC', +sub save_parameters { + my $fh = shift; + return save(to_filehandle($fh)); +} +END_OF_FUNC + +#### Method: restore_parameters +# A way to restore CGI parameters from an initializer. +# Only intended to be used with the function (non-OO) interface. +#### +'restore_parameters' => <<'END_OF_FUNC', +sub restore_parameters { + $Q = $CGI::DefaultClass->new(@_); +} +END_OF_FUNC + +#### Method: multipart_init +# Return a Content-Type: style header for server-push +# This has to be NPH, and it is advisable to set $| = 1 +# +# Many thanks to Ed Jordan for this +# contribution +#### +'multipart_init' => <<'END_OF_FUNC', +sub multipart_init { + my($self,@p) = self_or_default(@_); + my($boundary,@other) = $self->rearrange([BOUNDARY],@p); + $boundary = $boundary || '------- =_aaaaaaaaaa0'; + $self->{'separator'} = "\n--$boundary\n"; + $type = SERVER_PUSH($boundary); + return $self->header( + -nph => 1, + -type => $type, + (map { split "=", $_, 2 } @other), + ) . $self->multipart_end; +} +END_OF_FUNC + + +#### Method: multipart_start +# Return a Content-Type: style header for server-push, start of section +# +# Many thanks to Ed Jordan for this +# contribution +#### +'multipart_start' => <<'END_OF_FUNC', +sub multipart_start { + my($self,@p) = self_or_default(@_); + my($type,@other) = $self->rearrange([TYPE],@p); + $type = $type || 'text/html'; + return $self->header( + -type => $type, + (map { split "=", $_, 2 } @other), + ); +} +END_OF_FUNC + + +#### Method: multipart_end +# Return a Content-Type: style header for server-push, end of section +# +# Many thanks to Ed Jordan for this +# contribution +#### +'multipart_end' => <<'END_OF_FUNC', +sub multipart_end { + my($self,@p) = self_or_default(@_); + return $self->{'separator'}; +} +END_OF_FUNC + + +#### Method: header +# Return a Content-Type: style header +# +#### +'header' => <<'END_OF_FUNC', +sub header { + my($self,@p) = self_or_default(@_); + my(@header); + + my($type,$status,$cookie,$target,$expires,$nph,@other) = + $self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p); + + $nph ||= $NPH; + # rearrange() was designed for the HTML portion, so we + # need to fix it up a little. + foreach (@other) { + next unless my($header,$value) = /([^\s=]+)=\"?([^\"]+)\"?/; + ($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e; + } + + $type = $type || 'text/html'; + + # Maybe future compatibility. Maybe not. + my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0'; + push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph; + + push(@header,"Status: $status") if $status; + push(@header,"Window-Target: $target") if $target; + # push all the cookies -- there may be several + if ($cookie) { + my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie; + foreach (@cookie) { + push(@header,"Set-Cookie: " . (UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_)); + } + } + # if the user indicates an expiration time, then we need + # both an Expires and a Date header (so that the browser is + # uses OUR clock) + push(@header,"Expires: " . expires($expires,'http')) + if $expires; + push(@header,"Date: " . expires(0,'http')) if $expires || $cookie; + push(@header,"Pragma: no-cache") if $self->cache(); + push(@header,@other); + push(@header,"Content-Type: $type"); + + my $header = join($CRLF,@header)."${CRLF}${CRLF}"; + if ($MOD_PERL and not $nph) { + my $r = Apache->request; + $r->send_cgi_header($header); + return ''; + } + return $header; +} +END_OF_FUNC + + +#### Method: cache +# Control whether header() will produce the no-cache +# Pragma directive. +#### +'cache' => <<'END_OF_FUNC', +sub cache { + my($self,$new_value) = self_or_default(@_); + $new_value = '' unless $new_value; + if ($new_value ne '') { + $self->{'cache'} = $new_value; + } + return $self->{'cache'}; +} +END_OF_FUNC + + +#### Method: redirect +# Return a Location: style header +# +#### +'redirect' => <<'END_OF_FUNC', +sub redirect { + my($self,@p) = self_or_default(@_); + my($url,$target,$cookie,$nph,@other) = $self->rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p); + $url = $url || $self->self_url; + my(@o); + foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); } + unshift(@o, + '-Status'=>'302 Moved', + '-Location'=>$url, + '-nph'=>$nph); + unshift(@o,'-Target'=>$target) if $target; + unshift(@o,'-Cookie'=>$cookie) if $cookie; + return $self->header(@o); +} +END_OF_FUNC + + +#### Method: start_html +# Canned HTML header +# +# Parameters: +# $title -> (optional) The title for this HTML document (-title) +# $author -> (optional) e-mail address of the author (-author) +# $base -> (optional) if set to true, will enter the BASE address of this document +# for resolving relative references (-base) +# $xbase -> (optional) alternative base at some remote location (-xbase) +# $target -> (optional) target window to load all links into (-target) +# $script -> (option) Javascript code (-script) +# $no_script -> (option) Javascript +END + ; + my($other) = @other ? " @other" : ''; + push(@result,""); + return join("\n",@result); +} +END_OF_FUNC + +### Method: _style +# internal method for generating a CSS style section +#### +'_style' => <<'END_OF_FUNC', +sub _style { + my ($self,$style) = @_; + my (@result); + my $type = 'text/css'; + if (ref($style)) { + my($src,$code,$stype,@other) = + $self->rearrange([SRC,CODE,TYPE], + '-foo'=>'bar', # a trick to allow the '-' to be omitted + ref($style) eq 'ARRAY' ? @$style : %$style); + $type = $stype if $stype; + push(@result,qq//) if $src; + push(@result,style({'type'=>$type},"")) if $code; + } else { + push(@result,style({'type'=>$type},"")); + } + @result; +} +END_OF_FUNC + + +'_script' => <<'END_OF_FUNC', +sub _script { + my ($self,$script) = @_; + my (@result); + my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script); + foreach $script (@scripts) { + my($src,$code,$language); + if (ref($script)) { # script is a hash + ($src,$code,$language) = + $self->rearrange([SRC,CODE,LANGUAGE], + '-foo'=>'bar', # a trick to allow the '-' to be omitted + ref($style) eq 'ARRAY' ? @$script : %$script); + + } else { + ($src,$code,$language) = ('',$script,'JavaScript'); + } + my(@satts); + push(@satts,'src'=>$src) if $src; + push(@satts,'language'=>$language || 'JavaScript'); + $code = "" + if $code && $language=~/javascript/i; + $code = "" + if $code && $language=~/perl/i; + push(@result,script({@satts},$code)); + } + @result; +} +END_OF_FUNC + +#### Method: end_html +# End an HTML document. +# Trivial method for completeness. Just returns "" +#### +'end_html' => <<'END_OF_FUNC', +sub end_html { + return ""; +} +END_OF_FUNC + + +################################ +# METHODS USED IN BUILDING FORMS +################################ + +#### Method: isindex +# Just prints out the isindex tag. +# Parameters: +# $action -> optional URL of script to run +# Returns: +# A string containing a tag +'isindex' => <<'END_OF_FUNC', +sub isindex { + my($self,@p) = self_or_default(@_); + my($action,@other) = $self->rearrange([ACTION],@p); + $action = qq/ACTION="$action"/ if $action; + my($other) = @other ? " @other" : ''; + return ""; +} +END_OF_FUNC + + +#### Method: startform +# Start a form +# Parameters: +# $method -> optional submission method to use (GET or POST) +# $action -> optional URL of script to run +# $enctype ->encoding to use (URL_ENCODED or MULTIPART) +'startform' => <<'END_OF_FUNC', +sub startform { + my($self,@p) = self_or_default(@_); + + my($method,$action,$enctype,@other) = + $self->rearrange([METHOD,ACTION,ENCTYPE],@p); + + $method = $method || 'POST'; + $enctype = $enctype || &URL_ENCODED; + $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ? + 'ACTION="'.$self->script_name.'"' : ''; + my($other) = @other ? " @other" : ''; + $self->{'.parametersToAdd'}={}; + return qq/
    \n/; +} +END_OF_FUNC + + +#### Method: start_form +# synonym for startform +'start_form' => <<'END_OF_FUNC', +sub start_form { + &startform; +} +END_OF_FUNC + + +#### Method: start_multipart_form +# synonym for startform +'start_multipart_form' => <<'END_OF_FUNC', +sub start_multipart_form { + my($self,@p) = self_or_default(@_); + if ($self->use_named_parameters || + (defined($param[0]) && substr($param[0],0,1) eq '-')) { + my(%p) = @p; + $p{'-enctype'}=&MULTIPART; + return $self->startform(%p); + } else { + my($method,$action,@other) = + $self->rearrange([METHOD,ACTION],@p); + return $self->startform($method,$action,&MULTIPART,@other); + } +} +END_OF_FUNC + + +#### Method: endform +# End a form +'endform' => <<'END_OF_FUNC', +sub endform { + my($self,@p) = self_or_default(@_); + return ($self->get_fields,"
    "); +} +END_OF_FUNC + + +#### Method: end_form +# synonym for endform +'end_form' => <<'END_OF_FUNC', +sub end_form { + &endform; +} +END_OF_FUNC + + +'_textfield' => <<'END_OF_FUNC', +sub _textfield { + my($self,$tag,@p) = self_or_default(@_); + my($name,$default,$size,$maxlength,$override,@other) = + $self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p); + + my $current = $override ? $default : + (defined($self->param($name)) ? $self->param($name) : $default); + + $current = defined($current) ? $self->escapeHTML($current) : ''; + $name = defined($name) ? $self->escapeHTML($name) : ''; + my($s) = defined($size) ? qq/ SIZE=$size/ : ''; + my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : ''; + my($other) = @other ? " @other" : ''; + return qq//; +} +END_OF_FUNC + +#### Method: textfield +# Parameters: +# $name -> Name of the text field +# $default -> Optional default value of the field if not +# already defined. +# $size -> Optional width of field in characaters. +# $maxlength -> Optional maximum number of characters. +# Returns: +# A string containing a field +# +'textfield' => <<'END_OF_FUNC', +sub textfield { + my($self,@p) = self_or_default(@_); + $self->_textfield('text',@p); +} +END_OF_FUNC + + +#### Method: filefield +# Parameters: +# $name -> Name of the file upload field +# $size -> Optional width of field in characaters. +# $maxlength -> Optional maximum number of characters. +# Returns: +# A string containing a field +# +'filefield' => <<'END_OF_FUNC', +sub filefield { + my($self,@p) = self_or_default(@_); + $self->_textfield('file',@p); +} +END_OF_FUNC + + +#### Method: password +# Create a "secret password" entry field +# Parameters: +# $name -> Name of the field +# $default -> Optional default value of the field if not +# already defined. +# $size -> Optional width of field in characters. +# $maxlength -> Optional maximum characters that can be entered. +# Returns: +# A string containing a field +# +'password_field' => <<'END_OF_FUNC', +sub password_field { + my ($self,@p) = self_or_default(@_); + $self->_textfield('password',@p); +} +END_OF_FUNC + +#### Method: textarea +# Parameters: +# $name -> Name of the text field +# $default -> Optional default value of the field if not +# already defined. +# $rows -> Optional number of rows in text area +# $columns -> Optional number of columns in text area +# Returns: +# A string containing a tag +# +'textarea' => <<'END_OF_FUNC', +sub textarea { + my($self,@p) = self_or_default(@_); + + my($name,$default,$rows,$cols,$override,@other) = + $self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p); + + my($current)= $override ? $default : + (defined($self->param($name)) ? $self->param($name) : $default); + + $name = defined($name) ? $self->escapeHTML($name) : ''; + $current = defined($current) ? $self->escapeHTML($current) : ''; + my($r) = $rows ? " ROWS=$rows" : ''; + my($c) = $cols ? " COLS=$cols" : ''; + my($other) = @other ? " @other" : ''; + return qq{}; +} +END_OF_FUNC + + +#### Method: button +# Create a javascript button. +# Parameters: +# $name -> (optional) Name for the button. (-name) +# $value -> (optional) Value of the button when selected (and visible name) (-value) +# $onclick -> (optional) Text of the JavaScript to run when the button is +# clicked. +# Returns: +# A string containing a tag +#### +'button' => <<'END_OF_FUNC', +sub button { + my($self,@p) = self_or_default(@_); + + my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL], + [ONCLICK,SCRIPT]],@p); + + $label=$self->escapeHTML($label); + $value=$self->escapeHTML($value); + $script=$self->escapeHTML($script); + + my($name) = ''; + $name = qq/ NAME="$label"/ if $label; + $value = $value || $label; + my($val) = ''; + $val = qq/ VALUE="$value"/ if $value; + $script = qq/ ONCLICK="$script"/ if $script; + my($other) = @other ? " @other" : ''; + return qq//; +} +END_OF_FUNC + + +#### Method: submit +# Create a "submit query" button. +# Parameters: +# $name -> (optional) Name for the button. +# $value -> (optional) Value of the button when selected (also doubles as label). +# $label -> (optional) Label printed on the button(also doubles as the value). +# Returns: +# A string containing a tag +#### +'submit' => <<'END_OF_FUNC', +sub submit { + my($self,@p) = self_or_default(@_); + + my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p); + + $label=$self->escapeHTML($label); + $value=$self->escapeHTML($value); + + my($name) = ' NAME=".submit"'; + $name = qq/ NAME="$label"/ if defined($label); + $value = defined($value) ? $value : $label; + my($val) = ''; + $val = qq/ VALUE="$value"/ if defined($value); + my($other) = @other ? " @other" : ''; + return qq//; +} +END_OF_FUNC + + +#### Method: reset +# Create a "reset" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a tag +#### +'reset' => <<'END_OF_FUNC', +sub reset { + my($self,@p) = self_or_default(@_); + my($label,@other) = $self->rearrange([NAME],@p); + $label=$self->escapeHTML($label); + my($value) = defined($label) ? qq/ VALUE="$label"/ : ''; + my($other) = @other ? " @other" : ''; + return qq//; +} +END_OF_FUNC + + +#### Method: defaults +# Create a "defaults" button. +# Parameters: +# $name -> (optional) Name for the button. +# Returns: +# A string containing a tag +# +# Note: this button has a special meaning to the initialization script, +# and tells it to ERASE the current query string so that your defaults +# are used again! +#### +'defaults' => <<'END_OF_FUNC', +sub defaults { + my($self,@p) = self_or_default(@_); + + my($label,@other) = $self->rearrange([[NAME,VALUE]],@p); + + $label=$self->escapeHTML($label); + $label = $label || "Defaults"; + my($value) = qq/ VALUE="$label"/; + my($other) = @other ? " @other" : ''; + return qq//; +} +END_OF_FUNC + + +#### Method: comment +# Create an HTML +# Parameters: a string +'comment' => <<'END_OF_FUNC', +sub comment { + my($self,@p) = self_or_CGI(@_); + return ""; +} +END_OF_FUNC + +#### Method: checkbox +# Create a checkbox that is not logically linked to any others. +# The field value is "on" when the button is checked. +# Parameters: +# $name -> Name of the checkbox +# $checked -> (optional) turned on by default if true +# $value -> (optional) value of the checkbox, 'on' by default +# $label -> (optional) a user-readable label printed next to the box. +# Otherwise the checkbox name is used. +# Returns: +# A string containing a field +#### +'checkbox' => <<'END_OF_FUNC', +sub checkbox { + my($self,@p) = self_or_default(@_); + + my($name,$checked,$value,$label,$override,@other) = + $self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p); + + $value = defined $value ? $value : 'on'; + + if (!$override && ($self->{'.fieldnames'}->{$name} || + defined $self->param($name))) { + $checked = grep($_ eq $value,$self->param($name)) ? ' CHECKED' : ''; + } else { + $checked = $checked ? ' CHECKED' : ''; + } + my($the_label) = defined $label ? $label : $name; + $name = $self->escapeHTML($name); + $value = $self->escapeHTML($value); + $the_label = $self->escapeHTML($the_label); + my($other) = @other ? " @other" : ''; + $self->register_parameter($name); + return <$the_label +END +} +END_OF_FUNC + + +#### Method: checkbox_group +# Create a list of logically-linked checkboxes. +# Parameters: +# $name -> Common name for all the check boxes +# $values -> A pointer to a regular array containing the +# values for each checkbox in the group. +# $defaults -> (optional) +# 1. If a pointer to a regular array of checkbox values, +# then this will be used to decide which +# checkboxes to turn on by default. +# 2. If a scalar, will be assumed to hold the +# value of a single checkbox in the group to turn on. +# $linebreak -> (optional) Set to true to place linebreaks +# between the buttons. +# $labels -> (optional) +# A pointer to an associative array of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# An ARRAY containing a series of fields +#### +'checkbox_group' => <<'END_OF_FUNC', +sub checkbox_group { + my($self,@p) = self_or_default(@_); + + my($name,$values,$defaults,$linebreak,$labels,$rows,$columns, + $rowheaders,$colheaders,$override,$nolabels,@other) = + $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT], + LINEBREAK,LABELS,ROWS,[COLUMNS,COLS], + ROWHEADERS,COLHEADERS, + [OVERRIDE,FORCE],NOLABELS],@p); + + my($checked,$break,$result,$label); + + my(%checked) = $self->previous_or_default($name,$defaults,$override); + + $break = $linebreak ? "
    " : ''; + $name=$self->escapeHTML($name); + + # Create the elements + my(@elements,@values); + + @values = $self->_set_values_and_labels($values,\$labels,$name); + + my($other) = @other ? " @other" : ''; + foreach (@values) { + $checked = $checked{$_} ? ' CHECKED' : ''; + $label = ''; + unless (defined($nolabels) && $nolabels) { + $label = $_; + $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); + $label = $self->escapeHTML($label); + } + $_ = $self->escapeHTML($_); + push(@elements,qq/${label}${break}/); + } + $self->register_parameter($name); + return wantarray ? @elements : join(' ',@elements) + unless defined($columns) || defined($rows); + return _tableize($rows,$columns,$rowheaders,$colheaders,@elements); +} +END_OF_FUNC + +# Escape HTML -- used internally +'escapeHTML' => <<'END_OF_FUNC', +sub escapeHTML { + my($self,$toencode) = @_; + $toencode = $self unless ref($self); + return undef unless defined($toencode); + return $toencode if ref($self) && $self->{'dontescape'}; + + $toencode=~s/&/&/g; + $toencode=~s/\"/"/g; + $toencode=~s/>/>/g; + $toencode=~s/ <<'END_OF_FUNC', +sub unescapeHTML { + my $string = ref($_[0]) ? $_[1] : $_[0]; + return undef unless defined($string); + $string=~s/&/&/ig; + $string=~s/"/\"/ig; + $string=~s/>/>/ig; + $string=~s/</ <<'END_OF_FUNC', +sub _tableize { + my($rows,$columns,$rowheaders,$colheaders,@elements) = @_; + my($result); + + if (defined($columns)) { + $rows = int(0.99 + @elements/$columns) unless defined($rows); + } + if (defined($rows)) { + $columns = int(0.99 + @elements/$rows) unless defined($columns); + } + + # rearrange into a pretty table + $result = ""; + my($row,$column); + unshift(@$colheaders,'') if defined(@$colheaders) && defined(@$rowheaders); + $result .= "" if defined(@{$colheaders}); + foreach (@{$colheaders}) { + $result .= ""; + } + for ($row=0;$row<$rows;$row++) { + $result .= ""; + $result .= "" if defined(@$rowheaders); + for ($column=0;$column<$columns;$column++) { + $result .= "" + if defined($elements[$column*$rows + $row]); + } + $result .= ""; + } + $result .= "
    $_
    $rowheaders->[$row]" . $elements[$column*$rows + $row] . "
    "; + return $result; +} +END_OF_FUNC + + +#### Method: radio_group +# Create a list of logically-linked radio buttons. +# Parameters: +# $name -> Common name for all the buttons. +# $values -> A pointer to a regular array containing the +# values for each button in the group. +# $default -> (optional) Value of the button to turn on by default. Pass '-' +# to turn _nothing_ on. +# $linebreak -> (optional) Set to true to place linebreaks +# between the buttons. +# $labels -> (optional) +# A pointer to an associative array of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# An ARRAY containing a series of fields +#### +'radio_group' => <<'END_OF_FUNC', +sub radio_group { + my($self,@p) = self_or_default(@_); + + my($name,$values,$default,$linebreak,$labels, + $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) = + $self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS, + ROWS,[COLUMNS,COLS], + ROWHEADERS,COLHEADERS, + [OVERRIDE,FORCE],NOLABELS],@p); + my($result,$checked); + + if (!$override && defined($self->param($name))) { + $checked = $self->param($name); + } else { + $checked = $default; + } + # If no check array is specified, check the first by default + $checked = $values->[0] unless defined($checked) && $checked ne ''; + $name=$self->escapeHTML($name); + + my(@elements,@values); + + @values = $self->_set_values_and_labels($values,\$labels,$name); + + my($other) = @other ? " @other" : ''; + foreach (@values) { + my($checkit) = $checked eq $_ ? ' CHECKED' : ''; + my($break) = $linebreak ? '
    ' : ''; + my($label)=''; + unless (defined($nolabels) && $nolabels) { + $label = $_; + $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); + $label = $self->escapeHTML($label); + } + $_=$self->escapeHTML($_); + push(@elements,qq/${label}${break}/); + } + $self->register_parameter($name); + return wantarray ? @elements : join(' ',@elements) + unless defined($columns) || defined($rows); + return _tableize($rows,$columns,$rowheaders,$colheaders,@elements); +} +END_OF_FUNC + + +#### Method: popup_menu +# Create a popup menu. +# Parameters: +# $name -> Name for all the menu +# $values -> A pointer to a regular array containing the +# text of each menu item. +# $default -> (optional) Default item to display +# $labels -> (optional) +# A pointer to an associative array of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# A string containing the definition of a popup menu. +#### +'popup_menu' => <<'END_OF_FUNC', +sub popup_menu { + my($self,@p) = self_or_default(@_); + + my($name,$values,$default,$labels,$override,@other) = + $self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p); + my($result,$selected); + + if (!$override && defined($self->param($name))) { + $selected = $self->param($name); + } else { + $selected = $default; + } + $name=$self->escapeHTML($name); + my($other) = @other ? " @other" : ''; + + my(@values); + @values = $self->_set_values_and_labels($values,\$labels,$name); + + $result = qq/\n"; + return $result; +} +END_OF_FUNC + + +#### Method: scrolling_list +# Create a scrolling list. +# Parameters: +# $name -> name for the list +# $values -> A pointer to a regular array containing the +# values for each option line in the list. +# $defaults -> (optional) +# 1. If a pointer to a regular array of options, +# then this will be used to decide which +# lines to turn on by default. +# 2. Otherwise holds the value of the single line to turn on. +# $size -> (optional) Size of the list. +# $multiple -> (optional) If set, allow multiple selections. +# $labels -> (optional) +# A pointer to an associative array of labels to print next to each checkbox +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# Returns: +# A string containing the definition of a scrolling list. +#### +'scrolling_list' => <<'END_OF_FUNC', +sub scrolling_list { + my($self,@p) = self_or_default(@_); + my($name,$values,$defaults,$size,$multiple,$labels,$override,@other) + = $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT], + SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p); + + my($result,@values); + @values = $self->_set_values_and_labels($values,\$labels,$name); + + $size = $size || scalar(@values); + + my(%selected) = $self->previous_or_default($name,$defaults,$override); + my($is_multiple) = $multiple ? ' MULTIPLE' : ''; + my($has_size) = $size ? " SIZE=$size" : ''; + my($other) = @other ? " @other" : ''; + + $name=$self->escapeHTML($name); + $result = qq/\n"; + $self->register_parameter($name); + return $result; +} +END_OF_FUNC + + +#### Method: hidden +# Parameters: +# $name -> Name of the hidden field +# @default -> (optional) Initial values of field (may be an array) +# or +# $default->[initial values of field] +# Returns: +# A string containing a +#### +'hidden' => <<'END_OF_FUNC', +sub hidden { + my($self,@p) = self_or_default(@_); + + # this is the one place where we departed from our standard + # calling scheme, so we have to special-case (darn) + my(@result,@value); + my($name,$default,$override,@other) = + $self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p); + + my $do_override = 0; + if ( ref($p[0]) || substr($p[0],0,1) eq '-' || $self->use_named_parameters ) { + @value = ref($default) ? @{$default} : $default; + $do_override = $override; + } else { + foreach ($default,$override,@other) { + push(@value,$_) if defined($_); + } + } + + # use previous values if override is not set + my @prev = $self->param($name); + @value = @prev if !$do_override && @prev; + + $name=$self->escapeHTML($name); + foreach (@value) { + $_=$self->escapeHTML($_); + push(@result,qq//); + } + return wantarray ? @result : join('',@result); +} +END_OF_FUNC + + +#### Method: image_button +# Parameters: +# $name -> Name of the button +# $src -> URL of the image source +# $align -> Alignment style (TOP, BOTTOM or MIDDLE) +# Returns: +# A string containing a +#### +'image_button' => <<'END_OF_FUNC', +sub image_button { + my($self,@p) = self_or_default(@_); + + my($name,$src,$alignment,@other) = + $self->rearrange([NAME,SRC,ALIGN],@p); + + my($align) = $alignment ? " ALIGN=\U$alignment" : ''; + my($other) = @other ? " @other" : ''; + $name=$self->escapeHTML($name); + return qq//; +} +END_OF_FUNC + + +#### Method: self_url +# Returns a URL containing the current script and all its +# param/value pairs arranged as a query. You can use this +# to create a link that, when selected, will reinvoke the +# script with all its state information preserved. +#### +'self_url' => <<'END_OF_FUNC', +sub self_url { + my($self,@p) = self_or_default(@_); + return $self->url('-path_info'=>1,'-query'=>1,'-full'=>1,@p); +} +END_OF_FUNC + + +# This is provided as a synonym to self_url() for people unfortunate +# enough to have incorporated it into their programs already! +'state' => <<'END_OF_FUNC', +sub state { + &self_url; +} +END_OF_FUNC + + +#### Method: url +# Like self_url, but doesn't return the query string part of +# the URL. +#### +'url' => <<'END_OF_FUNC', +sub url { + my($self,@p) = self_or_default(@_); + my ($relative,$absolute,$full,$path_info,$query) = + $self->rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p); + my $url; + $full++ if !($relative || $absolute); + + if ($full) { + my $protocol = $self->protocol(); + $url = "$protocol://"; + my $vh = http('host'); + if ($vh) { + $url .= $vh; + } else { + $url .= server_name(); + my $port = $self->server_port; + $url .= ":" . $port + unless (lc($protocol) eq 'http' && $port == 80) + || (lc($protocol) eq 'https' && $port == 443); + } + $url .= $self->script_name; + } elsif ($relative) { + ($url) = $self->script_name =~ m!([^/]+)$!; + } elsif ($absolute) { + $url = $self->script_name; + } + $url .= $self->path_info if $path_info and $self->path_info; + $url .= "?" . $self->query_string if $query and $self->query_string; + return $url; +} + +END_OF_FUNC + +#### Method: cookie +# Set or read a cookie from the specified name. +# Cookie can then be passed to header(). +# Usual rules apply to the stickiness of -value. +# Parameters: +# -name -> name for this cookie (optional) +# -value -> value of this cookie (scalar, array or hash) +# -path -> paths for which this cookie is valid (optional) +# -domain -> internet domain in which this cookie is valid (optional) +# -secure -> if true, cookie only passed through secure channel (optional) +# -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional) +#### +'cookie' => <<'END_OF_FUNC', +sub cookie { + my($self,@p) = self_or_default(@_); + my($name,$value,$path,$domain,$secure,$expires) = + $self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p); + + require CGI::Cookie; + + # if no value is supplied, then we retrieve the + # value of the cookie, if any. For efficiency, we cache the parsed + # cookies in our state variables. + unless ( defined($value) ) { + $self->{'.cookies'} = CGI::Cookie->fetch + unless $self->{'.cookies'}; + + # If no name is supplied, then retrieve the names of all our cookies. + return () unless $self->{'.cookies'}; + return keys %{$self->{'.cookies'}} unless $name; + return () unless $self->{'.cookies'}->{$name}; + return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne ''; + } + + # If we get here, we're creating a new cookie + return undef unless $name; # this is an error + + my @param; + push(@param,'-name'=>$name); + push(@param,'-value'=>$value); + push(@param,'-domain'=>$domain) if $domain; + push(@param,'-path'=>$path) if $path; + push(@param,'-expires'=>$expires) if $expires; + push(@param,'-secure'=>$secure) if $secure; + + return new CGI::Cookie(@param); +} +END_OF_FUNC + +# This internal routine creates an expires time exactly some number of +# hours from the current time. It incorporates modifications from +# Mark Fisher. +'expire_calc' => <<'END_OF_FUNC', +sub expire_calc { + my($time) = @_; + my(%mult) = ('s'=>1, + 'm'=>60, + 'h'=>60*60, + 'd'=>60*60*24, + 'M'=>60*60*24*30, + 'y'=>60*60*24*365); + # format for time can be in any of the forms... + # "now" -- expire immediately + # "+180s" -- in 180 seconds + # "+2m" -- in 2 minutes + # "+12h" -- in 12 hours + # "+1d" -- in 1 day + # "+3M" -- in 3 months + # "+2y" -- in 2 years + # "-3m" -- 3 minutes ago(!) + # If you don't supply one of these forms, we assume you are + # specifying the date yourself + my($offset); + if (!$time || (lc($time) eq 'now')) { + $offset = 0; + } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) { + $offset = ($mult{$2} || 1)*$1; + } else { + return $time; + } + return (time+$offset); +} +END_OF_FUNC + +# This internal routine creates date strings suitable for use in +# cookies and HTTP headers. (They differ, unfortunately.) +# Thanks to Fisher Mark for this. +'expires' => <<'END_OF_FUNC', +sub expires { + my($time,$format) = @_; + $format ||= 'http'; + + my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; + my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/; + + # pass through preformatted dates for the sake of expire_calc() + $time = expire_calc($time); + return $time unless $time =~ /^\d+$/; + + # make HTTP/cookie date string from GMT'ed time + # (cookies use '-' as date separator, HTTP uses ' ') + my($sc) = ' '; + $sc = '-' if $format eq "cookie"; + my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time); + $year += 1900; + return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT", + $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec); +} +END_OF_FUNC + +'parse_keywordlist' => <<'END_OF_FUNC', +sub parse_keywordlist { + my($self,$tosplit) = @_; + $tosplit = unescape($tosplit); # unescape the keywords + $tosplit=~tr/+/ /; # pluses to spaces + my(@keywords) = split(/\s+/,$tosplit); + return @keywords; +} +END_OF_FUNC + +'param_fetch' => <<'END_OF_FUNC', +sub param_fetch { + my($self,@p) = self_or_default(@_); + my($name) = $self->rearrange([NAME],@p); + unless (exists($self->{$name})) { + $self->add_parameter($name); + $self->{$name} = []; + } + + return $self->{$name}; +} +END_OF_FUNC + +############################################### +# OTHER INFORMATION PROVIDED BY THE ENVIRONMENT +############################################### + +#### Method: path_info +# Return the extra virtual path information provided +# after the URL (if any) +#### +'path_info' => <<'END_OF_FUNC', +sub path_info { + my ($self,$info) = self_or_default(@_); + if (defined($info)) { + $info = "/$info" if $info ne '' && substr($info,0,1) ne '/'; + $self->{'.path_info'} = $info; + } elsif (! defined($self->{'.path_info'}) ) { + $self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ? + $ENV{'PATH_INFO'} : ''; + + # hack to fix broken path info in IIS + $self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS; + + } + return $self->{'.path_info'}; +} +END_OF_FUNC + + +#### Method: request_method +# Returns 'POST', 'GET', 'PUT' or 'HEAD' +#### +'request_method' => <<'END_OF_FUNC', +sub request_method { + return $ENV{'REQUEST_METHOD'}; +} +END_OF_FUNC + +#### Method: path_translated +# Return the physical path information provided +# by the URL (if any) +#### +'path_translated' => <<'END_OF_FUNC', +sub path_translated { + return $ENV{'PATH_TRANSLATED'}; +} +END_OF_FUNC + + +#### Method: query_string +# Synthesize a query string from our current +# parameters +#### +'query_string' => <<'END_OF_FUNC', +sub query_string { + my($self) = self_or_default(@_); + my($param,$value,@pairs); + foreach $param ($self->param) { + my($eparam) = escape($param); + foreach $value ($self->param($param)) { + $value = escape($value); + push(@pairs,"$eparam=$value"); + } + } + return join("&",@pairs); +} +END_OF_FUNC + + +#### Method: accept +# Without parameters, returns an array of the +# MIME types the browser accepts. +# With a single parameter equal to a MIME +# type, will return undef if the browser won't +# accept it, 1 if the browser accepts it but +# doesn't give a preference, or a floating point +# value between 0.0 and 1.0 if the browser +# declares a quantitative score for it. +# This handles MIME type globs correctly. +#### +'accept' => <<'END_OF_FUNC', +sub accept { + my($self,$search) = self_or_CGI(@_); + my(%prefs,$type,$pref,$pat); + + my(@accept) = split(',',$self->http('accept')); + + foreach (@accept) { + ($pref) = /q=(\d\.\d+|\d+)/; + ($type) = m#(\S+/[^;]+)#; + next unless $type; + $prefs{$type}=$pref || 1; + } + + return keys %prefs unless $search; + + # if a search type is provided, we may need to + # perform a pattern matching operation. + # The MIME types use a glob mechanism, which + # is easily translated into a perl pattern match + + # First return the preference for directly supported + # types: + return $prefs{$search} if $prefs{$search}; + + # Didn't get it, so try pattern matching. + foreach (keys %prefs) { + next unless /\*/; # not a pattern match + ($pat = $_) =~ s/([^\w*])/\\$1/g; # escape meta characters + $pat =~ s/\*/.*/g; # turn it into a pattern + return $prefs{$_} if $search=~/$pat/; + } +} +END_OF_FUNC + + +#### Method: user_agent +# If called with no parameters, returns the user agent. +# If called with one parameter, does a pattern match (case +# insensitive) on the user agent. +#### +'user_agent' => <<'END_OF_FUNC', +sub user_agent { + my($self,$match)=self_or_CGI(@_); + return $self->http('user_agent') unless $match; + return $self->http('user_agent') =~ /$match/i; +} +END_OF_FUNC + + +#### Method: raw_cookie +# Returns the magic cookies for the session. +# The cookies are not parsed or altered in any way, i.e. +# cookies are returned exactly as given in the HTTP +# headers. If a cookie name is given, only that cookie's +# value is returned, otherwise the entire raw cookie +# is returned. +#### +'raw_cookie' => <<'END_OF_FUNC', +sub raw_cookie { + my($self,$key) = self_or_CGI(@_); + + require CGI::Cookie; + + if (defined($key)) { + $self->{'.raw_cookies'} = CGI::Cookie->raw_fetch + unless $self->{'.raw_cookies'}; + + return () unless $self->{'.raw_cookies'}; + return () unless $self->{'.raw_cookies'}->{$key}; + return $self->{'.raw_cookies'}->{$key}; + } + return $self->http('cookie') || $ENV{'COOKIE'} || ''; +} +END_OF_FUNC + +#### Method: virtual_host +# Return the name of the virtual_host, which +# is not always the same as the server +###### +'virtual_host' => <<'END_OF_FUNC', +sub virtual_host { + my $vh = http('host') || server_name(); + $vh =~ s/:\d+$//; # get rid of port number + return $vh; +} +END_OF_FUNC + +#### Method: remote_host +# Return the name of the remote host, or its IP +# address if unavailable. If this variable isn't +# defined, it returns "localhost" for debugging +# purposes. +#### +'remote_host' => <<'END_OF_FUNC', +sub remote_host { + return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} + || 'localhost'; +} +END_OF_FUNC + + +#### Method: remote_addr +# Return the IP addr of the remote host. +#### +'remote_addr' => <<'END_OF_FUNC', +sub remote_addr { + return $ENV{'REMOTE_ADDR'} || '127.0.0.1'; +} +END_OF_FUNC + + +#### Method: script_name +# Return the partial URL to this script for +# self-referencing scripts. Also see +# self_url(), which returns a URL with all state information +# preserved. +#### +'script_name' => <<'END_OF_FUNC', +sub script_name { + return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'}); + # These are for debugging + return "/$0" unless $0=~/^\//; + return $0; +} +END_OF_FUNC + + +#### Method: referer +# Return the HTTP_REFERER: useful for generating +# a GO BACK button. +#### +'referer' => <<'END_OF_FUNC', +sub referer { + my($self) = self_or_CGI(@_); + return $self->http('referer'); +} +END_OF_FUNC + + +#### Method: server_name +# Return the name of the server +#### +'server_name' => <<'END_OF_FUNC', +sub server_name { + return $ENV{'SERVER_NAME'} || 'localhost'; +} +END_OF_FUNC + +#### Method: server_software +# Return the name of the server software +#### +'server_software' => <<'END_OF_FUNC', +sub server_software { + return $ENV{'SERVER_SOFTWARE'} || 'cmdline'; +} +END_OF_FUNC + +#### Method: server_port +# Return the tcp/ip port the server is running on +#### +'server_port' => <<'END_OF_FUNC', +sub server_port { + return $ENV{'SERVER_PORT'} || 80; # for debugging +} +END_OF_FUNC + +#### Method: server_protocol +# Return the protocol (usually HTTP/1.0) +#### +'server_protocol' => <<'END_OF_FUNC', +sub server_protocol { + return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; # for debugging +} +END_OF_FUNC + +#### Method: http +# Return the value of an HTTP variable, or +# the list of variables if none provided +#### +'http' => <<'END_OF_FUNC', +sub http { + my ($self,$parameter) = self_or_CGI(@_); + return $ENV{$parameter} if $parameter=~/^HTTP/; + return $ENV{"HTTP_\U$parameter\E"} if $parameter; + my(@p); + foreach (keys %ENV) { + push(@p,$_) if /^HTTP/; + } + return @p; +} +END_OF_FUNC + +#### Method: https +# Return the value of HTTPS +#### +'https' => <<'END_OF_FUNC', +sub https { + local($^W)=0; + my ($self,$parameter) = self_or_CGI(@_); + return $ENV{HTTPS} unless $parameter; + return $ENV{$parameter} if $parameter=~/^HTTPS/; + return $ENV{"HTTPS_\U$parameter\E"} if $parameter; + my(@p); + foreach (keys %ENV) { + push(@p,$_) if /^HTTPS/; + } + return @p; +} +END_OF_FUNC + +#### Method: protocol +# Return the protocol (http or https currently) +#### +'protocol' => <<'END_OF_FUNC', +sub protocol { + local($^W)=0; + my $self = shift; + return 'https' if uc($self->https()) eq 'ON'; + return 'https' if $self->server_port == 443; + my $prot = $self->server_protocol; + my($protocol,$version) = split('/',$prot); + return "\L$protocol\E"; +} +END_OF_FUNC + +#### Method: remote_ident +# Return the identity of the remote user +# (but only if his host is running identd) +#### +'remote_ident' => <<'END_OF_FUNC', +sub remote_ident { + return $ENV{'REMOTE_IDENT'}; +} +END_OF_FUNC + + +#### Method: auth_type +# Return the type of use verification/authorization in use, if any. +#### +'auth_type' => <<'END_OF_FUNC', +sub auth_type { + return $ENV{'AUTH_TYPE'}; +} +END_OF_FUNC + + +#### Method: remote_user +# Return the authorization name used for user +# verification. +#### +'remote_user' => <<'END_OF_FUNC', +sub remote_user { + return $ENV{'REMOTE_USER'}; +} +END_OF_FUNC + + +#### Method: user_name +# Try to return the remote user's name by hook or by +# crook +#### +'user_name' => <<'END_OF_FUNC', +sub user_name { + my ($self) = self_or_CGI(@_); + return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'}; +} +END_OF_FUNC + +#### Method: nph +# Set or return the NPH global flag +#### +'nph' => <<'END_OF_FUNC', +sub nph { + my ($self,$param) = self_or_CGI(@_); + $CGI::NPH = $param if defined($param); + return $CGI::NPH; +} +END_OF_FUNC + +#### Method: private_tempfiles +# Set or return the private_tempfiles global flag +#### +'private_tempfiles' => <<'END_OF_FUNC', +sub private_tempfiles { + my ($self,$param) = self_or_CGI(@_); + $CGI::PRIVATE_TEMPFILES = $param if defined($param); + return $CGI::PRIVATE_TEMPFILES; +} +END_OF_FUNC + +#### Method: default_dtd +# Set or return the default_dtd global +#### +'default_dtd' => <<'END_OF_FUNC', +sub default_dtd { + my ($self,$param) = self_or_CGI(@_); + $CGI::DEFAULT_DTD = $param if defined($param); + return $CGI::DEFAULT_DTD; +} +END_OF_FUNC + +# -------------- really private subroutines ----------------- +'previous_or_default' => <<'END_OF_FUNC', +sub previous_or_default { + my($self,$name,$defaults,$override) = @_; + my(%selected); + + if (!$override && ($self->{'.fieldnames'}->{$name} || + defined($self->param($name)) ) ) { + grep($selected{$_}++,$self->param($name)); + } elsif (defined($defaults) && ref($defaults) && + (ref($defaults) eq 'ARRAY')) { + grep($selected{$_}++,@{$defaults}); + } else { + $selected{$defaults}++ if defined($defaults); + } + + return %selected; +} +END_OF_FUNC + +'register_parameter' => <<'END_OF_FUNC', +sub register_parameter { + my($self,$param) = @_; + $self->{'.parametersToAdd'}->{$param}++; +} +END_OF_FUNC + +'get_fields' => <<'END_OF_FUNC', +sub get_fields { + my($self) = @_; + return $self->CGI::hidden('-name'=>'.cgifields', + '-values'=>[keys %{$self->{'.parametersToAdd'}}], + '-override'=>1); +} +END_OF_FUNC + +'read_from_cmdline' => <<'END_OF_FUNC', +sub read_from_cmdline { + my($input,@words); + my($query_string); + if (@ARGV) { + @words = @ARGV; + } else { + require "shellwords.pl"; + print STDERR "(offline mode: enter name=value pairs on standard input)\n"; + chomp(@lines = ); # remove newlines + $input = join(" ",@lines); + @words = &shellwords($input); + } + foreach (@words) { + s/\\=/%3D/g; + s/\\&/%26/g; + } + + if ("@words"=~/=/) { + $query_string = join('&',@words); + } else { + $query_string = join('+',@words); + } + return $query_string; +} +END_OF_FUNC + +##### +# subroutine: read_multipart +# +# Read multipart data and store it into our parameters. +# An interesting feature is that if any of the parts is a file, we +# create a temporary file and open up a filehandle on it so that the +# caller can read from it if necessary. +##### +'read_multipart' => <<'END_OF_FUNC', +sub read_multipart { + my($self,$boundary,$length,$filehandle) = @_; + my($buffer) = $self->new_MultipartBuffer($boundary,$length,$filehandle); + return unless $buffer; + my(%header,$body); + my $filenumber = 0; + while (!$buffer->eof) { + %header = $buffer->readHeader; + die "Malformed multipart POST\n" unless %header; + + my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/; + + # Bug: Netscape doesn't escape quotation marks in file names!!! + my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/; + + # add this parameter to our list + $self->add_parameter($param); + + # If no filename specified, then just read the data and assign it + # to our parameter list. + unless ($filename) { + my($value) = $buffer->readBody; + push(@{$self->{$param}},$value); + next; + } + + my ($tmpfile,$tmp,$filehandle); + UPLOADS: { + # If we get here, then we are dealing with a potentially large + # uploaded form. Save the data to a temporary file, then open + # the file for reading. + + # skip the file if uploads disabled + if ($DISABLE_UPLOADS) { + while (defined($data = $buffer->read)) { } + last UPLOADS; + } + + $tmpfile = new TempFile; + $tmp = $tmpfile->as_string; + + $filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES); + + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + chmod 0600,$tmp; # only the owner can tamper with it + + my ($data); + while (defined($data = $buffer->read)) { + print $filehandle $data; + } + + # back up to beginning of file + seek($filehandle,0,0); + $CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode; + + # Save some information about the uploaded file where we can get + # at it later. + $self->{'.tmpfiles'}->{$filename}= { + name => $tmpfile, + info => {%header}, + }; + push(@{$self->{$param}},$filehandle); + } + } +} +END_OF_FUNC + +'tmpFileName' => <<'END_OF_FUNC', +sub tmpFileName { + my($self,$filename) = self_or_default(@_); + return $self->{'.tmpfiles'}->{$filename}->{name} ? + $self->{'.tmpfiles'}->{$filename}->{name}->as_string + : ''; +} +END_OF_FUNC + +'uploadInfo' => <<'END_OF_FUNC', +sub uploadInfo { + my($self,$filename) = self_or_default(@_); + return $self->{'.tmpfiles'}->{$filename}->{info}; +} +END_OF_FUNC + +# internal routine, don't use +'_set_values_and_labels' => <<'END_OF_FUNC', +sub _set_values_and_labels { + my $self = shift; + my ($v,$l,$n) = @_; + $$l = $v if ref($v) eq 'HASH' && !ref($$l); + return $self->param($n) if !defined($v); + return $v if !ref($v); + return ref($v) eq 'HASH' ? keys %$v : @$v; +} +END_OF_FUNC + +'_compile_all' => <<'END_OF_FUNC', +sub _compile_all { + foreach (@_) { + next if defined(&$_); + $AUTOLOAD = "CGI::$_"; + _compile(); + } +} +END_OF_FUNC + +); +END_OF_AUTOLOAD +; + +######################################################### +# Globals and stubs for other packages that we use. +######################################################### + +################### Fh -- lightweight filehandle ############### +package Fh; +use overload + '""' => \&asString, + 'cmp' => \&compare, + 'fallback'=>1; + +$FH='fh00000'; + +*Fh::AUTOLOAD = \&CGI::AUTOLOAD; + +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( +'asString' => <<'END_OF_FUNC', +sub asString { + my $self = shift; + my $i = $$self; + $i=~ s/^\*(\w+::)+//; # get rid of package name + $i =~ s/\\(.)/$1/g; + return $i; +} +END_OF_FUNC + +'compare' => <<'END_OF_FUNC', +sub compare { + my $self = shift; + my $value = shift; + return "$self" cmp $value; +} +END_OF_FUNC + +'new' => <<'END_OF_FUNC', +sub new { + my($pack,$name,$file,$delete) = @_; + require Fcntl unless defined &Fcntl::O_RDWR; + ++$FH; + *{$FH} = quotemeta($name); + sysopen($FH,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL()) + || die "CGI open of $file: $!\n"; + unlink($file) if $delete; + return bless \*{$FH},$pack; +} +END_OF_FUNC + +'DESTROY' => <<'END_OF_FUNC', +sub DESTROY { + my $self = shift; + close $self; +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +######################## MultipartBuffer #################### +package MultipartBuffer; + +# how many bytes to read at a time. We use +# a 5K buffer by default. +$INITIAL_FILLUNIT = 1024 * 5; +$TIMEOUT = 10*60; # 10 minute timeout +$SPIN_LOOP_MAX = 1000; # bug fix for some Netscape servers +$CRLF=$CGI::CRLF; + +#reuse the autoload function +*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD; + +# avoid autoloader warnings +sub DESTROY {} + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( + +'new' => <<'END_OF_FUNC', +sub new { + my($package,$interface,$boundary,$length,$filehandle) = @_; + $FILLUNIT = $INITIAL_FILLUNIT; + my $IN; + if ($filehandle) { + my($package) = caller; + # force into caller's package if necessary + $IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; + } + $IN = "main::STDIN" unless $IN; + + $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode; + + # If the user types garbage into the file upload field, + # then Netscape passes NOTHING to the server (not good). + # We may hang on this read in that case. So we implement + # a read timeout. If nothing is ready to read + # by then, we return. + + # Netscape seems to be a little bit unreliable + # about providing boundary strings. + if ($boundary) { + + # Under the MIME spec, the boundary consists of the + # characters "--" PLUS the Boundary string + + # BUG: IE 3.01 on the Macintosh uses just the boundary -- not + # the two extra spaces. We do a special case here on the user-agent!!!! + $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; Mac'); + + } else { # otherwise we find it ourselves + my($old); + ($old,$/) = ($/,$CRLF); # read a CRLF-delimited line + $boundary = <$IN>; # BUG: This won't work correctly under mod_perl + $length -= length($boundary); + chomp($boundary); # remove the CRLF + $/ = $old; # restore old line separator + } + + my $self = {LENGTH=>$length, + BOUNDARY=>$boundary, + IN=>$IN, + INTERFACE=>$interface, + BUFFER=>'', + }; + + $FILLUNIT = length($boundary) + if length($boundary) > $FILLUNIT; + + my $retval = bless $self,ref $package || $package; + + # Read the preamble and the topmost (boundary) line plus the CRLF. + while ($self->read(0)) { } + die "Malformed multipart POST\n" if $self->eof; + + return $retval; +} +END_OF_FUNC + +'readHeader' => <<'END_OF_FUNC', +sub readHeader { + my($self) = @_; + my($end); + my($ok) = 0; + my($bad) = 0; + + if ($CGI::OS eq 'VMS') { # tssk, tssk: inconsistency alert! + local($CRLF) = "\015\012"; + } + + do { + $self->fillBuffer($FILLUNIT); + $ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0; + $ok++ if $self->{BUFFER} eq ''; + $bad++ if !$ok && $self->{LENGTH} <= 0; + # this was a bad idea + # $FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; + } until $ok || $bad; + return () if $bad; + + my($header) = substr($self->{BUFFER},0,$end+2); + substr($self->{BUFFER},0,$end+4) = ''; + my %return; + + + # See RFC 2045 Appendix A and RFC 822 sections 3.4.8 + # (Folding Long Header Fields), 3.4.3 (Comments) + # and 3.4.5 (Quoted-Strings). + + my $token = '[-\w!\#$%&\'*+.^_\`|{}~]'; + $header=~s/$CRLF\s+/ /og; # merge continuation lines + while ($header=~/($token+):\s+([^$CRLF]*)/mgox) { + my ($field_name,$field_value) = ($1,$2); # avoid taintedness + $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize + $return{$field_name}=$field_value; + } + return %return; +} +END_OF_FUNC + +# This reads and returns the body as a single scalar value. +'readBody' => <<'END_OF_FUNC', +sub readBody { + my($self) = @_; + my($data); + my($returnval)=''; + while (defined($data = $self->read)) { + $returnval .= $data; + } + return $returnval; +} +END_OF_FUNC + +# This will read $bytes or until the boundary is hit, whichever happens +# first. After the boundary is hit, we return undef. The next read will +# skip over the boundary and begin reading again; +'read' => <<'END_OF_FUNC', +sub read { + my($self,$bytes) = @_; + + # default number of bytes to read + $bytes = $bytes || $FILLUNIT; + + # Fill up our internal buffer in such a way that the boundary + # is never split between reads. + $self->fillBuffer($bytes); + + # Find the boundary in the buffer (it may not be there). + my $start = index($self->{BUFFER},$self->{BOUNDARY}); + # protect against malformed multipart POST operations + die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0); + + # If the boundary begins the data, then skip past it + # and return undef. The +2 here is a fiendish plot to + # remove the CR/LF pair at the end of the boundary. + if ($start == 0) { + + # clear us out completely if we've hit the last boundary. + if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) { + $self->{BUFFER}=''; + $self->{LENGTH}=0; + return undef; + } + + # just remove the boundary. + substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)=''; + return undef; + } + + my $bytesToReturn; + if ($start > 0) { # read up to the boundary + $bytesToReturn = $start > $bytes ? $bytes : $start; + } else { # read the requested number of bytes + # leave enough bytes in the buffer to allow us to read + # the boundary. Thanks to Kevin Hendrick for finding + # this one. + $bytesToReturn = $bytes - (length($self->{BOUNDARY})+1); + } + + my $returnval=substr($self->{BUFFER},0,$bytesToReturn); + substr($self->{BUFFER},0,$bytesToReturn)=''; + + # If we hit the boundary, remove the CRLF from the end. + return ($start > 0) ? substr($returnval,0,-2) : $returnval; +} +END_OF_FUNC + + +# This fills up our internal buffer in such a way that the +# boundary is never split between reads +'fillBuffer' => <<'END_OF_FUNC', +sub fillBuffer { + my($self,$bytes) = @_; + return unless $self->{LENGTH}; + + my($boundaryLength) = length($self->{BOUNDARY}); + my($bufferLength) = length($self->{BUFFER}); + my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2; + $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead; + + # Try to read some data. We may hang here if the browser is screwed up. + my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN}, + \$self->{BUFFER}, + $bytesToRead, + $bufferLength); + + # An apparent bug in the Apache server causes the read() + # to return zero bytes repeatedly without blocking if the + # remote user aborts during a file transfer. I don't know how + # they manage this, but the workaround is to abort if we get + # more than SPIN_LOOP_MAX consecutive zero reads. + if ($bytesRead == 0) { + die "CGI.pm: Server closed socket during multipart read (client aborted?).\n" + if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX); + } else { + $self->{ZERO_LOOP_COUNTER}=0; + } + + $self->{LENGTH} -= $bytesRead; +} +END_OF_FUNC + + +# Return true when we've finished reading +'eof' => <<'END_OF_FUNC' +sub eof { + my($self) = @_; + return 1 if (length($self->{BUFFER}) == 0) + && ($self->{LENGTH} <= 0); + undef; +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +#################################################################################### +################################## TEMPORARY FILES ################################# +#################################################################################### +package TempFile; + +$SL = $CGI::SL; +$MAC = $CGI::OS eq 'MACINTOSH'; +my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : ""; +unless ($TMPDIRECTORY) { + @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", + "${SL}tmp","${SL}temp","${vol}${SL}Temporary Items", + "${SL}WWW_ROOT"); + foreach (@TEMP) { + do {$TMPDIRECTORY = $_; last} if -d $_ && -w _; + } +} + +$TMPDIRECTORY = $MAC ? "" : "." unless $TMPDIRECTORY; +$SEQUENCE=0; +$MAXTRIES = 5000; + +# cute feature, but overload implementation broke it +# %OVERLOAD = ('""'=>'as_string'); +*TempFile::AUTOLOAD = \&CGI::AUTOLOAD; + +############################################################################### +################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND #################### +############################################################################### +$AUTOLOADED_ROUTINES = ''; # prevent -w error +$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD'; +%SUBS = ( + +'new' => <<'END_OF_FUNC', +sub new { + my($package) = @_; + my $directory; + my $i; + for ($i = 0; $i < $MAXTRIES; $i++) { + $directory = sprintf("${TMPDIRECTORY}${SL}CGItemp%d%04d",${$},++$SEQUENCE); + last if ! -f $directory; + } + return bless \$directory; +} +END_OF_FUNC + +'DESTROY' => <<'END_OF_FUNC', +sub DESTROY { + my($self) = @_; + unlink $$self; # get rid of the file +} +END_OF_FUNC + +'as_string' => <<'END_OF_FUNC' +sub as_string { + my($self) = @_; + return $$self; +} +END_OF_FUNC + +); +END_OF_AUTOLOAD + +package CGI; + +# We get a whole bunch of warnings about "possibly uninitialized variables" +# when running with the -w switch. Touch them all once to get rid of the +# warnings. This is ugly and I hate it. +if ($^W) { + $CGI::CGI = ''; + $CGI::CGI=<'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','minie']), p, + "What's your favorite color? ", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']),p, + submit, + end_form, + hr; + + if (param()) { + print "Your name is",em(param('name')),p, + "The keywords are: ",em(join(", ",param('words'))),p, + "Your favorite color is ",em(param('color')), + hr; + } + +=head1 ABSTRACT + +This perl library uses perl5 objects to make it easy to create Web +fill-out forms and parse their contents. This package defines CGI +objects, entities that contain the values of the current query string +and other state variables. Using a CGI object's methods, you can +examine keywords and parameters passed to your script, and create +forms whose initial values are taken from the current query (thereby +preserving state information). The module provides shortcut functions +that produce boilerplate HTML, reducing typing and coding errors. It +also provides functionality for some of the more advanced features of +CGI scripting, including support for file uploads, cookies, cascading +style sheets, server push, and frames. + +CGI.pm also provides a simple function-oriented programming style for +those who don't need its object-oriented features. + +The current version of CGI.pm is available at + + http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html + ftp://ftp-genome.wi.mit.edu/pub/software/WWW/ + +=head1 DESCRIPTION + +=head2 PROGRAMMING STYLE + +There are two styles of programming with CGI.pm, an object-oriented +style and a function-oriented style. In the object-oriented style you +create one or more CGI objects and then use object methods to create +the various elements of the page. Each CGI object starts out with the +list of named parameters that were passed to your CGI script by the +server. You can modify the objects, save them to a file or database +and recreate them. Because each object corresponds to the "state" of +the CGI script, and because each object's parameter list is +independent of the others, this allows you to save the state of the +script and restore it later. + +For example, using the object oriented style, here is now you create +a simple "Hello World" HTML page: + + #!/usr/local/bin/pelr + use CGI; # load CGI routines + $q = new CGI; # create new CGI object + print $q->header, # create the HTTP header + $q->start_html('hello world'), # start the HTML + $q->h1('hello world'), # level 1 header + $q->end_html; # end the HTML + +In the function-oriented style, there is one default CGI object that +you rarely deal with directly. Instead you just call functions to +retrieve CGI parameters, create HTML tags, manage cookies, and so +on. This provides you with a cleaner programming interface, but +limits you to using one CGI object at a time. The following example +prints the same page, but uses the function-oriented interface. +The main differences are that we now need to import a set of functions +into our name space (usually the "standard" functions), and we don't +need to create the CGI object. + + #!/usr/local/bin/pelr + use CGI qw/:standard/; # load standard CGI routines + print header, # create the HTTP header + start_html('hello world'), # start the HTML + h1('hello world'), # level 1 header + end_html; # end the HTML + +The examples in this document mainly use the object-oriented style. +See HOW TO IMPORT FUNCTIONS for important information on +function-oriented programming in CGI.pm + +=head2 CALLING CGI.PM ROUTINES + +Most CGI.pm routines accept several arguments, sometimes as many as 20 +optional ones! To simplify this interface, all routines use a named +argument calling style that looks like this: + + print $q->header(-type=>'image/gif',-expires=>'+3d'); + +Each argument name is preceded by a dash. Neither case nor order +matters in the argument list. -type, -Type, and -TYPE are all +acceptable. In fact, only the first argument needs to begin with a +dash. If a dash is present in the first argument, CGI.pm assumes +dashes for the subsequent ones. + +You don't have to use the hyphen at allif you don't want to. After +creating a CGI object, call the B method with +a nonzero value. This will tell CGI.pm that you intend to use named +parameters exclusively: + + $query = new CGI; + $query->use_named_parameters(1); + $field = $query->radio_group('name'=>'OS', + 'values'=>['Unix','Windows','Macintosh'], + 'default'=>'Unix'); + +Several routines are commonly called with just one argument. In the +case of these routines you can provide the single argument without an +argument name. header() happens to be one of these routines. In this +case, the single argument is the document type. + + print $q->header('text/html'); + +Other such routines are documented below. + +Sometimes named arguments expect a scalar, sometimes a reference to an +array, and sometimes a reference to a hash. Often, you can pass any +type of argument and the routine will do whatever is most appropriate. +For example, the param() routine is used to set a CGI parameter to a +single or a multi-valued value. The two cases are shown below: + + $q->param(-name=>'veggie',-value=>'tomato'); + $q->param(-name=>'veggie',-value=>'[tomato','tomahto','potato','potahto']); + +A large number of routines in CGI.pm actually aren't specifically +defined in the module, but are generated automatically as needed. +These are the "HTML shortcuts," routines that generate HTML tags for +use in dynamically-generated pages. HTML tags have both attributes +(the attribute="value" pairs within the tag itself) and contents (the +part between the opening and closing pairs.) To distinguish between +attributes and contents, CGI.pm uses the convention of passing HTML +attributes as a hash reference as the first argument, and the +contents, if any, as any subsequent arguments. It works out like +this: + + Code Generated HTML + ---- -------------- + h1()

    + h1('some','contents');

    some contents

    + h1({-align=>left});

    + h1({-align=>left},'contents');

    contents

    + +HTML tags are described in more detail later. + +Many newcomers to CGI.pm are puzzled by the difference between the +calling conventions for the HTML shortcuts, which require curly braces +around the HTML tag attributes, and the calling conventions for other +routines, which manage to generate attributes without the curly +brackets. Don't be confused. As a convenience the curly braces are +optional in all but the HTML shortcuts. If you like, you can use +curly braces when calling any routine that takes named arguments. For +example: + + print $q->header( {-type=>'image/gif',-expires=>'+3d'} ); + +If you use the B<-w> switch, you will be warned that some CGI.pm argument +names conflict with built-in Perl functions. The most frequent of +these is the -values argument, used to create multi-valued menus, +radio button clusters and the like. To get around this warning, you +have several choices: + +=over 4 + +=item 1. Use another name for the argument, if one is available. For +example, -value is an alias for -values. + +=item 2. Change the capitalization, e.g. -Values + +=item 3. Put quotes around the argument name, e.g. '-values' + +=back + +Many routines will do something useful with a named argument that it +doesn't recognize. For example, you can produce non-standard HTTP +header fields by providing them as named arguments: + + print $q->header(-type => 'text/html', + -cost => 'Three smackers', + -annoyance_level => 'high', + -complaints_to => 'bit bucket'); + +This will produce the following nonstandard HTTP header: + + HTTP/1.0 200 OK + Cost: Three smackers + Annoyance-level: high + Complaints-to: bit bucket + Content-type: text/html + +Notice the way that underscores are translated automatically into +hyphens. HTML-generating routines perform a different type of +translation. + +This feature allows you to keep up with the rapidly changing HTTP and +HTML "standards". + +=head2 CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE): + + $query = new CGI; + +This will parse the input (from both POST and GET methods) and store +it into a perl5 object called $query. + +=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE + + $query = new CGI(INPUTFILE); + +If you provide a file handle to the new() method, it will read +parameters from the file (or STDIN, or whatever). The file can be in +any of the forms describing below under debugging (i.e. a series of +newline delimited TAG=VALUE pairs will work). Conveniently, this type +of file is created by the save() method (see below). Multiple records +can be saved and restored. + +Perl purists will be pleased to know that this syntax accepts +references to file handles, or even references to filehandle globs, +which is the "official" way to pass a filehandle: + + $query = new CGI(\*STDIN); + +You can also initialize the CGI object with a FileHandle or IO::File +object. + +If you are using the function-oriented interface and want to +initialize CGI state from a file handle, the way to do this is with +B. This will (re)initialize the +default CGI object from the indicated file handle. + + open (IN,"test.in") || die; + restore_parameters(IN); + close IN; + +You can also initialize the query object from an associative array +reference: + + $query = new CGI( {'dinosaur'=>'barney', + 'song'=>'I love you', + 'friends'=>[qw/Jessica George Nancy/]} + ); + +or from a properly formatted, URL-escaped query string: + + $query = new CGI('dinosaur=barney&color=purple'); + +or from a previously existing CGI object (currently this clones the +parameter list, but none of the other object-specific fields, such as +autoescaping): + + $old_query = new CGI; + $new_query = new CGI($old_query); + +To create an empty query, initialize it from an empty string or hash: + + $empty_query = new CGI(""); + + -or- + + $empty_query = new CGI({}); + +=head2 FETCHING A LIST OF KEYWORDS FROM THE QUERY: + + @keywords = $query->keywords + +If the script was invoked as the result of an search, the +parsed keywords can be obtained as an array using the keywords() method. + +=head2 FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT: + + @names = $query->param + +If the script was invoked with a parameter list +(e.g. "name1=value1&name2=value2&name3=value3"), the param() +method will return the parameter names as a list. If the +script was invoked as an script, there will be a +single parameter named 'keywords'. + +NOTE: As of version 1.5, the array of parameter names returned will +be in the same order as they were submitted by the browser. +Usually this order is the same as the order in which the +parameters are defined in the form (however, this isn't part +of the spec, and so isn't guaranteed). + +=head2 FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER: + + @values = $query->param('foo'); + + -or- + + $value = $query->param('foo'); + +Pass the param() method a single argument to fetch the value of the +named parameter. If the parameter is multivalued (e.g. from multiple +selections in a scrolling list), you can ask to receive an array. Otherwise +the method will return a single value. + +=head2 SETTING THE VALUE(S) OF A NAMED PARAMETER: + + $query->param('foo','an','array','of','values'); + +This sets the value for the named parameter 'foo' to an array of +values. This is one way to change the value of a field AFTER +the script has been invoked once before. (Another way is with +the -override parameter accepted by all methods that generate +form elements.) + +param() also recognizes a named parameter style of calling described +in more detail later: + + $query->param(-name=>'foo',-values=>['an','array','of','values']); + + -or- + + $query->param(-name=>'foo',-value=>'the value'); + +=head2 APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER: + + $query->append(-name=>'foo',-values=>['yet','more','values']); + +This adds a value or list of values to the named parameter. The +values are appended to the end of the parameter if it already exists. +Otherwise the parameter is created. Note that this method only +recognizes the named argument calling syntax. + +=head2 IMPORTING ALL PARAMETERS INTO A NAMESPACE: + + $query->import_names('R'); + +This creates a series of variables in the 'R' namespace. For example, +$R::foo, @R:foo. For keyword lists, a variable @R::keywords will appear. +If no namespace is given, this method will assume 'Q'. +WARNING: don't import anything into 'main'; this is a major security +risk!!!! + +In older versions, this method was called B. As of version 2.20, +this name has been removed completely to avoid conflict with the built-in +Perl module B operator. + +=head2 DELETING A PARAMETER COMPLETELY: + + $query->delete('foo'); + +This completely clears a parameter. It sometimes useful for +resetting parameters that you don't want passed down between +script invocations. + +If you are using the function call interface, use "Delete()" instead +to avoid conflicts with Perl's built-in delete operator. + +=head2 DELETING ALL PARAMETERS: + + $query->delete_all(); + +This clears the CGI object completely. It might be useful to ensure +that all the defaults are taken when you create a fill-out form. + +Use Delete_all() instead if you are using the function call interface. + +=head2 DIRECT ACCESS TO THE PARAMETER LIST: + + $q->param_fetch('address')->[1] = '1313 Mockingbird Lane'; + unshift @{$q->param_fetch(-name=>'address')},'George Munster'; + +If you need access to the parameter list in a way that isn't covered +by the methods above, you can obtain a direct reference to it by +calling the B method with the name of the . This +will return an array reference to the named parameters, which you then +can manipulate in any way you like. + +You can also use a named argument style using the B<-name> argument. + +=head2 SAVING THE STATE OF THE SCRIPT TO A FILE: + + $query->save(FILEHANDLE) + +This will write the current state of the form to the provided +filehandle. You can read it back in by providing a filehandle +to the new() method. Note that the filehandle can be a file, a pipe, +or whatever! + +The format of the saved file is: + + NAME1=VALUE1 + NAME1=VALUE1' + NAME2=VALUE2 + NAME3=VALUE3 + = + +Both name and value are URL escaped. Multi-valued CGI parameters are +represented as repeated names. A session record is delimited by a +single = symbol. You can write out multiple records and read them +back in with several calls to B. You can do this across several +sessions by opening the file in append mode, allowing you to create +primitive guest books, or to keep a history of users' queries. Here's +a short example of creating multiple session records: + + use CGI; + + open (OUT,">>test.out") || die; + $records = 5; + foreach (0..$records) { + my $q = new CGI; + $q->param(-name=>'counter',-value=>$_); + $q->save(OUT); + } + close OUT; + + # reopen for reading + open (IN,"test.out") || die; + while (!eof(IN)) { + my $q = new CGI(IN); + print $q->param('counter'),"\n"; + } + +The file format used for save/restore is identical to that used by the +Whitehead Genome Center's data exchange format "Boulderio", and can be +manipulated and even databased using Boulderio utilities. See + + http://www.genome.wi.mit.edu/genome_software/other/boulder.html + +for further details. + +If you wish to use this method from the function-oriented (non-OO) +interface, the exported name for this method is B. + +=head2 USING THE FUNCTION-ORIENTED INTERFACE + +To use the function-oriented interface, you must specify which CGI.pm +routines or sets of routines to import into your script's namespace. +There is a small overhead associated with this importation, but it +isn't much. + + use CGI ; + +The listed methods will be imported into the current package; you can +call them directly without creating a CGI object first. This example +shows how to import the B and B +methods, and then use them directly: + + use CGI 'param','header'; + print header('text/plain'); + $zipcode = param('zipcode'); + +More frequently, you'll import common sets of functions by referring +to the gropus by name. All function sets are preceded with a ":" +character as in ":html3" (for tags defined in the HTML 3 standard). + +Here is a list of the function sets you can import: + +=over 4 + +=item B<:cgi> + +Import all CGI-handling methods, such as B, B +and the like. + +=item B<:form> + +Import all fill-out form generating methods, such as B. + +=item B<:html2> + +Import all methods that generate HTML 2.0 standard elements. + +=item B<:html3> + +Import all methods that generate HTML 3.0 proposed elements (such as +, and ). + +=item B<:netscape> + +Import all methods that generate Netscape-specific HTML extensions. + +=item B<:html> + +Import all HTML-generating shortcuts (i.e. 'html2' + 'html3' + +'netscape')... + +=item B<:standard> + +Import "standard" features, 'html2', 'html3', 'form' and 'cgi'. + +=item B<:all> + +Import all the available methods. For the full list, see the CGI.pm +code, where the variable %TAGS is defined. + +=back + +If you import a function name that is not part of CGI.pm, the module +will treat it as a new HTML tag and generate the appropriate +subroutine. You can then use it like any other HTML tag. This is to +provide for the rapidly-evolving HTML "standard." For example, say +Microsoft comes out with a new tag called (which causes the +user's desktop to be flooded with a rotating gradient fill until his +machine reboots). You don't need to wait for a new version of CGI.pm +to start using it immeidately: + + use CGI qw/:standard :html3 gradient/; + print gradient({-start=>'red',-end=>'blue'}); + +Note that in the interests of execution speed CGI.pm does B use +the standard L syntax for specifying load symbols. This may +change in the future. + +If you import any of the state-maintaining CGI or form-generating +methods, a default CGI object will be created and initialized +automatically the first time you use any of the methods that require +one to be present. This includes B, B, +B and the like. (If you need direct access to the CGI +object, you can find it in the global variable B<$CGI::Q>). By +importing CGI.pm methods, you can create visually elegant scripts: + + use CGI qw/:standard/; + print + header, + start_html('Simple Script'), + h1('Simple Script'), + start_form, + "What's your name? ",textfield('name'),p, + "What's the combination?", + checkbox_group(-name=>'words', + -values=>['eenie','meenie','minie','moe'], + -defaults=>['eenie','moe']),p, + "What's your favorite color?", + popup_menu(-name=>'color', + -values=>['red','green','blue','chartreuse']),p, + submit, + end_form, + hr,"\n"; + + if (param) { + print + "Your name is ",em(param('name')),p, + "The keywords are: ",em(join(", ",param('words'))),p, + "Your favorite color is ",em(param('color')),".\n"; + } + print end_html; + +=head2 PRAGMAS + +In addition to the function sets, there are a number of pragmas that +you can import. Pragmas, which are always preceded by a hyphen, +change the way that CGI.pm functions in various ways. Pragmas, +function sets, and individual functions can all be imported in the +same use() line. For example, the following use statement imports the +standard set of functions and disables debugging mode (pragma +-no_debug): + + use CGI qw/:standard -no_debug/; + +The current list of pragmas is as follows: + +=over 4 + +=item -any + +When you I, then any method that the query object +doesn't recognize will be interpreted as a new HTML tag. This allows +you to support the next I Netscape or Microsoft HTML +extension. This lets you go wild with new and unsupported tags: + + use CGI qw(-any); + $q=new CGI; + print $q->gradient({speed=>'fast',start=>'red',end=>'blue'}); + +Since using any causes any mistyped method name +to be interpreted as an HTML tag, use it with care or not at +all. + +=item -compile + +This causes the indicated autoloaded methods to be compiled up front, +rather than deferred to later. This is useful for scripts that run +for an extended period of time under FastCGI or mod_perl, and for +those destined to be crunched by Malcom Beattie's Perl compiler. Use +it in conjunction with the methods or method familes you plan to use. + + use CGI qw(-compile :standard :html3); + +or even + + use CGI qw(-compile :all); + +Note that using the -compile pragma in this way will always have +the effect of importing the compiled functions into the current +namespace. If you want to compile without importing use the +compile() method instead (see below). + +=item -nph + +This makes CGI.pm produce a header appropriate for an NPH (no +parsed header) script. You may need to do other things as well +to tell the server that the script is NPH. See the discussion +of NPH scripts below. + +=item -autoload + +This overrides the autoloader so that any function in your program +that is not recognized is referred to CGI.pm for possible evaluation. +This allows you to use all the CGI.pm functions without adding them to +your symbol table, which is of concern for mod_perl users who are +worried about memory consumption. I when +I<-autoload> is in effect, you cannot use "poetry mode" +(functions without the parenthesis). Use I rather +than I
    , or add something like I +to the top of your script. + +=item -no_debug + +This turns off the command-line processing features. If you want to +run a CGI.pm script from the command line to produce HTML, and you +don't want it pausing to request CGI parameters from standard input or +the command line, then use this pragma: + + use CGI qw(-no_debug :standard); + +If you'd like to process the command-line parameters but not standard +input, this should work: + + use CGI qw(-no_debug :standard); + restore_parameters(join('&',@ARGV)); + +See the section on debugging for more details. + +=item -private_tempfiles + +CGI.pm can process uploaded file. Ordinarily it spools the +uploaded file to a temporary directory, then deletes the file +when done. However, this opens the risk of eavesdropping as +described in the file upload section. +Another CGI script author could peek at this data during the +upload, even if it is confidential information. On Unix systems, +the -private_tempfiles pragma will cause the temporary file to be unlinked as soon +as it is opened and before any data is written into it, +eliminating the risk of eavesdropping. +n +=back + +=head1 GENERATING DYNAMIC DOCUMENTS + +Most of CGI.pm's functions deal with creating documents on the fly. +Generally you will produce the HTTP header first, followed by the +document itself. CGI.pm provides functions for generating HTTP +headers of various types as well as for generating HTML. For creating +GIF images, see the GD.pm module. + +Each of these functions produces a fragment of HTML or HTTP which you +can print out directly so that it displays in the browser window, +append to a string, or save to a file for later use. + +=head2 CREATING A STANDARD HTTP HEADER: + +Normally the first thing you will do in any CGI script is print out an +HTTP header. This tells the browser what type of document to expect, +and gives other optional information, such as the language, expiration +date, and whether to cache the document. The header can also be +manipulated for special purposes, such as server push and pay per view +pages. + + print $query->header; + + -or- + + print $query->header('image/gif'); + + -or- + + print $query->header('text/html','204 No response'); + + -or- + + print $query->header(-type=>'image/gif', + -nph=>1, + -status=>'402 Payment required', + -expires=>'+3d', + -cookie=>$cookie, + -Cost=>'$2.00'); + +header() returns the Content-type: header. You can provide your own +MIME type if you choose, otherwise it defaults to text/html. An +optional second parameter specifies the status code and a human-readable +message. For example, you can specify 204, "No response" to create a +script that tells the browser to do nothing at all. + +The last example shows the named argument style for passing arguments +to the CGI methods using named parameters. Recognized parameters are +B<-type>, B<-status>, B<-expires>, and B<-cookie>. Any other named +parameters will be stripped of their initial hyphens and turned into +header fields, allowing you to specify any HTTP header you desire. +Internal underscores will be turned into hyphens: + + print $query->header(-Content_length=>3002); + +Most browsers will not cache the output from CGI scripts. Every time +the browser reloads the page, the script is invoked anew. You can +change this behavior with the B<-expires> parameter. When you specify +an absolute or relative expiration interval with this parameter, some +browsers and proxy servers will cache the script's output until the +indicated expiration date. The following forms are all valid for the +-expires field: + + +30s 30 seconds from now + +10m ten minutes from now + +1h one hour from now + -1d yesterday (i.e. "ASAP!") + now immediately + +3M in three months + +10y in ten years time + Thursday, 25-Apr-1999 00:40:33 GMT at the indicated time & date + +The B<-cookie> parameter generates a header that tells the browser to provide +a "magic cookie" during all subsequent transactions with your script. +Netscape cookies have a special format that includes interesting attributes +such as expiration time. Use the cookie() method to create and retrieve +session cookies. + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers, such as Microsoft Internet Explorer, which +expect all their scripts to be NPH. + +=head2 GENERATING A REDIRECTION HEADER + + print $query->redirect('http://somewhere.else/in/movie/land'); + +Sometimes you don't want to produce a document yourself, but simply +redirect the browser elsewhere, perhaps choosing a URL based on the +time of day or the identity of the user. + +The redirect() function redirects the browser to a different URL. If +you use redirection like this, you should B print out a header as +well. As of version 2.0, we produce both the unofficial Location: +header and the official URI: header. This should satisfy most servers +and browsers. + +One hint I can offer is that relative links may not work correctly +when you generate a redirection to another document on your site. +This is due to a well-intentioned optimization that some servers use. +The solution to this is to use the full URL (including the http: part) +of the document you are redirecting to. + +You can also use named arguments: + + print $query->redirect(-uri=>'http://somewhere.else/in/movie/land', + -nph=>1); + +The B<-nph> parameter, if set to a true value, will issue the correct +headers to work with a NPH (no-parse-header) script. This is important +to use with certain servers, such as Microsoft Internet Explorer, which +expect all their scripts to be NPH. + +=head2 CREATING THE HTML DOCUMENT HEADER + + print $query->start_html(-title=>'Secrets of the Pyramids', + -author=>'fred@capricorn.org', + -base=>'true', + -target=>'_blank', + -meta=>{'keywords'=>'pharaoh secret mummy', + 'copyright'=>'copyright 1996 King Tut'}, + -style=>{'src'=>'/styles/style1.css'}, + -BGCOLOR=>'blue'); + +After creating the HTTP header, most CGI scripts will start writing +out an HTML document. The start_html() routine creates the top of the +page, along with a lot of optional information that controls the +page's appearance and behavior. + +This method returns a canned HTML header and the opening tag. +All parameters are optional. In the named parameter form, recognized +parameters are -title, -author, -base, -xbase and -target (see below +for the explanation). Any additional parameters you provide, such as +the Netscape unofficial BGCOLOR attribute, are added to the +tag. Additional parameters must be proceeded by a hyphen. + +The argument B<-xbase> allows you to provide an HREF for the tag +different from the current location, as in + + -xbase=>"http://home.mcom.com/" + +All relative links will be interpreted relative to this tag. + +The argument B<-target> allows you to provide a default target frame +for all the links and fill-out forms on the page. See the Netscape +documentation on frames for details of how to manipulate this. + + -target=>"answer_window" + +All relative links will be interpreted relative to this tag. +You add arbitrary meta information to the header with the B<-meta> +argument. This argument expects a reference to an associative array +containing name/value pairs of meta information. These will be turned +into a series of header tags that look something like this: + + + + +There is no support for the HTTP-EQUIV type of tag. This is +because you can modify the HTTP header directly with the B +method. For example, if you want to send the Refresh: header, do it +in the header() method: + + print $q->header(-Refresh=>'10; URL=http://www.capricorn.com'); + +The B<-style> tag is used to incorporate cascading stylesheets into +your code. See the section on CASCADING STYLESHEETS for more information. + +You can place other arbitrary HTML elements to the section with the +B<-head> tag. For example, to place the rarely-used element in the +head section, use this: + + print $q->start_html(-head=>Link({-rel=>'next', + -href=>'http://www.capricorn.com/s2.html'})); + +To incorporate multiple HTML elements into the section, just pass an +array reference: + + print $q->start_html(-head=>[ + Link({-rel=>'next', + -href=>'http://www.capricorn.com/s2.html'}), + Link({-rel=>'previous', + -href=>'http://www.capricorn.com/s1.html'}) + ] + ); + +JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>, +B<-onMouseOver>, B<-onMouseOut> and B<-onUnload> parameters are used +to add Netscape JavaScript calls to your pages. B<-script> should +point to a block of text containing JavaScript function definitions. +This block will be placed within a + + <# Just data #> + + >>>>>>>>>>> ]]> + +If HTML comments include other tags, those solutions would also break +on text like this: + + + +=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 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 BSELECTE> and BOPTIONE> 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: + + # simplest version + use LWP::Simple; + $content = get($URL); + + # or print HTML from a URL + use LWP::Simple; + getprint "http://www.sn.no/libwww-perl/"; + + # or 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 automate an HTML form submission? + +If you're submitting values using the GET method, create a URL and encode +the form using the C method: + + use LWP::Simple; + use URI::URL; + + my $url = url('http://www.perl.com/cgi-bin/cpan_mod'); + $url->query_form(module => 'DB_File', readme => 1); + $content = get($url); + +If you're using the POST method, create your own user agent and encode +the content appropriately. + + use HTTP::Request::Common qw(POST); + use LWP::UserAgent; + + $ua = LWP::UserAgent->new(); + my $req = POST 'http://www.perl.com/cgi-bin/cpan_mod', + [ module => 'DB_File', readme => 1 ]; + $content = $ua->request($req)->as_string; + +=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 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 as the headers of your +reply, send back a C header. Officially this should be a +C 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. + + $url = "http://www.perl.com/CPAN/"; + print "Location: $url\n\n"; + exit; + +To be correct to the spec, each of those C<"\n"> +should really each be C<"\015\012">, but unless you're +stuck on MacOS, you probably won't notice. + +=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), which makes sure that data +from outside your script (eg, CGI parameters) are never used in +C or C 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 a mail header? + +For a quick-and-dirty solution, try this solution derived +from page 222 of the 2nd edition of "Programming Perl": + + $/ = ''; + $header = ; + $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? + +You use a standard module, probably CGI.pm. Under no circumstances +should you attempt to do so by hand! + +You'll see a lot of CGI programs that blindly read from STDIN the number +of bytes equal to CONTENT_LENGTH for POSTs, or grab QUERY_STRING for +decoding GETs. These programs are very poorly written. They only work +sometimes. They typically forget to check the return value of the read() +system call, which is a cardinal sin. They don't handle HEAD requests. +They don't handle multipart forms used for file uploads. They don't deal +with GET/POST combinations where query fields are in more than one place. +They don't deal with keywords in the query string. + +In short, they're bad hacks. Resist them at all costs. 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). + +Make sure you know whether to use a GET or a POST in your form. +GETs should only be used for something that doesn't update the server. +Otherwise you can get mangled databases and repeated feedback mail +messages. The fancy word for this is ``idempotency''. This simply +means that there should be no difference between making a GET request +for a particular URL once or multiple times. This is because the +HTTP protocol definition says that a GET request may be cached by the +browser, or server, or an intervening proxy. POST requests cannot be +cached, because each request is independent and matters. Typically, +POST requests change or depend on state on the server (query or update +a database, send mail, or purchase a computer). + +=head2 How do I check a valid mail address? + +You can't, at least, not in real time. Bummer, eh? + +Without sending mail to the address and seeing whether there's a human +on the other hand to answer you, you cannot determine whether a mail +address is valid. Even if you apply the mail 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 +mail addresses with a simple regexp, such as +C. It's a very bad idea. 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 mail to +(say, Bill Clinton or your postmaster), and then makes sure that the +hostname given can be looked up in the DNS MX records. It's not fast, +but it works for what it tries to do. + +Our best advice for verifying a person's mail address is to have them +enter their address twice, just as you normally do to change a password. +This usually weeds out typos. If both versions match, send +mail to that address with a personal message that looks somewhat like: + + Dear someuser@host.com, + + Please confirm the mail address you gave us Wed May 6 09:38:41 + MDT 1998 by replying to this message. Include the string + "Rumpelstiltskin" in that reply, but spelled in reverse; that is, + start with "Nik...". Once this is done, your confirmed address will + be entered into our records. + +If you get the message back and they've followed your directions, +you can be reasonably assured that it's real. + +A related strategy that's less open to forgery is to give them a PIN +(personal ID number). Record the address and PIN (best that it be a +random one) for later processing. In the mail you send, ask them to +include the PIN in their reply. But if it bounces, or the message is +included via a ``vacation'' script, it'll be there anyway. So it's +best to ask them to mail back a slight alteration of the PIN, such as +with the characters reversed, one added or subtracted to each digit, etc. + +=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 mail address? + +On systems that support getpwuid, the $E 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 mail address can mean that this generates addresses +that the company's mail system will not accept, so you should ask for +users' mail 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 mail? + +Use the C program directly: + + open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq") + or die "Can't fork for sendmail: $!\n"; + print SENDMAIL <<"EOF"; + From: User Originating Mail + To: Final Destination + Subject: A relevant subject line + + Body of the message goes here, in as many lines as you like. + EOF + close(SENDMAIL) or warn "sendmail didn't close nicely"; + +The B<-oi> option prevents sendmail from interpreting a line consisting +of a single dot as "end of message". The B<-t> option says to use the +headers to decide who to send the message to, and B<-odq> says to put +the message into the queue. This last option means your message won't +be immediately delivered, so leave it out if you want immediate +delivery. + +Or use the CPAN module Mail::Mailer: + + use Mail::Mailer; + + $mailer = Mail::Mailer->new(); + $mailer->open({ From => $from_address, + To => $to_address, + Subject => $subject, + }) + or die "Can't open: $!\n"; + print $mailer $body; + $mailer->close(); + +The Mail::Internet module uses Net::SMTP which is less Unix-centric than +Mail::Mailer, but less reliable. Avoid raw SMTP commands. There +are many reasons to use a mail transport agent like sendmail. These +include queueing, MX records, and security. + +=head2 How do I read 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; + +Often a module is overkill, though. Here's a mail sorter. + + #!/usr/bin/perl + # bysub1 - simple sort by subject + my(@msgs, @sub); + my $msgno = -1; + $/ = ''; # paragraph reads + while (<>) { + if (/^From/m) { + /^Subject:\s*(?:Re:\s*)*(.*)/mi; + $sub[++$msgno] = lc($1) || ''; + } + $msgs[$msgno] .= $_; + } + for my $i (sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msgs)) { + print $msgs[$i]; + } + +Or more succinctly, + + #!/usr/bin/perl -n00 + # bysub2 - awkish sort-by-subject + BEGIN { $msgno = -1 } + $sub[++$msgno] = (/^Subject:\s*(?:Re:\s*)*(.*)/mi)[0] if /^From/m; + $msg[$msgno] .= $_; + END { print @msg[ sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msg) ] } + +=head2 How do I find out my hostname/domainname/IP address? + +The normal way to find your own hostname is to call the C<`hostname`> +program. While sometimes expedient, this has some problems, such as +not knowing whether you've got the canonical name or not. 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, 1998 Tom Christiansen and Nathan Torkington. +All rights reserved. + +When included as part of the Standard Version of Perl, or as part of +its complete documentation whether printed or otherwise, this work +may be distributed only under the terms of Perl's Artistic License. +Any distribution of this file or derivatives thereof I +of that package require that special arrangements be made with +copyright holder. + +Irrespective of its distribution, all code examples in this file +are hereby placed into the public domain. You are permitted and +encouraged to use this code in your own programs for fun +or for profit as you see fit. A simple comment in the code giving +credit would be courteous but is not required. diff --git a/contrib/perl5/pod/perlform.pod b/contrib/perl5/pod/perlform.pod new file mode 100644 index 00000000000..6b65e043031 --- /dev/null +++ b/contrib/perl5/pod/perlform.pod @@ -0,0 +1,337 @@ +=head1 NAME + +perlform - Perl formats + +=head1 DESCRIPTION + +Perl has a mechanism to help you generate simple reports and charts. To +facilitate this, Perl helps you code up your output page close to how it +will look when it's printed. It can keep track of things like how many +lines are on a page, what page you're on, when to print page headers, +etc. Keywords are borrowed from FORTRAN: format() to declare and write() +to execute; see their entries in L. Fortunately, the layout is +much more legible, more like BASIC's PRINT USING statement. Think of it +as a poor man's nroff(1). + +Formats, like packages and subroutines, are declared rather than +executed, so they may occur at any point in your program. (Usually it's +best to keep them all together though.) They have their own namespace +apart from all the other "types" in Perl. This means that if you have a +function named "Foo", it is not the same thing as having a format named +"Foo". However, the default name for the format associated with a given +filehandle is the same as the name of the filehandle. Thus, the default +format for STDOUT is named "STDOUT", and the default format for filehandle +TEMP is named "TEMP". They just look the same. They aren't. + +Output record formats are declared as follows: + + format NAME = + FORMLIST + . + +If name is omitted, format "STDOUT" is defined. FORMLIST consists of +a sequence of lines, each of which may be one of three types: + +=over 4 + +=item 1. + +A comment, indicated by putting a '#' in the first column. + +=item 2. + +A "picture" line giving the format for one output line. + +=item 3. + +An argument line supplying values to plug into the previous picture line. + +=back + +Picture lines are printed exactly as they look, except for certain fields +that substitute values into the line. Each field in a picture line starts +with either "@" (at) or "^" (caret). These lines do not undergo any kind +of variable interpolation. The at field (not to be confused with the array +marker @) is the normal kind of field; the other kind, caret fields, are used +to do rudimentary multi-line text block filling. The length of the field +is supplied by padding out the field with multiple "E", "E", or "|" +characters to specify, respectively, left justification, right +justification, or centering. If the variable would exceed the width +specified, it is truncated. + +As an alternate form of right justification, you may also use "#" +characters (with an optional ".") to specify a numeric field. This way +you can line up the decimal points. If any value supplied for these +fields contains a newline, only the text up to the newline is printed. +Finally, the special field "@*" can be used for printing multi-line, +nontruncated values; it should appear by itself on a line. + +The values are specified on the following line in the same order as +the picture fields. The expressions providing the values should be +separated by commas. The expressions are all evaluated in a list context +before the line is processed, so a single list expression could produce +multiple list elements. The expressions may be spread out to more than +one line if enclosed in braces. If so, the opening brace must be the first +token on the first line. If an expression evaluates to a number with a +decimal part, and if the corresponding picture specifies that the decimal +part should appear in the output (that is, any picture except multiple "#" +characters B an embedded "."), the character used for the decimal +point is B determined by the current LC_NUMERIC locale. This +means that, if, for example, the run-time environment happens to specify a +German locale, "," will be used instead of the default ".". See +L and L<"WARNINGS"> for more information. + +Picture fields that begin with ^ rather than @ are treated specially. +With a # field, the field is blanked out if the value is undefined. For +other field types, the caret enables a kind of fill mode. Instead of an +arbitrary expression, the value supplied must be a scalar variable name +that contains a text string. Perl puts as much text as it can into the +field, and then chops off the front of the string so that the next time +the variable is referenced, more of the text can be printed. (Yes, this +means that the variable itself is altered during execution of the write() +call, and is not returned.) Normally you would use a sequence of fields +in a vertical stack to print out a block of text. You might wish to end +the final field with the text "...", which will appear in the output if +the text was too long to appear in its entirety. You can change which +characters are legal to break on by changing the variable C<$:> (that's +$FORMAT_LINE_BREAK_CHARACTERS if you're using the English module) to a +list of the desired characters. + +Using caret fields can produce variable length records. If the text +to be formatted is short, you can suppress blank lines by putting a +"~" (tilde) character anywhere in the line. The tilde will be translated +to a space upon output. If you put a second tilde contiguous to the +first, the line will be repeated until all the fields on the line are +exhausted. (If you use a field of the at variety, the expression you +supply had better not give the same value every time forever!) + +Top-of-form processing is by default handled by a format with the +same name as the current filehandle with "_TOP" concatenated to it. +It's triggered at the top of each page. See L. + +Examples: + + # a report on the /etc/passwd file + format STDOUT_TOP = + Passwd File + Name Login Office Uid Gid Home + ------------------------------------------------------------------ + . + format STDOUT = + @<<<<<<<<<<<<<<<<<< @||||||| @<<<<<<@>>>> @>>>> @<<<<<<<<<<<<<<<<< + $name, $login, $office,$uid,$gid, $home + . + + + # a report from a bug report form + format STDOUT_TOP = + Bug Reports + @<<<<<<<<<<<<<<<<<<<<<<< @||| @>>>>>>>>>>>>>>>>>>>>>>> + $system, $%, $date + ------------------------------------------------------------------ + . + format STDOUT = + Subject: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $subject + Index: @<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $index, $description + Priority: @<<<<<<<<<< Date: @<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $priority, $date, $description + From: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $from, $description + Assigned to: @<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $programmer, $description + ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $description + ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $description + ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $description + ~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $description + ~ ^<<<<<<<<<<<<<<<<<<<<<<<... + $description + . + +It is possible to intermix print()s with write()s on the same output +channel, but you'll have to handle C<$-> (C<$FORMAT_LINES_LEFT>) +yourself. + +=head2 Format Variables + +The current format name is stored in the variable C<$~> (C<$FORMAT_NAME>), +and the current top of form format name is in C<$^> (C<$FORMAT_TOP_NAME>). +The current output page number is stored in C<$%> (C<$FORMAT_PAGE_NUMBER>), +and the number of lines on the page is in C<$=> (C<$FORMAT_LINES_PER_PAGE>). +Whether to autoflush output on this handle is stored in C<$|> +(C<$OUTPUT_AUTOFLUSH>). The string output before each top of page (except +the first) is stored in C<$^L> (C<$FORMAT_FORMFEED>). These variables are +set on a per-filehandle basis, so you'll need to select() into a different +one to affect them: + + select((select(OUTF), + $~ = "My_Other_Format", + $^ = "My_Top_Format" + )[0]); + +Pretty ugly, eh? It's a common idiom though, so don't be too surprised +when you see it. You can at least use a temporary variable to hold +the previous filehandle: (this is a much better approach in general, +because not only does legibility improve, you now have intermediary +stage in the expression to single-step the debugger through): + + $ofh = select(OUTF); + $~ = "My_Other_Format"; + $^ = "My_Top_Format"; + select($ofh); + +If you use the English module, you can even read the variable names: + + use English; + $ofh = select(OUTF); + $FORMAT_NAME = "My_Other_Format"; + $FORMAT_TOP_NAME = "My_Top_Format"; + select($ofh); + +But you still have those funny select()s. So just use the FileHandle +module. Now, you can access these special variables using lowercase +method names instead: + + use FileHandle; + format_name OUTF "My_Other_Format"; + format_top_name OUTF "My_Top_Format"; + +Much better! + +=head1 NOTES + +Because the values line may contain arbitrary expressions (for at fields, +not caret fields), you can farm out more sophisticated processing +to other functions, like sprintf() or one of your own. For example: + + format Ident = + @<<<<<<<<<<<<<<< + &commify($n) + . + +To get a real at or caret into the field, do this: + + format Ident = + I have an @ here. + "@" + . + +To center a whole line of text, do something like this: + + format Ident = + @||||||||||||||||||||||||||||||||||||||||||||||| + "Some text line" + . + +There is no builtin way to say "float this to the right hand side +of the page, however wide it is." You have to specify where it goes. +The truly desperate can generate their own format on the fly, based +on the current number of columns, and then eval() it: + + $format = "format STDOUT = \n" + . '^' . '<' x $cols . "\n" + . '$entry' . "\n" + . "\t^" . "<" x ($cols-8) . "~~\n" + . '$entry' . "\n" + . ".\n"; + print $format if $Debugging; + eval $format; + die $@ if $@; + +Which would generate a format looking something like this: + + format STDOUT = + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + $entry + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ + $entry + . + +Here's a little program that's somewhat like fmt(1): + + format = + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~ + $_ + + . + + $/ = ''; + while (<>) { + s/\s*\n\s*/ /g; + write; + } + +=head2 Footers + +While $FORMAT_TOP_NAME contains the name of the current header format, +there is no corresponding mechanism to automatically do the same thing +for a footer. Not knowing how big a format is going to be until you +evaluate it is one of the major problems. It's on the TODO list. + +Here's one strategy: If you have a fixed-size footer, you can get footers +by checking $FORMAT_LINES_LEFT before each write() and print the footer +yourself if necessary. + +Here's another strategy: Open a pipe to yourself, using C +(see L) and always write() to MYSELF instead of STDOUT. +Have your child process massage its STDIN to rearrange headers and footers +however you like. Not very convenient, but doable. + +=head2 Accessing Formatting Internals + +For low-level access to the formatting mechanism. you may use formline() +and access C<$^A> (the $ACCUMULATOR variable) directly. + +For example: + + $str = formline <<'END', 1,2,3; + @<<< @||| @>>> + END + + print "Wow, I just stored `$^A' in the accumulator!\n"; + +Or to make an swrite() subroutine, which is to write() what sprintf() +is to printf(), do this: + + use Carp; + sub swrite { + croak "usage: swrite PICTURE ARGS" unless @_; + my $format = shift; + $^A = ""; + formline($format,@_); + return $^A; + } + + $string = swrite(<<'END', 1, 2, 3); + Check me out + @<<< @||| @>>> + END + print $string; + +=head1 WARNINGS + +The lone dot that ends a format can also prematurely end a mail +message passing through a misconfigured Internet mailer (and based on +experience, such misconfiguration is the rule, not the exception). So +when sending format code through mail, you should indent it so that +the format-ending dot is not on the left margin; this will prevent +SMTP cutoff. + +Lexical variables (declared with "my") are not visible within a +format unless the format is declared within the scope of the lexical +variable. (They weren't visible at all before version 5.001.) + +Formats are the only part of Perl that unconditionally use information +from a program's locale; if a program's environment specifies an +LC_NUMERIC locale, it is always used to specify the decimal point +character in formatted output. Perl ignores all other aspects of locale +handling unless the C pragma is in effect. Formatted output +cannot be controlled by C because the pragma is tied to the +block structure of the program, and, for historical reasons, formats +exist outside that block structure. See L for further +discussion of locale handling. diff --git a/contrib/perl5/pod/perlfunc.pod b/contrib/perl5/pod/perlfunc.pod new file mode 100644 index 00000000000..4eac093b0e0 --- /dev/null +++ b/contrib/perl5/pod/perlfunc.pod @@ -0,0 +1,4440 @@ +=head1 NAME + +perlfunc - Perl builtin functions + +=head1 DESCRIPTION + +The functions in this section can serve as terms in an expression. +They fall into two major categories: list operators and named unary +operators. These differ in their precedence relationship with a +following comma. (See the precedence table in L.) List +operators take more than one argument, while unary operators can never +take more than one argument. Thus, a comma terminates the argument of +a unary operator, but merely separates the arguments of a list +operator. A unary operator generally provides a scalar context to its +argument, while a list operator may provide either scalar and list +contexts for its arguments. If it does both, the scalar arguments will +be first, and the list argument will follow. (Note that there can ever +be only one list argument.) For instance, splice() has three scalar +arguments followed by a list. + +In the syntax descriptions that follow, list operators that expect a +list (and provide list context for the elements of the list) are shown +with LIST as an argument. Such a list may consist of any combination +of scalar arguments or list values; the list values will be included +in the list as if each individual element were interpolated at that +point in the list, forming a longer single-dimensional list value. +Elements of the LIST should be separated by commas. + +Any function in the list below may be used either with or without +parentheses around its arguments. (The syntax descriptions omit the +parentheses.) If you use the parentheses, the simple (but occasionally +surprising) rule is this: It I like a function, therefore it I a +function, and precedence doesn't matter. Otherwise it's a list +operator or unary operator, and precedence does matter. And whitespace +between the function and left parenthesis doesn't count--so you need to +be careful sometimes: + + print 1+2+4; # Prints 7. + print(1+2) + 4; # Prints 3. + print (1+2)+4; # Also prints 3! + print +(1+2)+4; # Prints 7. + print ((1+2)+4); # Prints 7. + +If you run Perl with the B<-w> switch it can warn you about this. For +example, the third line above produces: + + print (...) interpreted as function at - line 1. + Useless use of integer addition in void context at - line 1. + +For functions that can be used in either a scalar or list context, +nonabortive failure is generally indicated in a scalar context by +returning the undefined value, and in a list context by returning the +null list. + +Remember the following important rule: There is B that relates +the behavior of an expression in list context to its behavior in scalar +context, or vice versa. It might do two totally different things. +Each operator and function decides which sort of value it would be most +appropriate to return in a scalar context. Some operators return the +length of the list that would have been returned in list context. Some +operators return the first value in the list. Some operators return the +last value in the list. Some operators return a count of successful +operations. In general, they do what you want, unless you want +consistency. + +An named array in scalar context is quite different from what would at +first glance appear to be a list in scalar context. You can't get a list +like C<(1,2,3)> into being in scalar context, because the compiler knows +the context at compile time. It would generate the scalar comma operator +there, not the list construction version of the comma. That means it +was never a list to start with. + +In general, functions in Perl that serve as wrappers for system calls +of the same name (like chown(2), fork(2), closedir(2), etc.) all return +true when they succeed and C otherwise, as is usually mentioned +in the descriptions below. This is different from the C interfaces, +which return C<-1> on failure. Exceptions to this rule are C, +C, and C. System calls also set the special C<$!> +variable on failure. Other functions do not, except accidentally. + +=head2 Perl Functions by Category + +Here are Perl's functions (including things that look like +functions, like some keywords and named operators) +arranged by category. Some functions appear in more +than one place. + +=over + +=item Functions for SCALARs or strings + +C, C, C, C, C, C, C, C, +C, C, C, C, C, C, C, +C, C, C, C    , C, C, C + +=item Regular expressions and pattern matching + +C, C, C, C, C, C, C + +=item Numeric functions + +C, C, C, C, C, C, C, C, C, +C, C, C + +=item Functions for real @ARRAYs + +C, C, C, C, C + +=item Functions for list data + +C, C, C, C, C, C, C + +=item Functions for real %HASHes + +C, C, C, C, C + +=item Input and output functions + +C, C, C, C, C, C, C, +C, C, C, C, C, C, C, +C, C, C, C, C). If LIST is also omitted, prints C<$_> to +the currently selected output channel. To set the default output channel to something other than +STDOUT use the select operation. Note that, because print takes a +LIST, anything in the LIST is evaluated in list context, and any +subroutine that you call will have one or more of its expressions +evaluated in list context. Also be careful not to follow the print +keyword with a left parenthesis unless you want the corresponding right +parenthesis to terminate the arguments to the print--interpose a C<+> or +put parentheses around all the arguments. + +Note that if you're storing FILEHANDLES in an array or other expression, +you will have to use a block returning its value instead: + + print { $files[$i] } "stuff\n"; + print { $OK ? STDOUT : STDERR } "stuff\n"; + +=item printf FILEHANDLE FORMAT, LIST + +=item printf FORMAT, LIST + +Equivalent to C, except that C<$\> +(the output record separator) is not appended. The first argument +of the list will be interpreted as the C format. If C is +in effect, the character used for the decimal point in formatted real numbers +is affected by the LC_NUMERIC locale. See L. + +Don't fall into the trap of using a C when a simple +C would do. The C is more efficient and less +error prone. + +=item prototype FUNCTION + +Returns the prototype of a function as a string (or C if the +function has no prototype). FUNCTION is a reference to, or the name of, +the function whose prototype you want to retrieve. + +If FUNCTION is a string starting with C, the rest is taken as +a name for Perl builtin. If builtin is not I (such as +C) or its arguments cannot be expressed by a prototype (such as +C) - in other words, the builtin does not behave like a Perl +function - returns C. Otherwise, the string describing the +equivalent prototype is returned. + +=item push ARRAY,LIST + +Treats ARRAY as a stack, and pushes the values of LIST +onto the end of ARRAY. The length of ARRAY increases by the length of +LIST. Has the same effect as + + for $value (LIST) { + $ARRAY[++$#ARRAY] = $value; + } + +but is more efficient. Returns the new number of elements in the array. + +=item q/STRING/ + +=item qq/STRING/ + +=item qr/STRING/ + +=item qx/STRING/ + +=item qw/STRING/ + +Generalized quotes. See L. + +=item quotemeta EXPR + +=item quotemeta + +Returns the value of EXPR with all non-alphanumeric +characters backslashed. (That is, all characters not matching +C will be preceded by a backslash in the +returned string, regardless of any locale settings.) +This is the internal function implementing +the C<\Q> escape in double-quoted strings. + +If EXPR is omitted, uses C<$_>. + +=item rand EXPR + +=item rand + +Returns a random fractional number greater than or equal to C<0> and less +than the value of EXPR. (EXPR should be positive.) If EXPR is +omitted, the value C<1> is used. Automatically calls C unless +C has already been called. See also C. + +(Note: If your rand function consistently returns numbers that are too +large or too small, then your version of Perl was probably compiled +with the wrong number of RANDBITS.) + +=item read FILEHANDLE,SCALAR,LENGTH,OFFSET + +=item read FILEHANDLE,SCALAR,LENGTH + +Attempts to read LENGTH bytes of data into variable SCALAR from the +specified FILEHANDLE. Returns the number of bytes actually read, +C<0> at end of file, or undef if there was an error. SCALAR will be grown +or shrunk to the length actually read. An OFFSET may be specified to +place the read data at some other place than the beginning of the +string. This call is actually implemented in terms of stdio's fread(3) +call. To get a true read(2) system call, see C. + +=item readdir DIRHANDLE + +Returns the next directory entry for a directory opened by C. +If used in list context, returns all the rest of the entries in the +directory. If there are no more entries, returns an undefined value in +scalar context or a null list in list context. + +If you're planning to filetest the return values out of a C, you'd +better prepend the directory in question. Otherwise, because we didn't +C there, it would have been testing the wrong file. + + opendir(DIR, $some_dir) || die "can't opendir $some_dir: $!"; + @dots = grep { /^\./ && -f "$some_dir/$_" } readdir(DIR); + closedir DIR; + +=item readline EXPR + +Reads from the filehandle whose typeglob is contained in EXPR. In scalar context, a single line +is read and returned. In list context, reads until end-of-file is +reached and returns a list of lines (however you've defined lines +with C<$/> or C<$INPUT_RECORD_SEPARATOR>). +This is the internal function implementing the CEXPRE> +operator, but you can use it directly. The CEXPRE> +operator is discussed in more detail in L. + + $line = ; + $line = readline(*STDIN); # same thing + +=item readlink EXPR + +=item readlink + +Returns the value of a symbolic link, if symbolic links are +implemented. If not, gives a fatal error. If there is some system +error, returns the undefined value and sets C<$!> (errno). If EXPR is +omitted, uses C<$_>. + +=item readpipe EXPR + +EXPR is executed as a system command. +The collected standard output of the command is returned. +In scalar context, it comes back as a single (potentially +multi-line) string. In list context, returns a list of lines +(however you've defined lines with C<$/> or C<$INPUT_RECORD_SEPARATOR>). +This is the internal function implementing the C +operator, but you can use it directly. The C +operator is discussed in more detail in L. + +=item recv SOCKET,SCALAR,LEN,FLAGS + +Receives a message on a socket. Attempts to receive LENGTH bytes of +data into variable SCALAR from the specified SOCKET filehandle. +Actually does a C C, so that it can return the address of the +sender. Returns the undefined value if there's an error. SCALAR will +be grown or shrunk to the length actually read. Takes the same flags +as the system call of the same name. +See L for examples. + +=item redo LABEL + +=item redo + +The C command restarts the loop block without evaluating the +conditional again. The C block, if any, is not executed. If +the LABEL is omitted, the command refers to the innermost enclosing +loop. This command is normally used by programs that want to lie to +themselves about what was just input: + + # a simpleminded Pascal comment stripper + # (warning: assumes no { or } in strings) + LINE: while () { + while (s|({.*}.*){.*}|$1 |) {} + s|{.*}| |; + if (s|{.*| |) { + $front = $_; + while () { + if (/}/) { # end of comment? + s|^|$front\{|; + redo LINE; + } + } + } + print; + } + +See also L for an illustration of how C, C, and +C work. + +=item ref EXPR + +=item ref + +Returns a TRUE value if EXPR is a reference, FALSE otherwise. If EXPR +is not specified, C<$_> will be used. The value returned depends on the +type of thing the reference is a reference to. +Builtin types include: + + REF + SCALAR + ARRAY + HASH + CODE + GLOB + +If the referenced object has been blessed into a package, then that package +name is returned instead. You can think of C as a C operator. + + if (ref($r) eq "HASH") { + print "r is a reference to a hash.\n"; + } + if (!ref($r)) { + print "r is not a reference at all.\n"; + } + +See also L. + +=item rename OLDNAME,NEWNAME + +Changes the name of a file. Returns C<1> for success, C<0> otherwise. Will +not work across file system boundaries. + +=item require EXPR + +=item require + +Demands some semantics specified by EXPR, or by C<$_> if EXPR is not +supplied. If EXPR is numeric, demands that the current version of Perl +(C<$]> or $PERL_VERSION) be equal or greater than EXPR. + +Otherwise, demands that a library file be included if it hasn't already +been included. The file is included via the do-FILE mechanism, which is +essentially just a variety of C. Has semantics similar to the following +subroutine: + + sub require { + my($filename) = @_; + return 1 if $INC{$filename}; + my($realfilename,$result); + ITER: { + foreach $prefix (@INC) { + $realfilename = "$prefix/$filename"; + if (-f $realfilename) { + $result = do $realfilename; + last ITER; + } + } + die "Can't find $filename in \@INC"; + } + die $@ if $@; + die "$filename did not return true value" unless $result; + $INC{$filename} = $realfilename; + return $result; + } + +Note that the file will not be included twice under the same specified +name. The file must return TRUE as the last statement to indicate +successful execution of any initialization code, so it's customary to +end such a file with "C<1;>" unless you're sure it'll return TRUE +otherwise. But it's better just to put the "C<1;>", in case you add more +statements. + +If EXPR is a bareword, the require assumes a "F<.pm>" extension and +replaces "F<::>" with "F" in the filename for you, +to make it easy to load standard modules. This form of loading of +modules does not risk altering your namespace. + +In other words, if you try this: + + require Foo::Bar; # a splendid bareword + +The require function will actually look for the "F" file in the +directories specified in the C<@INC> array. + +But if you try this: + + $class = 'Foo::Bar'; + require $class; # $class is not a bareword + #or + require "Foo::Bar"; # not a bareword because of the "" + +The require function will look for the "F" file in the @INC array and +will complain about not finding "F" there. In this case you can do: + + eval "require $class"; + +For a yet-more-powerful import facility, see L and L. + +=item reset EXPR + +=item reset + +Generally used in a C block at the end of a loop to clear +variables and reset C searches so that they work again. The +expression is interpreted as a list of single characters (hyphens +allowed for ranges). All variables and arrays beginning with one of +those letters are reset to their pristine state. If the expression is +omitted, one-match searches (C) are reset to match again. Resets +only variables or searches in the current package. Always returns +1. Examples: + + reset 'X'; # reset all X variables + reset 'a-z'; # reset lower case variables + reset; # just reset ?? searches + +Resetting C<"A-Z"> is not recommended because you'll wipe out your +C<@ARGV> and C<@INC> arrays and your C<%ENV> hash. Resets only package variables--lexical variables +are unaffected, but they clean themselves up on scope exit anyway, +so you'll probably want to use them instead. See L. + +=item return EXPR + +=item return + +Returns from a subroutine, C, or C with the value +given in EXPR. Evaluation of EXPR may be in list, scalar, or void +context, depending on how the return value will be used, and the context +may vary from one execution to the next (see C). If no EXPR +is given, returns an empty list in list context, an undefined value in +scalar context, or nothing in a void context. + +(Note that in the absence of a return, a subroutine, eval, or do FILE +will automatically return the value of the last expression evaluated.) + +=item reverse LIST + +In list context, returns a list value consisting of the elements +of LIST in the opposite order. In scalar context, concatenates the +elements of LIST, and returns a string value consisting of those bytes, +but in the opposite order. + + print reverse <>; # line tac, last line first + + undef $/; # for efficiency of <> + print scalar reverse <>; # byte tac, last line tsrif + +This operator is also handy for inverting a hash, although there are some +caveats. If a value is duplicated in the original hash, only one of those +can be represented as a key in the inverted hash. Also, this has to +unwind one hash and build a whole new one, which may take some time +on a large hash. + + %by_name = reverse %by_address; # Invert the hash + +=item rewinddir DIRHANDLE + +Sets the current position to the beginning of the directory for the +C routine on DIRHANDLE. + +=item rindex STR,SUBSTR,POSITION + +=item rindex STR,SUBSTR + +Works just like index except that it returns the position of the LAST +occurrence of SUBSTR in STR. If POSITION is specified, returns the +last occurrence at or before that position. + +=item rmdir FILENAME + +=item rmdir + +Deletes the directory specified by FILENAME if that directory is empty. If it +succeeds it returns TRUE, otherwise it returns FALSE and sets C<$!> (errno). If +FILENAME is omitted, uses C<$_>. + +=item s/// + +The substitution operator. See L. + +=item scalar EXPR + +Forces EXPR to be interpreted in scalar context and returns the value +of EXPR. + + @counts = ( scalar @a, scalar @b, scalar @c ); + +There is no equivalent operator to force an expression to +be interpolated in list context because it's in practice never +needed. If you really wanted to do so, however, you could use +the construction C<@{[ (some expression) ]}>, but usually a simple +C<(some expression)> suffices. + +=item seek FILEHANDLE,POSITION,WHENCE + +Sets FILEHANDLE's position, just like the C call of C. +FILEHANDLE may be an expression whose value gives the name of the +filehandle. The values for WHENCE are C<0> to set the new position to +POSITION, C<1> to set it to the current position plus POSITION, and C<2> to +set it to EOF plus POSITION (typically negative). For WHENCE you may +use the constants C, C, and C from either the +C or the POSIX module. Returns C<1> upon success, C<0> otherwise. + +If you want to position file for C or C, don't use +C -- buffering makes its effect on the file's system position +unpredictable and non-portable. Use C instead. + +On some systems you have to do a seek whenever you switch between reading +and writing. Amongst other things, this may have the effect of calling +stdio's clearerr(3). A WHENCE of C<1> (C) is useful for not moving +the file position: + + seek(TEST,0,1); + +This is also useful for applications emulating C. Once you hit +EOF on your read, and then sleep for a while, you might have to stick in a +seek() to reset things. The C doesn't change the current position, +but it I clear the end-of-file condition on the handle, so that the +next CFILEE> makes Perl try again to read something. We hope. + +If that doesn't work (some stdios are particularly cantankerous), then +you may need something more like this: + + for (;;) { + for ($curpos = tell(FILE); $_ = ; + $curpos = tell(FILE)) { + # search for some stuff and put it into files + } + sleep($for_a_while); + seek(FILE, $curpos, 0); + } + +=item seekdir DIRHANDLE,POS + +Sets the current position for the C routine on DIRHANDLE. POS +must be a value returned by C. Has the same caveats about +possible directory compaction as the corresponding system library +routine. + +=item select FILEHANDLE + +=item select + +Returns the currently selected filehandle. Sets the current default +filehandle for output, if FILEHANDLE is supplied. This has two +effects: first, a C or a C without a filehandle will +default to this FILEHANDLE. Second, references to variables related to +output will refer to this output channel. For example, if you have to +set the top of form format for more than one output channel, you might +do the following: + + select(REPORT1); + $^ = 'report1_top'; + select(REPORT2); + $^ = 'report2_top'; + +FILEHANDLE may be an expression whose value gives the name of the +actual filehandle. Thus: + + $oldfh = select(STDERR); $| = 1; select($oldfh); + +Some programmers may prefer to think of filehandles as objects with +methods, preferring to write the last example as: + + use IO::Handle; + STDERR->autoflush(1); + +=item select RBITS,WBITS,EBITS,TIMEOUT + +This calls the select(2) system call with the bit masks specified, which +can be constructed using C and C, along these lines: + + $rin = $win = $ein = ''; + vec($rin,fileno(STDIN),1) = 1; + vec($win,fileno(STDOUT),1) = 1; + $ein = $rin | $win; + +If you want to select on many filehandles you might wish to write a +subroutine: + + sub fhbits { + my(@fhlist) = split(' ',$_[0]); + my($bits); + for (@fhlist) { + vec($bits,fileno($_),1) = 1; + } + $bits; + } + $rin = fhbits('STDIN TTY SOCK'); + +The usual idiom is: + + ($nfound,$timeleft) = + select($rout=$rin, $wout=$win, $eout=$ein, $timeout); + +or to block until something becomes ready just do this + + $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); + +Most systems do not bother to return anything useful in C<$timeleft>, so +calling select() in scalar context just returns C<$nfound>. + +Any of the bit masks can also be undef. The timeout, if specified, is +in seconds, which may be fractional. Note: not all implementations are +capable of returning theC<$timeleft>. If not, they always return +C<$timeleft> equal to the supplied C<$timeout>. + +You can effect a sleep of 250 milliseconds this way: + + select(undef, undef, undef, 0.25); + +B: One should not attempt to mix buffered I/O (like C +or EFHE) with C, except as permitted by POSIX, and even +then only on POSIX systems. You have to use C instead. + +=item semctl ID,SEMNUM,CMD,ARG + +Calls the System V IPC function C. You'll probably have to say + + use IPC::SysV; + +first to get the correct constant definitions. If CMD is IPC_STAT or +GETALL, then ARG must be a variable which will hold the returned +semid_ds structure or semaphore value array. Returns like C: the +undefined value for error, "C<0> but true" for zero, or the actual return +value otherwise. See also C and C documentation. + +=item semget KEY,NSEMS,FLAGS + +Calls the System V IPC function semget. Returns the semaphore id, or +the undefined value if there is an error. See also C and +C documentation. + +=item semop KEY,OPSTRING + +Calls the System V IPC function semop to perform semaphore operations +such as signaling and waiting. OPSTRING must be a packed array of +semop structures. Each semop structure can be generated with +C. The number of semaphore +operations is implied by the length of OPSTRING. Returns TRUE if +successful, or FALSE if there is an error. As an example, the +following code waits on semaphore C<$semnum> of semaphore id C<$semid>: + + $semop = pack("sss", $semnum, -1, 0); + die "Semaphore trouble: $!\n" unless semop($semid, $semop); + +To signal the semaphore, replace C<-1> with C<1>. See also C +and C documentation. + +=item send SOCKET,MSG,FLAGS,TO + +=item send SOCKET,MSG,FLAGS + +Sends a message on a socket. Takes the same flags as the system call +of the same name. On unconnected sockets you must specify a +destination to send TO, in which case it does a C C. Returns +the number of characters sent, or the undefined value if there is an +error. +See L for examples. + +=item setpgrp PID,PGRP + +Sets the current process group for the specified PID, C<0> for the current +process. Will produce a fatal error if used on a machine that doesn't +implement setpgrp(2). If the arguments are omitted, it defaults to +C<0,0>. Note that the POSIX version of C does not accept any +arguments, so only setpgrp C<0,0> is portable. + +=item setpriority WHICH,WHO,PRIORITY + +Sets the current priority for a process, a process group, or a user. +(See setpriority(2).) Will produce a fatal error if used on a machine +that doesn't implement setpriority(2). + +=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL + +Sets the socket option requested. Returns undefined if there is an +error. OPTVAL may be specified as C if you don't want to pass an +argument. + +=item shift ARRAY + +=item shift + +Shifts the first value of the array off and returns it, shortening the +array by 1 and moving everything down. If there are no elements in the +array, returns the undefined value. If ARRAY is omitted, shifts the +C<@_> array within the lexical scope of subroutines and formats, and the +C<@ARGV> array at file scopes or within the lexical scopes established by +the C, C, C, and C constructs. +See also C, C, and C. C and C do the +same thing to the left end of an array that C and C do to the +right end. + +=item shmctl ID,CMD,ARG + +Calls the System V IPC function shmctl. You'll probably have to say + + use IPC::SysV; + +first to get the correct constant definitions. If CMD is C, +then ARG must be a variable which will hold the returned C +structure. Returns like ioctl: the undefined value for error, "C<0> but +true" for zero, or the actual return value otherwise. +See also C documentation. + +=item shmget KEY,SIZE,FLAGS + +Calls the System V IPC function shmget. Returns the shared memory +segment id, or the undefined value if there is an error. +See also C documentation. + +=item shmread ID,VAR,POS,SIZE + +=item shmwrite ID,STRING,POS,SIZE + +Reads or writes the System V shared memory segment ID starting at +position POS for size SIZE by attaching to it, copying in/out, and +detaching from it. When reading, VAR must be a variable that will +hold the data read. When writing, if STRING is too long, only SIZE +bytes are used; if STRING is too short, nulls are written to fill out +SIZE bytes. Return TRUE if successful, or FALSE if there is an error. +See also C documentation. + +=item shutdown SOCKET,HOW + +Shuts down a socket connection in the manner indicated by HOW, which +has the same interpretation as in the system call of the same name. + + shutdown(SOCKET, 0); # I/we have stopped reading data + shutdown(SOCKET, 1); # I/we have stopped writing data + shutdown(SOCKET, 2); # I/we have stopped using this socket + +This is useful with sockets when you want to tell the other +side you're done writing but not done reading, or vice versa. +It's also a more insistent form of close because it also +disables the filedescriptor in any forked copies in other +processes. + +=item sin EXPR + +=item sin + +Returns the sine of EXPR (expressed in radians). If EXPR is omitted, +returns sine of C<$_>. + +For the inverse sine operation, you may use the C +function, or use this relation: + + sub asin { atan2($_[0], sqrt(1 - $_[0] * $_[0])) } + +=item sleep EXPR + +=item sleep + +Causes the script to sleep for EXPR seconds, or forever if no EXPR. +May be interrupted if the process receives a signal such as C. +Returns the number of seconds actually slept. You probably cannot +mix C and C calls, because C is often implemented +using C. + +On some older systems, it may sleep up to a full second less than what +you requested, depending on how it counts seconds. Most modern systems +always sleep the full amount. They may appear to sleep longer than that, +however, because your process might not be scheduled right away in a +busy multitasking system. + +For delays of finer granularity than one second, you may use Perl's +C interface to access setitimer(2) if your system supports it, +or else see L above. + +See also the POSIX module's C function. + +=item socket SOCKET,DOMAIN,TYPE,PROTOCOL + +Opens a socket of the specified kind and attaches it to filehandle +SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the +system call of the same name. You should "C" first to get +the proper definitions imported. See the example in L. + +=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL + +Creates an unnamed pair of sockets in the specified domain, of the +specified type. DOMAIN, TYPE, and PROTOCOL are specified the same as +for the system call of the same name. If unimplemented, yields a fatal +error. Returns TRUE if successful. + +Some systems defined C in terms of C, in which a call +to C is essentially: + + use Socket; + socketpair(Rdr, Wtr, AF_UNIX, SOCK_STREAM, PF_UNSPEC); + shutdown(Rdr, 1); # no more writing for reader + shutdown(Wtr, 0); # no more reading for writer + +See L for an example of socketpair use. + +=item sort SUBNAME LIST + +=item sort BLOCK LIST + +=item sort LIST + +Sorts the LIST and returns the sorted list value. If SUBNAME or BLOCK +is omitted, Cs in standard string comparison order. If SUBNAME is +specified, it gives the name of a subroutine that returns an integer +less than, equal to, or greater than C<0>, depending on how the elements +of the array are to be ordered. (The C=E> and C +operators are extremely useful in such routines.) SUBNAME may be a +scalar variable name (unsubscripted), in which case the value provides +the name of (or a reference to) the actual subroutine to use. In place +of a SUBNAME, you can provide a BLOCK as an anonymous, in-line sort +subroutine. + +In the interests of efficiency the normal calling code for subroutines is +bypassed, with the following effects: the subroutine may not be a +recursive subroutine, and the two elements to be compared are passed into +the subroutine not via C<@_> but as the package global variables C<$a> and +C<$b> (see example below). They are passed by reference, so don't +modify C<$a> and C<$b>. And don't try to declare them as lexicals either. + +You also cannot exit out of the sort block or subroutine using any of the +loop control operators described in L or with C. + +When C is in effect, C sorts LIST according to the +current collation locale. See L. + +Examples: + + # sort lexically + @articles = sort @files; + + # same thing, but with explicit sort routine + @articles = sort {$a cmp $b} @files; + + # now case-insensitively + @articles = sort {uc($a) cmp uc($b)} @files; + + # same thing in reversed order + @articles = sort {$b cmp $a} @files; + + # sort numerically ascending + @articles = sort {$a <=> $b} @files; + + # sort numerically descending + @articles = sort {$b <=> $a} @files; + + # sort using explicit subroutine name + sub byage { + $age{$a} <=> $age{$b}; # presuming numeric + } + @sortedclass = sort byage @class; + + # this sorts the %age hash by value instead of key + # using an in-line function + @eldest = sort { $age{$b} <=> $age{$a} } keys %age; + + sub backwards { $b cmp $a; } + @harry = ('dog','cat','x','Cain','Abel'); + @george = ('gone','chased','yz','Punished','Axed'); + print sort @harry; + # prints AbelCaincatdogx + print sort backwards @harry; + # prints xdogcatCainAbel + print sort @george, 'to', @harry; + # prints AbelAxedCainPunishedcatchaseddoggonetoxyz + + # inefficiently sort by descending numeric compare using + # the first integer after the first = sign, or the + # whole record case-insensitively otherwise + + @new = sort { + ($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0] + || + uc($a) cmp uc($b) + } @old; + + # same thing, but much more efficiently; + # we'll build auxiliary indices instead + # for speed + @nums = @caps = (); + for (@old) { + push @nums, /=(\d+)/; + push @caps, uc($_); + } + + @new = @old[ sort { + $nums[$b] <=> $nums[$a] + || + $caps[$a] cmp $caps[$b] + } 0..$#old + ]; + + # same thing using a Schwartzian Transform (no temps) + @new = map { $_->[0] } + sort { $b->[1] <=> $a->[1] + || + $a->[2] cmp $b->[2] + } map { [$_, /=(\d+)/, uc($_)] } @old; + +If you're using strict, you I declare C<$a> +and C<$b> as lexicals. They are package globals. That means +if you're in the C
    package, it's + + @articles = sort {$main::b <=> $main::a} @files; + +or just + + @articles = sort {$::b <=> $::a} @files; + +but if you're in the C package, it's + + @articles = sort {$FooPack::b <=> $FooPack::a} @files; + +The comparison function is required to behave. If it returns +inconsistent results (sometimes saying C<$x[1]> is less than C<$x[2]> and +sometimes saying the opposite, for example) the results are not +well-defined. + +=item splice ARRAY,OFFSET,LENGTH,LIST + +=item splice ARRAY,OFFSET,LENGTH + +=item splice ARRAY,OFFSET + +Removes the elements designated by OFFSET and LENGTH from an array, and +replaces them with the elements of LIST, if any. In list context, +returns the elements removed from the array. In scalar context, +returns the last element removed, or C if no elements are +removed. The array grows or shrinks as necessary. +If OFFSET is negative then it start that far from the end of the array. +If LENGTH is omitted, removes everything from OFFSET onward. +If LENGTH is negative, leave that many elements off the end of the array. +The following equivalences hold (assuming C<$[ == 0>): + + push(@a,$x,$y) splice(@a,@a,0,$x,$y) + pop(@a) splice(@a,-1) + shift(@a) splice(@a,0,1) + unshift(@a,$x,$y) splice(@a,0,0,$x,$y) + $a[$x] = $y splice(@a,$x,1,$y) + +Example, assuming array lengths are passed before arrays: + + sub aeq { # compare two list values + my(@a) = splice(@_,0,shift); + my(@b) = splice(@_,0,shift); + return 0 unless @a == @b; # same len? + while (@a) { + return 0 if pop(@a) ne pop(@b); + } + return 1; + } + if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... } + +=item split /PATTERN/,EXPR,LIMIT + +=item split /PATTERN/,EXPR + +=item split /PATTERN/ + +=item split + +Splits a string into an array of strings, and returns it. By default, +empty leading fields are preserved, and empty trailing ones are deleted. + +If not in list context, returns the number of fields found and splits into +the C<@_> array. (In list context, you can force the split into C<@_> by +using C as the pattern delimiters, but it still returns the list +value.) The use of implicit split to C<@_> is deprecated, however, because +it clobbers your subroutine arguments. + +If EXPR is omitted, splits the C<$_> string. If PATTERN is also omitted, +splits on whitespace (after skipping any leading whitespace). Anything +matching PATTERN is taken to be a delimiter separating the fields. (Note +that the delimiter may be longer than one character.) + +If LIMIT is specified and positive, splits into no more than that +many fields (though it may split into fewer). If LIMIT is unspecified +or zero, trailing null fields are stripped (which potential users +of C would do well to remember). If LIMIT is negative, it is +treated as if an arbitrarily large LIMIT had been specified. + +A pattern matching the null string (not to be confused with +a null pattern C, which is just one member of the set of patterns +matching a null string) will split the value of EXPR into separate +characters at each point it matches that way. For example: + + print join(':', split(/ */, 'hi there')); + +produces the output 'h:i:t:h:e:r:e'. + +The LIMIT parameter can be used to split a line partially + + ($login, $passwd, $remainder) = split(/:/, $_, 3); + +When assigning to a list, if LIMIT is omitted, Perl supplies a LIMIT +one larger than the number of variables in the list, to avoid +unnecessary work. For the list above LIMIT would have been 4 by +default. In time critical applications it behooves you not to split +into more fields than you really need. + +If the PATTERN contains parentheses, additional array elements are +created from each matching substring in the delimiter. + + split(/([,-])/, "1-10,20", 3); + +produces the list value + + (1, '-', 10, ',', 20) + +If you had the entire header of a normal Unix email message in C<$header>, +you could split it up into fields and their values this way: + + $header =~ s/\n\s+/ /g; # fix continuation lines + %hdrs = (UNIX_FROM => split /^(\S*?):\s*/m, $header); + +The pattern C may be replaced with an expression to specify +patterns that vary at runtime. (To do runtime compilation only once, +use C.) + +As a special case, specifying a PATTERN of space (C<' '>) will split on +white space just as C with no arguments does. Thus, C can +be used to emulate B's default behavior, whereas C +will give you as many null initial fields as there are leading spaces. +A C on C is like a C except that any leading +whitespace produces a null first field. A C with no arguments +really does a C internally. + +Example: + + open(PASSWD, '/etc/passwd'); + while () { + ($login, $passwd, $uid, $gid, + $gcos, $home, $shell) = split(/:/); + #... + } + +(Note that C<$shell> above will still have a newline on it. See L, +L, and L.) + +=item sprintf FORMAT, LIST + +Returns a string formatted by the usual C conventions of the +C library function C. See L or L +on your system for an explanation of the general principles. + +Perl does its own C formatting -- it emulates the C +function C, but it doesn't use it (except for floating-point +numbers, and even then only the standard modifiers are allowed). As a +result, any non-standard extensions in your local C are not +available from Perl. + +Perl's C permits the following universally-known conversions: + + %% a percent sign + %c a character with the given number + %s a string + %d a signed integer, in decimal + %u an unsigned integer, in decimal + %o an unsigned integer, in octal + %x an unsigned integer, in hexadecimal + %e a floating-point number, in scientific notation + %f a floating-point number, in fixed decimal notation + %g a floating-point number, in %e or %f notation + +In addition, Perl permits the following widely-supported conversions: + + %X like %x, but using upper-case letters + %E like %e, but using an upper-case "E" + %G like %g, but with an upper-case "E" (if applicable) + %p a pointer (outputs the Perl value's address in hexadecimal) + %n special: *stores* the number of characters output so far + into the next variable in the parameter list + +Finally, for backward (and we do mean "backward") compatibility, Perl +permits these unnecessary but widely-supported conversions: + + %i a synonym for %d + %D a synonym for %ld + %U a synonym for %lu + %O a synonym for %lo + %F a synonym for %f + +Perl permits the following universally-known flags between the C<%> +and the conversion letter: + + space prefix positive number with a space + + prefix positive number with a plus sign + - left-justify within the field + 0 use zeros, not spaces, to right-justify + # prefix non-zero octal with "0", non-zero hex with "0x" + number minimum field width + .number "precision": digits after decimal point for + floating-point, max length for string, minimum length + for integer + l interpret integer as C type "long" or "unsigned long" + h interpret integer as C type "short" or "unsigned short" + +There is also one Perl-specific flag: + + V interpret integer as Perl's standard integer type + +Where a number would appear in the flags, an asterisk ("C<*>") may be +used instead, in which case Perl uses the next item in the parameter +list as the given number (that is, as the field width or precision). +If a field width obtained through "C<*>" is negative, it has the same +effect as the "C<->" flag: left-justification. + +If C is in effect, the character used for the decimal +point in formatted real numbers is affected by the LC_NUMERIC locale. +See L. + +=item sqrt EXPR + +=item sqrt + +Return the square root of EXPR. If EXPR is omitted, returns square +root of C<$_>. + +=item srand EXPR + +=item srand + +Sets the random number seed for the C operator. If EXPR is +omitted, uses a semi-random value based on the current time and process +ID, among other things. In versions of Perl prior to 5.004 the default +seed was just the current C. This isn't a particularly good seed, +so many old programs supply their own seed value (often C
    . See L. + +=back diff --git a/contrib/perl5/pod/perlguts.pod b/contrib/perl5/pod/perlguts.pod new file mode 100644 index 00000000000..20a07d38540 --- /dev/null +++ b/contrib/perl5/pod/perlguts.pod @@ -0,0 +1,3557 @@ +=head1 NAME + +perlguts - Perl's Internal Functions + +=head1 DESCRIPTION + +This document attempts to describe some of the internal functions of the +Perl executable. It is far from complete and probably contains many errors. +Please refer any questions or comments to the author below. + +=head1 Variables + +=head2 Datatypes + +Perl has three typedefs that handle Perl's three main data types: + + SV Scalar Value + AV Array Value + HV Hash Value + +Each typedef has specific routines that manipulate the various data types. + +=head2 What is an "IV"? + +Perl uses a special typedef IV which is a simple integer type that is +guaranteed to be large enough to hold a pointer (as well as an integer). + +Perl also uses two special typedefs, I32 and I16, which will always be at +least 32-bits and 16-bits long, respectively. + +=head2 Working with SVs + +An SV can be created and loaded with one command. There are four types of +values that can be loaded: an integer value (IV), a double (NV), a string, +(PV), and another scalar (SV). + +The six routines are: + + SV* newSViv(IV); + SV* newSVnv(double); + SV* newSVpv(char*, int); + SV* newSVpvn(char*, int); + SV* newSVpvf(const char*, ...); + SV* newSVsv(SV*); + +To change the value of an *already-existing* SV, there are seven routines: + + void sv_setiv(SV*, IV); + void sv_setuv(SV*, UV); + void sv_setnv(SV*, double); + void sv_setpv(SV*, char*); + void sv_setpvn(SV*, char*, int) + void sv_setpvf(SV*, const char*, ...); + void sv_setpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool); + void sv_setsv(SV*, SV*); + +Notice that you can choose to specify the length of the string to be +assigned by using C, C, or C, or you may +allow Perl to calculate the length by using C or by specifying +0 as the second argument to C. Be warned, though, that Perl will +determine the string's length by using C, which depends on the +string terminating with a NUL character. + +The arguments of C are processed like C, and the +formatted output becomes the value. + +C is an analogue of C, but it allows you to specify +either a pointer to a variable argument list or the address and length of +an array of SVs. The last argument points to a boolean; on return, if that +boolean is true, then locale-specific information has been used to format +the string, and the string's contents are therefore untrustworty (see +L). This pointer may be NULL if that information is not +important. Note that this function requires you to specify the length of +the format. + +The C functions are not generic enough to operate on values +that have "magic". See L later in this document. + +All SVs that contain strings should be terminated with a NUL character. +If it is not NUL-terminated there is a risk of +core dumps and corruptions from code which passes the string to C +functions or system calls which expect a NUL-terminated string. +Perl's own functions typically add a trailing NUL for this reason. +Nevertheless, you should be very careful when you pass a string stored +in an SV to a C function or system call. + +To access the actual value that an SV points to, you can use the macros: + + SvIV(SV*) + SvNV(SV*) + SvPV(SV*, STRLEN len) + +which will automatically coerce the actual scalar type into an IV, double, +or string. + +In the C macro, the length of the string returned is placed into the +variable C (this is a macro, so you do I use C<&len>). If you do not +care what the length of the data is, use the global variable C. Remember, +however, that Perl allows arbitrary strings of data that may both contain +NULs and might not be terminated by a NUL. + +If you want to know if the scalar value is TRUE, you can use: + + SvTRUE(SV*) + +Although Perl will automatically grow strings for you, if you need to force +Perl to allocate more memory for your SV, you can use the macro + + SvGROW(SV*, STRLEN newlen) + +which will determine if more memory needs to be allocated. If so, it will +call the function C. Note that C can only increase, not +decrease, the allocated memory of an SV and that it does not automatically +add a byte for the a trailing NUL (perl's own string functions typically do +C). + +If you have an SV and want to know what kind of data Perl thinks is stored +in it, you can use the following macros to check the type of SV you have. + + SvIOK(SV*) + SvNOK(SV*) + SvPOK(SV*) + +You can get and set the current length of the string stored in an SV with +the following macros: + + SvCUR(SV*) + SvCUR_set(SV*, I32 val) + +You can also get a pointer to the end of the string stored in the SV +with the macro: + + SvEND(SV*) + +But note that these last three macros are valid only if C is true. + +If you want to append something to the end of string stored in an C, +you can use the following functions: + + void sv_catpv(SV*, char*); + void sv_catpvn(SV*, char*, int); + void sv_catpvf(SV*, const char*, ...); + void sv_catpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool); + void sv_catsv(SV*, SV*); + +The first function calculates the length of the string to be appended by +using C. In the second, you specify the length of the string +yourself. The third function processes its arguments like C and +appends the formatted output. The fourth function works like C. +You can specify the address and length of an array of SVs instead of the +va_list argument. The fifth function extends the string stored in the first +SV with the string stored in the second SV. It also forces the second SV +to be interpreted as a string. + +The C functions are not generic enough to operate on values that +have "magic". See L later in this document. + +If you know the name of a scalar variable, you can get a pointer to its SV +by using the following: + + SV* perl_get_sv("package::varname", FALSE); + +This returns NULL if the variable does not exist. + +If you want to know if this variable (or any other SV) is actually C, +you can call: + + SvOK(SV*) + +The scalar C value is stored in an SV instance called C. Its +address can be used whenever an C is needed. + +There are also the two values C and C, which contain Boolean +TRUE and FALSE values, respectively. Like C, their addresses can +be used whenever an C is needed. + +Do not be fooled into thinking that C<(SV *) 0> is the same as C<&PL_sv_undef>. +Take this code: + + SV* sv = (SV*) 0; + if (I-am-to-return-a-real-value) { + sv = sv_2mortal(newSViv(42)); + } + sv_setsv(ST(0), sv); + +This code tries to return a new SV (which contains the value 42) if it should +return a real value, or undef otherwise. Instead it has returned a NULL +pointer which, somewhere down the line, will cause a segmentation violation, +bus error, or just weird results. Change the zero to C<&PL_sv_undef> in the first +line and all will be well. + +To free an SV that you've created, call C. Normally this +call is not necessary (see L). + +=head2 What's Really Stored in an SV? + +Recall that the usual method of determining the type of scalar you have is +to use C macros. Because a scalar can be both a number and a string, +usually these macros will always return TRUE and calling the C +macros will do the appropriate conversion of string to integer/double or +integer/double to string. + +If you I need to know if you have an integer, double, or string +pointer in an SV, you can use the following three macros instead: + + SvIOKp(SV*) + SvNOKp(SV*) + SvPOKp(SV*) + +These will tell you if you truly have an integer, double, or string pointer +stored in your SV. The "p" stands for private. + +In general, though, it's best to use the C macros. + +=head2 Working with AVs + +There are two ways to create and load an AV. The first method creates an +empty AV: + + AV* newAV(); + +The second method both creates the AV and initially populates it with SVs: + + AV* av_make(I32 num, SV **ptr); + +The second argument points to an array containing C C's. Once the +AV has been created, the SVs can be destroyed, if so desired. + +Once the AV has been created, the following operations are possible on AVs: + + void av_push(AV*, SV*); + SV* av_pop(AV*); + SV* av_shift(AV*); + void av_unshift(AV*, I32 num); + +These should be familiar operations, with the exception of C. +This routine adds C elements at the front of the array with the C +value. You must then use C (described below) to assign values +to these new elements. + +Here are some other functions: + + I32 av_len(AV*); + SV** av_fetch(AV*, I32 key, I32 lval); + SV** av_store(AV*, I32 key, SV* val); + +The C function returns the highest index value in array (just +like $#array in Perl). If the array is empty, -1 is returned. The +C function returns the value at index C, but if C +is non-zero, then C will store an undef value at that index. +The C function stores the value C at index C, and does +not increment the reference count of C. Thus the caller is responsible +for taking care of that, and if C returns NULL, the caller will +have to decrement the reference count to avoid a memory leak. Note that +C and C both return C's, not C's as their +return value. + + void av_clear(AV*); + void av_undef(AV*); + void av_extend(AV*, I32 key); + +The C function deletes all the elements in the AV* array, but +does not actually delete the array itself. The C function will +delete all the elements in the array plus the array itself. The +C function extends the array so that it contains C +elements. If C is less than the current length of the array, then +nothing is done. + +If you know the name of an array variable, you can get a pointer to its AV +by using the following: + + AV* perl_get_av("package::varname", FALSE); + +This returns NULL if the variable does not exist. + +See L for more +information on how to use the array access functions on tied arrays. + +=head2 Working with HVs + +To create an HV, you use the following routine: + + HV* newHV(); + +Once the HV has been created, the following operations are possible on HVs: + + SV** hv_store(HV*, char* key, U32 klen, SV* val, U32 hash); + SV** hv_fetch(HV*, char* key, U32 klen, I32 lval); + +The C parameter is the length of the key being passed in (Note that +you cannot pass 0 in as a value of C to tell Perl to measure the +length of the key). The C argument contains the SV pointer to the +scalar being stored, and C is the precomputed hash value (zero if +you want C to calculate it for you). The C parameter +indicates whether this fetch is actually a part of a store operation, in +which case a new undefined value will be added to the HV with the supplied +key and C will return as if the value had already existed. + +Remember that C and C return C's and not just +C. To access the scalar value, you must first dereference the return +value. However, you should check to make sure that the return value is +not NULL before dereferencing it. + +These two functions check if a hash table entry exists, and deletes it. + + bool hv_exists(HV*, char* key, U32 klen); + SV* hv_delete(HV*, char* key, U32 klen, I32 flags); + +If C does not include the C flag then C will +create and return a mortal copy of the deleted value. + +And more miscellaneous functions: + + void hv_clear(HV*); + void hv_undef(HV*); + +Like their AV counterparts, C deletes all the entries in the hash +table but does not actually delete the hash table. The C deletes +both the entries and the hash table itself. + +Perl keeps the actual data in linked list of structures with a typedef of HE. +These contain the actual key and value pointers (plus extra administrative +overhead). The key is a string pointer; the value is an C. However, +once you have an C, to get the actual key and value, use the routines +specified below. + + I32 hv_iterinit(HV*); + /* Prepares starting point to traverse hash table */ + HE* hv_iternext(HV*); + /* Get the next entry, and return a pointer to a + structure that has both the key and value */ + char* hv_iterkey(HE* entry, I32* retlen); + /* Get the key from an HE structure and also return + the length of the key string */ + SV* hv_iterval(HV*, HE* entry); + /* Return a SV pointer to the value of the HE + structure */ + SV* hv_iternextsv(HV*, char** key, I32* retlen); + /* This convenience routine combines hv_iternext, + hv_iterkey, and hv_iterval. The key and retlen + arguments are return values for the key and its + length. The value is returned in the SV* argument */ + +If you know the name of a hash variable, you can get a pointer to its HV +by using the following: + + HV* perl_get_hv("package::varname", FALSE); + +This returns NULL if the variable does not exist. + +The hash algorithm is defined in the C macro: + + i = klen; + hash = 0; + s = key; + while (i--) + hash = hash * 33 + *s++; + +See L for more +information on how to use the hash access functions on tied hashes. + +=head2 Hash API Extensions + +Beginning with version 5.004, the following functions are also supported: + + HE* hv_fetch_ent (HV* tb, SV* key, I32 lval, U32 hash); + HE* hv_store_ent (HV* tb, SV* key, SV* val, U32 hash); + + bool hv_exists_ent (HV* tb, SV* key, U32 hash); + SV* hv_delete_ent (HV* tb, SV* key, I32 flags, U32 hash); + + SV* hv_iterkeysv (HE* entry); + +Note that these functions take C keys, which simplifies writing +of extension code that deals with hash structures. These functions +also allow passing of C keys to C functions without forcing +you to stringify the keys (unlike the previous set of functions). + +They also return and accept whole hash entries (C), making their +use more efficient (since the hash number for a particular string +doesn't have to be recomputed every time). See L later in +this document for detailed descriptions. + +The following macros must always be used to access the contents of hash +entries. Note that the arguments to these macros must be simple +variables, since they may get evaluated more than once. See +L later in this document for detailed descriptions of these +macros. + + HePV(HE* he, STRLEN len) + HeVAL(HE* he) + HeHASH(HE* he) + HeSVKEY(HE* he) + HeSVKEY_force(HE* he) + HeSVKEY_set(HE* he, SV* sv) + +These two lower level macros are defined, but must only be used when +dealing with keys that are not Cs: + + HeKEY(HE* he) + HeKLEN(HE* he) + +Note that both C and C do not increment the +reference count of the stored C, which is the caller's responsibility. +If these functions return a NULL value, the caller will usually have to +decrement the reference count of C to avoid a memory leak. + +=head2 References + +References are a special type of scalar that point to other data types +(including references). + +To create a reference, use either of the following functions: + + SV* newRV_inc((SV*) thing); + SV* newRV_noinc((SV*) thing); + +The C argument can be any of an C, C, or C. The +functions are identical except that C increments the reference +count of the C, while C does not. For historical +reasons, C is a synonym for C. + +Once you have a reference, you can use the following macro to dereference +the reference: + + SvRV(SV*) + +then call the appropriate routines, casting the returned C to either an +C or C, if required. + +To determine if an SV is a reference, you can use the following macro: + + SvROK(SV*) + +To discover what type of value the reference refers to, use the following +macro and then check the return value. + + SvTYPE(SvRV(SV*)) + +The most useful types that will be returned are: + + SVt_IV Scalar + SVt_NV Scalar + SVt_PV Scalar + SVt_RV Scalar + SVt_PVAV Array + SVt_PVHV Hash + SVt_PVCV Code + SVt_PVGV Glob (possible a file handle) + SVt_PVMG Blessed or Magical Scalar + + See the sv.h header file for more details. + +=head2 Blessed References and Class Objects + +References are also used to support object-oriented programming. In the +OO lexicon, an object is simply a reference that has been blessed into a +package (or class). Once blessed, the programmer may now use the reference +to access the various methods in the class. + +A reference can be blessed into a package with the following function: + + SV* sv_bless(SV* sv, HV* stash); + +The C argument must be a reference. The C argument specifies +which class the reference will belong to. See +L for information on converting class names into stashes. + +/* Still under construction */ + +Upgrades rv to reference if not already one. Creates new SV for rv to +point to. If C is non-null, the SV is blessed into the specified +class. SV is returned. + + SV* newSVrv(SV* rv, char* classname); + +Copies integer or double into an SV whose reference is C. SV is blessed +if C is non-null. + + SV* sv_setref_iv(SV* rv, char* classname, IV iv); + SV* sv_setref_nv(SV* rv, char* classname, NV iv); + +Copies the pointer value (I) into an SV whose +reference is rv. SV is blessed if C is non-null. + + SV* sv_setref_pv(SV* rv, char* classname, PV iv); + +Copies string into an SV whose reference is C. Set length to 0 to let +Perl calculate the string length. SV is blessed if C is non-null. + + SV* sv_setref_pvn(SV* rv, char* classname, PV iv, int length); + +Tests whether the SV is blessed into the specified class. It does not +check inheritance relationships. + + int sv_isa(SV* sv, char* name); + +Tests whether the SV is a reference to a blessed object. + + int sv_isobject(SV* sv); + +Tests whether the SV is derived from the specified class. SV can be either +a reference to a blessed object or a string containing a class name. This +is the function implementing the C functionality. + + bool sv_derived_from(SV* sv, char* name); + +To check if you've got an object derived from a specific class you have +to write: + + if (sv_isobject(sv) && sv_derived_from(sv, class)) { ... } + +=head2 Creating New Variables + +To create a new Perl variable with an undef value which can be accessed from +your Perl script, use the following routines, depending on the variable type. + + SV* perl_get_sv("package::varname", TRUE); + AV* perl_get_av("package::varname", TRUE); + HV* perl_get_hv("package::varname", TRUE); + +Notice the use of TRUE as the second parameter. The new variable can now +be set, using the routines appropriate to the data type. + +There are additional macros whose values may be bitwise OR'ed with the +C argument to enable certain extra features. Those bits are: + + GV_ADDMULTI Marks the variable as multiply defined, thus preventing the + "Name used only once: possible typo" warning. + GV_ADDWARN Issues the warning "Had to create unexpectedly" if + the variable did not exist before the function was called. + +If you do not specify a package name, the variable is created in the current +package. + +=head2 Reference Counts and Mortality + +Perl uses an reference count-driven garbage collection mechanism. SVs, +AVs, or HVs (xV for short in the following) start their life with a +reference count of 1. If the reference count of an xV ever drops to 0, +then it will be destroyed and its memory made available for reuse. + +This normally doesn't happen at the Perl level unless a variable is +undef'ed or the last variable holding a reference to it is changed or +overwritten. At the internal level, however, reference counts can be +manipulated with the following macros: + + int SvREFCNT(SV* sv); + SV* SvREFCNT_inc(SV* sv); + void SvREFCNT_dec(SV* sv); + +However, there is one other function which manipulates the reference +count of its argument. The C function, you will recall, +creates a reference to the specified argument. As a side effect, +it increments the argument's reference count. If this is not what +you want, use C instead. + +For example, imagine you want to return a reference from an XSUB function. +Inside the XSUB routine, you create an SV which initially has a reference +count of one. Then you call C, passing it the just-created SV. +This returns the reference as a new SV, but the reference count of the +SV you passed to C has been incremented to two. Now you +return the reference from the XSUB routine and forget about the SV. +But Perl hasn't! Whenever the returned reference is destroyed, the +reference count of the original SV is decreased to one and nothing happens. +The SV will hang around without any way to access it until Perl itself +terminates. This is a memory leak. + +The correct procedure, then, is to use C instead of +C. Then, if and when the last reference is destroyed, +the reference count of the SV will go to zero and it will be destroyed, +stopping any memory leak. + +There are some convenience functions available that can help with the +destruction of xVs. These functions introduce the concept of "mortality". +An xV that is mortal has had its reference count marked to be decremented, +but not actually decremented, until "a short time later". Generally the +term "short time later" means a single Perl statement, such as a call to +an XSUB function. The actual determinant for when mortal xVs have their +reference count decremented depends on two macros, SAVETMPS and FREETMPS. +See L and L for more details on these macros. + +"Mortalization" then is at its simplest a deferred C. +However, if you mortalize a variable twice, the reference count will +later be decremented twice. + +You should be careful about creating mortal variables. Strange things +can happen if you make the same value mortal within multiple contexts, +or if you make a variable mortal multiple times. + +To create a mortal variable, use the functions: + + SV* sv_newmortal() + SV* sv_2mortal(SV*) + SV* sv_mortalcopy(SV*) + +The first call creates a mortal SV, the second converts an existing +SV to a mortal SV (and thus defers a call to C), and the +third creates a mortal copy of an existing SV. + +The mortal routines are not just for SVs -- AVs and HVs can be +made mortal by passing their address (type-casted to C) to the +C or C routines. + +=head2 Stashes and Globs + +A "stash" is a hash that contains all of the different objects that +are contained within a package. Each key of the stash is a symbol +name (shared by all the different types of objects that have the same +name), and each value in the hash table is a GV (Glob Value). This GV +in turn contains references to the various objects of that name, +including (but not limited to) the following: + + Scalar Value + Array Value + Hash Value + I/O Handle + Format + Subroutine + +There is a single stash called "PL_defstash" that holds the items that exist +in the "main" package. To get at the items in other packages, append the +string "::" to the package name. The items in the "Foo" package are in +the stash "Foo::" in PL_defstash. The items in the "Bar::Baz" package are +in the stash "Baz::" in "Bar::"'s stash. + +To get the stash pointer for a particular package, use the function: + + HV* gv_stashpv(char* name, I32 create) + HV* gv_stashsv(SV*, I32 create) + +The first function takes a literal string, the second uses the string stored +in the SV. Remember that a stash is just a hash table, so you get back an +C. The C flag will create a new package if it is set. + +The name that C wants is the name of the package whose symbol table +you want. The default package is called C
    . If you have multiply nested +packages, pass their names to C, separated by C<::> as in the Perl +language itself. + +Alternately, if you have an SV that is a blessed reference, you can find +out the stash pointer by using: + + HV* SvSTASH(SvRV(SV*)); + +then use the following to get the package name itself: + + char* HvNAME(HV* stash); + +If you need to bless or re-bless an object you can use the following +function: + + SV* sv_bless(SV*, HV* stash) + +where the first argument, an C, must be a reference, and the second +argument is a stash. The returned C can now be used in the same way +as any other SV. + +For more information on references and blessings, consult L. + +=head2 Double-Typed SVs + +Scalar variables normally contain only one type of value, an integer, +double, pointer, or reference. Perl will automatically convert the +actual scalar data from the stored type into the requested type. + +Some scalar variables contain more than one type of scalar data. For +example, the variable C<$!> contains either the numeric value of C +or its string equivalent from either C or C. + +To force multiple data values into an SV, you must do two things: use the +C routines to add the additional scalar type, then set a flag +so that Perl will believe it contains more than one type of data. The +four macros to set the flags are: + + SvIOK_on + SvNOK_on + SvPOK_on + SvROK_on + +The particular macro you must use depends on which C routine +you called first. This is because every C routine turns on +only the bit for the particular type of data being set, and turns off +all the rest. + +For example, to create a new Perl variable called "dberror" that contains +both the numeric and descriptive string error values, you could use the +following code: + + extern int dberror; + extern char *dberror_list; + + SV* sv = perl_get_sv("dberror", TRUE); + sv_setiv(sv, (IV) dberror); + sv_setpv(sv, dberror_list[dberror]); + SvIOK_on(sv); + +If the order of C and C had been reversed, then the +macro C would need to be called instead of C. + +=head2 Magic Variables + +[This section still under construction. Ignore everything here. Post no +bills. Everything not permitted is forbidden.] + +Any SV may be magical, that is, it has special features that a normal +SV does not have. These features are stored in the SV structure in a +linked list of C's, typedef'ed to C. + + struct magic { + MAGIC* mg_moremagic; + MGVTBL* mg_virtual; + U16 mg_private; + char mg_type; + U8 mg_flags; + SV* mg_obj; + char* mg_ptr; + I32 mg_len; + }; + +Note this is current as of patchlevel 0, and could change at any time. + +=head2 Assigning Magic + +Perl adds magic to an SV using the sv_magic function: + + void sv_magic(SV* sv, SV* obj, int how, char* name, I32 namlen); + +The C argument is a pointer to the SV that is to acquire a new magical +feature. + +If C is not already magical, Perl uses the C macro to +set the C flag for the C. Perl then continues by adding +it to the beginning of the linked list of magical features. Any prior +entry of the same type of magic is deleted. Note that this can be +overridden, and multiple instances of the same type of magic can be +associated with an SV. + +The C and C arguments are used to associate a string with +the magic, typically the name of a variable. C is stored in the +C field and if C is non-null and C >= 0 a malloc'd +copy of the name is stored in C field. + +The sv_magic function uses C to determine which, if any, predefined +"Magic Virtual Table" should be assigned to the C field. +See the "Magic Virtual Table" section below. The C argument is also +stored in the C field. + +The C argument is stored in the C field of the C +structure. If it is not the same as the C argument, the reference +count of the C object is incremented. If it is the same, or if +the C argument is "#", or if it is a NULL pointer, then C is +merely stored, without the reference count being incremented. + +There is also a function to add magic to an C: + + void hv_magic(HV *hv, GV *gv, int how); + +This simply calls C and coerces the C argument into an C. + +To remove the magic from an SV, call the function sv_unmagic: + + void sv_unmagic(SV *sv, int type); + +The C argument should be equal to the C value when the C +was initially made magical. + +=head2 Magic Virtual Tables + +The C field in the C structure is a pointer to a +C, which is a structure of function pointers and stands for +"Magic Virtual Table" to handle the various operations that might be +applied to that variable. + +The C has five pointers to the following routine types: + + int (*svt_get)(SV* sv, MAGIC* mg); + int (*svt_set)(SV* sv, MAGIC* mg); + U32 (*svt_len)(SV* sv, MAGIC* mg); + int (*svt_clear)(SV* sv, MAGIC* mg); + int (*svt_free)(SV* sv, MAGIC* mg); + +This MGVTBL structure is set at compile-time in C and there are +currently 19 types (or 21 with overloading turned on). These different +structures contain pointers to various routines that perform additional +actions depending on which function is being called. + + Function pointer Action taken + ---------------- ------------ + svt_get Do something after the value of the SV is retrieved. + svt_set Do something after the SV is assigned a value. + svt_len Report on the SV's length. + svt_clear Clear something the SV represents. + svt_free Free any extra storage associated with the SV. + +For instance, the MGVTBL structure called C (which corresponds +to an C of '\0') contains: + + { magic_get, magic_set, magic_len, 0, 0 } + +Thus, when an SV is determined to be magical and of type '\0', if a get +operation is being performed, the routine C is called. All +the various routines for the various magical types begin with C. + +The current kinds of Magic Virtual Tables are: + + mg_type MGVTBL Type of magic + ------- ------ ---------------------------- + \0 vtbl_sv Special scalar variable + A vtbl_amagic %OVERLOAD hash + a vtbl_amagicelem %OVERLOAD hash element + c (none) Holds overload table (AMT) on stash + B vtbl_bm Boyer-Moore (fast string search) + E vtbl_env %ENV hash + e vtbl_envelem %ENV hash element + f vtbl_fm Formline ('compiled' format) + g vtbl_mglob m//g target / study()ed string + I vtbl_isa @ISA array + i vtbl_isaelem @ISA array element + k vtbl_nkeys scalar(keys()) lvalue + L (none) Debugger %_'s +C field points to a C structure: + + struct ufuncs { + I32 (*uf_val)(IV, SV*); + I32 (*uf_set)(IV, SV*); + IV uf_index; + }; + +When the SV is read from or written to, the C or C +function will be called with C as the first arg and a +pointer to the SV as the second. + +Note that because multiple extensions may be using '~' or 'U' magic, +it is important for extensions to take extra care to avoid conflict. +Typically only using the magic on objects blessed into the same class +as the extension is sufficient. For '~' magic, it may also be +appropriate to add an I32 'signature' at the top of the private data +area and check that. + +Also note that the C and C functions described +earlier do B invoke 'set' magic on their targets. This must +be done by the user either by calling the C macro after +calling these functions, or by using one of the C or +C functions. Similarly, generic C code must call the +C macro to invoke any 'get' magic if they use an SV +obtained from external sources in functions that don't handle magic. +L later in this document identifies such functions. +For example, calls to the C functions typically need to be +followed by C, but they don't need a prior C +since their implementation handles 'get' magic. + +=head2 Finding Magic + + MAGIC* mg_find(SV*, int type); /* Finds the magic pointer of that type */ + +This routine returns a pointer to the C structure stored in the SV. +If the SV does not have that magical feature, C is returned. Also, +if the SV is not of type SVt_PVMG, Perl may core dump. + + int mg_copy(SV* sv, SV* nsv, char* key, STRLEN klen); + +This routine checks to see what types of magic C has. If the mg_type +field is an uppercase letter, then the mg_obj is copied to C, but +the mg_type field is changed to be the lowercase letter. + +=head2 Understanding the Magic of Tied Hashes and Arrays + +Tied hashes and arrays are magical beasts of the 'P' magic type. + +WARNING: As of the 5.004 release, proper usage of the array and hash +access functions requires understanding a few caveats. Some +of these caveats are actually considered bugs in the API, to be fixed +in later releases, and are bracketed with [MAYCHANGE] below. If +you find yourself actually applying such information in this section, be +aware that the behavior may change in the future, umm, without warning. + +The C function, when given a tied array argument, merely +copies the magic of the array onto the value to be "stored", using +C. It may also return NULL, indicating that the value did not +actually need to be stored in the array. [MAYCHANGE] After a call to +C on a tied array, the caller will usually need to call +C to actually invoke the perl level "STORE" method on the +TIEARRAY object. If C did return NULL, a call to +C will also be usually necessary to avoid a memory +leak. [/MAYCHANGE] + +The previous paragraph is applicable verbatim to tied hash access using the +C and C functions as well. + +C and the corresponding hash functions C and +C actually return an undefined mortal value whose magic +has been initialized using C. Note the value so returned does not +need to be deallocated, as it is already mortal. [MAYCHANGE] But you will +need to call C on the returned value in order to actually invoke +the perl level "FETCH" method on the underlying TIE object. Similarly, +you may also call C on the return value after possibly assigning +a suitable value to it using C, which will invoke the "STORE" +method on the TIE object. [/MAYCHANGE] + +[MAYCHANGE] +In other words, the array or hash fetch/store functions don't really +fetch and store actual values in the case of tied arrays and hashes. They +merely call C to attach magic to the values that were meant to be +"stored" or "fetched". Later calls to C and C actually +do the job of invoking the TIE methods on the underlying objects. Thus +the magic mechanism currently implements a kind of lazy access to arrays +and hashes. + +Currently (as of perl version 5.004), use of the hash and array access +functions requires the user to be aware of whether they are operating on +"normal" hashes and arrays, or on their tied variants. The API may be +changed to provide more transparent access to both tied and normal data +types in future versions. +[/MAYCHANGE] + +You would do well to understand that the TIEARRAY and TIEHASH interfaces +are mere sugar to invoke some perl method calls while using the uniform hash +and array syntax. The use of this sugar imposes some overhead (typically +about two to four extra opcodes per FETCH/STORE operation, in addition to +the creation of all the mortal variables required to invoke the methods). +This overhead will be comparatively small if the TIE methods are themselves +substantial, but if they are only a few statements long, the overhead +will not be insignificant. + +=head2 Localizing changes + +Perl has a very handy construction + + { + local $var = 2; + ... + } + +This construction is I equivalent to + + { + my $oldvar = $var; + $var = 2; + ... + $var = $oldvar; + } + +The biggest difference is that the first construction would +reinstate the initial value of $var, irrespective of how control exits +the block: C, C, C/C etc. It is a little bit +more efficient as well. + +There is a way to achieve a similar task from C via Perl API: create a +I, and arrange for some changes to be automatically +undone at the end of it, either explicit, or via a non-local exit (via +die()). A I-like construct is created by a pair of +C/C macros (see L). Such a construct may be created specially for some +important localized task, or an existing one (like boundaries of +enclosing Perl subroutine/block, or an existing pair for freeing TMPs) +may be used. (In the second case the overhead of additional +localization must be almost negligible.) Note that any XSUB is +automatically enclosed in an C/C pair. + +Inside such a I the following service is available: + +=over + +=item C + +=item C + +=item C + +=item C + +These macros arrange things to restore the value of integer variable +C at the end of enclosing I. + +=item C + +=item C + +These macros arrange things to restore the value of pointers C and +C

    . C must be a pointer of a type which survives conversion to +C and back, C

    should be able to survive conversion to C +and back. + +=item C + +The refcount of C would be decremented at the end of +I. This is similar to C, which should (?) be +used instead. + +=item C + +The C is op_free()ed at the end of I. + +=item C + +The chunk of memory which is pointed to by C

    is Safefree()ed at the +end of I. + +=item C + +Clears a slot in the current scratchpad which corresponds to C at +the end of I. + +=item C + +The key C of C is deleted at the end of I. The +string pointed to by C is Safefree()ed. If one has a I in +short-lived storage, the corresponding string may be reallocated like +this: + + SAVEDELETE(PL_defstash, savepv(tmpbuf), strlen(tmpbuf)); + +=item C + +At the end of I the function C is called with the +only argument (of type C) C

    . + +=item C + +The current offset on the Perl internal stack (cf. C) is restored +at the end of I. + +=back + +The following API list contains functions, thus one needs to +provide pointers to the modifiable data explicitly (either C pointers, +or Perlish Cs). Where the above macros take C, a similar +function takes C. + +=over + +=item C + +Equivalent to Perl code C. + +=item C + +=item C + +Similar to C, but localize C<@gv> and C<%gv>. + +=item C + +Duplicates the current value of C, on the exit from the current +C/C I will restore the value of C +using the stored value. + +=item C + +A variant of C which takes multiple arguments via an array +C of C of length C. + +=item C + +Similar to C, but will reinstate a C. + +=item C + +=item C + +Similar to C, but localize C and C. + +=back + +The C module implements localization of the basic types within the +I. People who are interested in how to localize things in +the containing scope should take a look there too. + +=head1 Subroutines + +=head2 XSUBs and the Argument Stack + +The XSUB mechanism is a simple way for Perl programs to access C subroutines. +An XSUB routine will have a stack that contains the arguments from the Perl +program, and a way to map from the Perl data structures to a C equivalent. + +The stack arguments are accessible through the C macro, which returns +the C'th stack argument. Argument 0 is the first argument passed in the +Perl subroutine call. These arguments are C, and can be used anywhere +an C is used. + +Most of the time, output from the C routine can be handled through use of +the RETVAL and OUTPUT directives. However, there are some cases where the +argument stack is not already long enough to handle all the return values. +An example is the POSIX tzname() call, which takes no arguments, but returns +two, the local time zone's standard and summer time abbreviations. + +To handle this situation, the PPCODE directive is used and the stack is +extended using the macro: + + EXTEND(SP, num); + +where C is the macro that represents the local copy of the stack pointer, +and C is the number of elements the stack should be extended by. + +Now that there is room on the stack, values can be pushed on it using the +macros to push IVs, doubles, strings, and SV pointers respectively: + + PUSHi(IV) + PUSHn(double) + PUSHp(char*, I32) + PUSHs(SV*) + +And now the Perl program calling C, the two values will be assigned +as in: + + ($standard_abbrev, $summer_abbrev) = POSIX::tzname; + +An alternate (and possibly simpler) method to pushing values on the stack is +to use the macros: + + XPUSHi(IV) + XPUSHn(double) + XPUSHp(char*, I32) + XPUSHs(SV*) + +These macros automatically adjust the stack for you, if needed. Thus, you +do not need to call C to extend the stack. + +For more information, consult L and L. + +=head2 Calling Perl Routines from within C Programs + +There are four routines that can be used to call a Perl subroutine from +within a C program. These four are: + + I32 perl_call_sv(SV*, I32); + I32 perl_call_pv(char*, I32); + I32 perl_call_method(char*, I32); + I32 perl_call_argv(char*, I32, register char**); + +The routine most often used is C. The C argument +contains either the name of the Perl subroutine to be called, or a +reference to the subroutine. The second argument consists of flags +that control the context in which the subroutine is called, whether +or not the subroutine is being passed arguments, how errors should be +trapped, and how to treat return values. + +All four routines return the number of arguments that the subroutine returned +on the Perl stack. + +When using any of these routines (except C), the programmer +must manipulate the Perl stack. These include the following macros and +functions: + + dSP + SP + PUSHMARK() + PUTBACK + SPAGAIN + ENTER + SAVETMPS + FREETMPS + LEAVE + XPUSH*() + POP*() + +For a detailed description of calling conventions from C to Perl, +consult L. + +=head2 Memory Allocation + +It is suggested that you use the version of malloc that is distributed +with Perl. It keeps pools of various sizes of unallocated memory in +order to satisfy allocation requests more quickly. However, on some +platforms, it may cause spurious malloc or free errors. + + New(x, pointer, number, type); + Newc(x, pointer, number, type, cast); + Newz(x, pointer, number, type); + +These three macros are used to initially allocate memory. + +The first argument C was a "magic cookie" that was used to keep track +of who called the macro, to help when debugging memory problems. However, +the current code makes no use of this feature (most Perl developers now +use run-time memory checkers), so this argument can be any number. + +The second argument C should be the name of a variable that will +point to the newly allocated memory. + +The third and fourth arguments C and C specify how many of +the specified type of data structure should be allocated. The argument +C is passed to C. The final argument to C, C, +should be used if the C argument is different from the C +argument. + +Unlike the C and C macros, the C macro calls C +to zero out all the newly allocated memory. + + Renew(pointer, number, type); + Renewc(pointer, number, type, cast); + Safefree(pointer) + +These three macros are used to change a memory buffer size or to free a +piece of memory no longer needed. The arguments to C and C +match those of C and C with the exception of not needing the +"magic cookie" argument. + + Move(source, dest, number, type); + Copy(source, dest, number, type); + Zero(dest, number, type); + +These three macros are used to move, copy, or zero out previously allocated +memory. The C and C arguments point to the source and +destination starting points. Perl will move, copy, or zero out C +instances of the size of the C data structure (using the C +function). + +=head2 PerlIO + +The most recent development releases of Perl has been experimenting with +removing Perl's dependency on the "normal" standard I/O suite and allowing +other stdio implementations to be used. This involves creating a new +abstraction layer that then calls whichever implementation of stdio Perl +was compiled with. All XSUBs should now use the functions in the PerlIO +abstraction layer and not make any assumptions about what kind of stdio +is being used. + +For a complete description of the PerlIO abstraction, consult L. + +=head2 Putting a C value on Perl stack + +A lot of opcodes (this is an elementary operation in the internal perl +stack machine) put an SV* on the stack. However, as an optimization +the corresponding SV is (usually) not recreated each time. The opcodes +reuse specially assigned SVs (Is) which are (as a corollary) +not constantly freed/created. + +Each of the targets is created only once (but see +L below), and when an opcode needs to put +an integer, a double, or a string on stack, it just sets the +corresponding parts of its I and puts the I on stack. + +The macro to put this target on stack is C, and it is +directly used in some opcodes, as well as indirectly in zillions of +others, which use it via C<(X)PUSH[pni]>. + +=head2 Scratchpads + +The question remains on when the SVs which are Is for opcodes +are created. The answer is that they are created when the current unit -- +a subroutine or a file (for opcodes for statements outside of +subroutines) -- is compiled. During this time a special anonymous Perl +array is created, which is called a scratchpad for the current +unit. + +A scratchpad keeps SVs which are lexicals for the current unit and are +targets for opcodes. One can deduce that an SV lives on a scratchpad +by looking on its flags: lexicals have C set, and +Is have C set. + +The correspondence between OPs and Is is not 1-to-1. Different +OPs in the compile tree of the unit can use the same target, if this +would not conflict with the expected life of the temporary. + +=head2 Scratchpads and recursion + +In fact it is not 100% true that a compiled unit contains a pointer to +the scratchpad AV. In fact it contains a pointer to an AV of +(initially) one element, and this element is the scratchpad AV. Why do +we need an extra level of indirection? + +The answer is B, and maybe (sometime soon) B. Both +these can create several execution pointers going into the same +subroutine. For the subroutine-child not write over the temporaries +for the subroutine-parent (lifespan of which covers the call to the +child), the parent and the child should have different +scratchpads. (I the lexicals should be separate anyway!) + +So each subroutine is born with an array of scratchpads (of length 1). +On each entry to the subroutine it is checked that the current +depth of the recursion is not more than the length of this array, and +if it is, new scratchpad is created and pushed into the array. + +The Is on this scratchpad are Cs, but they are already +marked with correct flags. + +=head1 Compiled code + +=head2 Code tree + +Here we describe the internal form your code is converted to by +Perl. Start with a simple example: + + $a = $b + $c; + +This is converted to a tree similar to this one: + + assign-to + / \ + + $a + / \ + $b $c + +(but slightly more complicated). This tree reflects the way Perl +parsed your code, but has nothing to do with the execution order. +There is an additional "thread" going through the nodes of the tree +which shows the order of execution of the nodes. In our simplified +example above it looks like: + + $b ---> $c ---> + ---> $a ---> assign-to + +But with the actual compile tree for C<$a = $b + $c> it is different: +some nodes I. As a corollary, though the actual tree +contains more nodes than our simplified example, the execution order +is the same as in our example. + +=head2 Examining the tree + +If you have your perl compiled for debugging (usually done with C<-D +optimize=-g> on C command line), you may examine the +compiled tree by specifying C<-Dx> on the Perl command line. The +output takes several lines per node, and for C<$b+$c> it looks like +this: + + 5 TYPE = add ===> 6 + TARG = 1 + FLAGS = (SCALAR,KIDS) + { + TYPE = null ===> (4) + (was rv2sv) + FLAGS = (SCALAR,KIDS) + { + 3 TYPE = gvsv ===> 4 + FLAGS = (SCALAR) + GV = main::b + } + } + { + TYPE = null ===> (5) + (was rv2sv) + FLAGS = (SCALAR,KIDS) + { + 4 TYPE = gvsv ===> 5 + FLAGS = (SCALAR) + GV = main::c + } + } + +This tree has 5 nodes (one per C specifier), only 3 of them are +not optimized away (one per number in the left column). The immediate +children of the given node correspond to C<{}> pairs on the same level +of indentation, thus this listing corresponds to the tree: + + add + / \ + null null + | | + gvsv gvsv + +The execution order is indicated by C<===E> marks, thus it is C<3 +4 5 6> (node C<6> is not included into above listing), i.e., +C. + +=head2 Compile pass 1: check routines + +The tree is created by the I while yacc code feeds it +the constructions it recognizes. Since yacc works bottom-up, so does +the first pass of perl compilation. + +What makes this pass interesting for perl developers is that some +optimization may be performed on this pass. This is optimization by +so-called I. The correspondence between node names +and corresponding check routines is described in F (do not +forget to run C if you modify this file). + +A check routine is called when the node is fully constructed except +for the execution-order thread. Since at this time there are no +back-links to the currently constructed node, one can do most any +operation to the top-level node, including freeing it and/or creating +new nodes above/below it. + +The check routine returns the node which should be inserted into the +tree (if the top-level node was not modified, check routine returns +its argument). + +By convention, check routines have names C. They are usually +called from C subroutines (or C) (which in turn are +called from F). + +=head2 Compile pass 1a: constant folding + +Immediately after the check routine is called the returned node is +checked for being compile-time executable. If it is (the value is +judged to be constant) it is immediately executed, and a I +node with the "return value" of the corresponding subtree is +substituted instead. The subtree is deleted. + +If constant folding was not performed, the execution-order thread is +created. + +=head2 Compile pass 2: context propagation + +When a context for a part of compile tree is known, it is propagated +down through the tree. At this time the context can have 5 values +(instead of 2 for runtime context): void, boolean, scalar, list, and +lvalue. In contrast with the pass 1 this pass is processed from top +to bottom: a node's context determines the context for its children. + +Additional context-dependent optimizations are performed at this time. +Since at this moment the compile tree contains back-references (via +"thread" pointers), nodes cannot be free()d now. To allow +optimized-away nodes at this stage, such nodes are null()ified instead +of free()ing (i.e. their type is changed to OP_NULL). + +=head2 Compile pass 3: peephole optimization + +After the compile tree for a subroutine (or for an C or a file) +is created, an additional pass over the code is performed. This pass +is neither top-down or bottom-up, but in the execution order (with +additional complications for conditionals). These optimizations are +done in the subroutine peep(). Optimizations performed at this stage +are subject to the same restrictions as in the pass 2. + +=head1 API LISTING + +This is a listing of functions, macros, flags, and variables that may be +useful to extension writers or that may be found while reading other +extensions. + +Note that all Perl API global variables must be referenced with the C +prefix. Some macros are provided for compatibility with the older, +unadorned names, but this support will be removed in a future release. + +It is strongly recommended that all Perl API functions that don't begin +with C be referenced with an explicit C prefix. + +The sort order of the listing is case insensitive, with any +occurrences of '_' ignored for the the purpose of sorting. + +=over 8 + +=item av_clear + +Clears an array, making it empty. Does not free the memory used by the +array itself. + + void av_clear (AV* ar) + +=item av_extend + +Pre-extend an array. The C is the index to which the array should be +extended. + + void av_extend (AV* ar, I32 key) + +=item av_fetch + +Returns the SV at the specified index in the array. The C is the +index. If C is set then the fetch will be part of a store. Check +that the return value is non-null before dereferencing it to a C. + +See L for more +information on how to use this function on tied arrays. + + SV** av_fetch (AV* ar, I32 key, I32 lval) + +=item AvFILL + +Same as C. Deprecated, use C instead. + +=item av_len + +Returns the highest index in the array. Returns -1 if the array is empty. + + I32 av_len (AV* ar) + +=item av_make + +Creates a new AV and populates it with a list of SVs. The SVs are copied +into the array, so they may be freed after the call to av_make. The new AV +will have a reference count of 1. + + AV* av_make (I32 size, SV** svp) + +=item av_pop + +Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array is +empty. + + SV* av_pop (AV* ar) + +=item av_push + +Pushes an SV onto the end of the array. The array will grow automatically +to accommodate the addition. + + void av_push (AV* ar, SV* val) + +=item av_shift + +Shifts an SV off the beginning of the array. + + SV* av_shift (AV* ar) + +=item av_store + +Stores an SV in an array. The array index is specified as C. The +return value will be NULL if the operation failed or if the value did not +need to be actually stored within the array (as in the case of tied arrays). +Otherwise it can be dereferenced to get the original C. Note that the +caller is responsible for suitably incrementing the reference count of C +before the call, and decrementing it if the function returned NULL. + +See L for more +information on how to use this function on tied arrays. + + SV** av_store (AV* ar, I32 key, SV* val) + +=item av_undef + +Undefines the array. Frees the memory used by the array itself. + + void av_undef (AV* ar) + +=item av_unshift + +Unshift the given number of C values onto the beginning of the +array. The array will grow automatically to accommodate the addition. +You must then use C to assign values to these new elements. + + void av_unshift (AV* ar, I32 num) + +=item CLASS + +Variable which is setup by C to indicate the class name for a C++ XS +constructor. This is always a C. See C and +L. + +=item Copy + +The XSUB-writer's interface to the C C function. The C is the +source, C is the destination, C is the number of items, and C is +the type. May fail on overlapping copies. See also C. + + void Copy( s, d, n, t ) + +=item croak + +This is the XSUB-writer's interface to Perl's C function. Use this +function the same way you use the C C function. See C. + +=item CvSTASH + +Returns the stash of the CV. + + HV* CvSTASH( SV* sv ) + +=item PL_DBsingle + +When Perl is run in debugging mode, with the B<-d> switch, this SV is a +boolean which indicates whether subs are being single-stepped. +Single-stepping is automatically turned on after every step. This is the C +variable which corresponds to Perl's $DB::single variable. See C. + +=item PL_DBsub + +When Perl is run in debugging mode, with the B<-d> switch, this GV contains +the SV which holds the name of the sub being debugged. This is the C +variable which corresponds to Perl's $DB::sub variable. See C. +The sub name can be found by + + SvPV( GvSV( PL_DBsub ), PL_na ) + +=item PL_DBtrace + +Trace variable used when Perl is run in debugging mode, with the B<-d> +switch. This is the C variable which corresponds to Perl's $DB::trace +variable. See C. + +=item dMARK + +Declare a stack marker variable, C, for the XSUB. See C and +C. + +=item dORIGMARK + +Saves the original stack mark for the XSUB. See C. + +=item PL_dowarn + +The C variable which corresponds to Perl's $^W warning variable. + +=item dSP + +Declares a local copy of perl's stack pointer for the XSUB, available via +the C macro. See C. + +=item dXSARGS + +Sets up stack and mark pointers for an XSUB, calling dSP and dMARK. This is +usually handled automatically by C. Declares the C variable +to indicate the number of items on the stack. + +=item dXSI32 + +Sets up the C variable for an XSUB which has aliases. This is usually +handled automatically by C. + +=item do_binmode + +Switches filehandle to binmode. C is what C would +contain. + + do_binmode(fp, iotype, TRUE); + +=item ENTER + +Opening bracket on a callback. See C and L. + + ENTER; + +=item EXTEND + +Used to extend the argument stack for an XSUB's return values. + + EXTEND( sp, int x ) + +=item fbm_compile + +Analyses the string in order to make fast searches on it using fbm_instr() -- +the Boyer-Moore algorithm. + + void fbm_compile(SV* sv, U32 flags) + +=item fbm_instr + +Returns the location of the SV in the string delimited by C and +C. It returns C if the string can't be found. The +C does not have to be fbm_compiled, but the search will not be as +fast then. + + char* fbm_instr(char *str, char *strend, SV *sv, U32 flags) + +=item FREETMPS + +Closing bracket for temporaries on a callback. See C and +L. + + FREETMPS; + +=item G_ARRAY + +Used to indicate array context. See C, C and L. + +=item G_DISCARD + +Indicates that arguments returned from a callback should be discarded. See +L. + +=item G_EVAL + +Used to force a Perl C wrapper around a callback. See L. + +=item GIMME + +A backward-compatible version of C which can only return +C or C; in a void context, it returns C. + +=item GIMME_V + +The XSUB-writer's equivalent to Perl's C. Returns +C, C or C for void, scalar or array +context, respectively. + +=item G_NOARGS + +Indicates that no arguments are being sent to a callback. See L. + +=item G_SCALAR + +Used to indicate scalar context. See C, C, and L. + +=item gv_fetchmeth + +Returns the glob with the given C and a defined subroutine or +C. The glob lives in the given C, or in the stashes +accessible via @ISA and @UNIVERSAL. + +The argument C should be either 0 or -1. If C, as a +side-effect creates a glob with the given C in the given +C which in the case of success contains an alias for the +subroutine, and sets up caching info for this glob. Similarly for all +the searched stashes. + +This function grants C<"SUPER"> token as a postfix of the stash name. + +The GV returned from C may be a method cache entry, +which is not visible to Perl code. So when calling C, +you should not use the GV directly; instead, you should use the +method's CV, which can be obtained from the GV with the C macro. + + GV* gv_fetchmeth (HV* stash, char* name, STRLEN len, I32 level) + +=item gv_fetchmethod + +=item gv_fetchmethod_autoload + +Returns the glob which contains the subroutine to call to invoke the +method on the C. In fact in the presense of autoloading this may +be the glob for "AUTOLOAD". In this case the corresponding variable +$AUTOLOAD is already setup. + +The third parameter of C determines whether AUTOLOAD +lookup is performed if the given method is not present: non-zero means +yes, look for AUTOLOAD; zero means no, don't look for AUTOLOAD. Calling +C is equivalent to calling C with a +non-zero C parameter. + +These functions grant C<"SUPER"> token as a prefix of the method name. + +Note that if you want to keep the returned glob for a long time, you +need to check for it being "AUTOLOAD", since at the later time the call +may load a different subroutine due to $AUTOLOAD changing its value. +Use the glob created via a side effect to do this. + +These functions have the same side-effects and as C with +C. C should be writable if contains C<':'> or C<'\''>. +The warning against passing the GV returned by C to +C apply equally to these functions. + + GV* gv_fetchmethod (HV* stash, char* name) + GV* gv_fetchmethod_autoload (HV* stash, char* name, I32 autoload) + +=item G_VOID + +Used to indicate void context. See C and L. + +=item gv_stashpv + +Returns a pointer to the stash for a specified package. If C is set +then the package will be created if it does not already exist. If C +is not set and the package does not exist then NULL is returned. + + HV* gv_stashpv (char* name, I32 create) + +=item gv_stashsv + +Returns a pointer to the stash for a specified package. See C. + + HV* gv_stashsv (SV* sv, I32 create) + +=item GvSV + +Return the SV from the GV. + +=item HEf_SVKEY + +This flag, used in the length slot of hash entries and magic +structures, specifies the structure contains a C pointer where a +C pointer is to be expected. (For information only--not to be used). + +=item HeHASH + +Returns the computed hash stored in the hash entry. + + U32 HeHASH(HE* he) + +=item HeKEY + +Returns the actual pointer stored in the key slot of the hash entry. +The pointer may be either C or C, depending on the value of +C. Can be assigned to. The C or C macros +are usually preferable for finding the value of a key. + + char* HeKEY(HE* he) + +=item HeKLEN + +If this is negative, and amounts to C, it indicates the entry +holds an C key. Otherwise, holds the actual length of the key. +Can be assigned to. The C macro is usually preferable for finding +key lengths. + + int HeKLEN(HE* he) + +=item HePV + +Returns the key slot of the hash entry as a C value, doing any +necessary dereferencing of possibly C keys. The length of +the string is placed in C (this is a macro, so do I use +C<&len>). If you do not care about what the length of the key is, +you may use the global variable C. Remember though, that hash +keys in perl are free to contain embedded nulls, so using C +or similar is not a good way to find the length of hash keys. +This is very similar to the C macro described elsewhere in +this document. + + char* HePV(HE* he, STRLEN len) + +=item HeSVKEY + +Returns the key as an C, or C if the hash entry +does not contain an C key. + + HeSVKEY(HE* he) + +=item HeSVKEY_force + +Returns the key as an C. Will create and return a temporary +mortal C if the hash entry contains only a C key. + + HeSVKEY_force(HE* he) + +=item HeSVKEY_set + +Sets the key to a given C, taking care to set the appropriate flags +to indicate the presence of an C key, and returns the same C. + + HeSVKEY_set(HE* he, SV* sv) + +=item HeVAL + +Returns the value slot (type C) stored in the hash entry. + + HeVAL(HE* he) + +=item hv_clear + +Clears a hash, making it empty. + + void hv_clear (HV* tb) + +=item hv_delayfree_ent + +Releases a hash entry, such as while iterating though the hash, but +delays actual freeing of key and value until the end of the current +statement (or thereabouts) with C. See C +and C. + + void hv_delayfree_ent (HV* hv, HE* entry) + +=item hv_delete + +Deletes a key/value pair in the hash. The value SV is removed from the hash +and returned to the caller. The C is the length of the key. The +C value will normally be zero; if set to G_DISCARD then NULL will be +returned. + + SV* hv_delete (HV* tb, char* key, U32 klen, I32 flags) + +=item hv_delete_ent + +Deletes a key/value pair in the hash. The value SV is removed from the hash +and returned to the caller. The C value will normally be zero; if set +to G_DISCARD then NULL will be returned. C can be a valid precomputed +hash value, or 0 to ask for it to be computed. + + SV* hv_delete_ent (HV* tb, SV* key, I32 flags, U32 hash) + +=item hv_exists + +Returns a boolean indicating whether the specified hash key exists. The +C is the length of the key. + + bool hv_exists (HV* tb, char* key, U32 klen) + +=item hv_exists_ent + +Returns a boolean indicating whether the specified hash key exists. C +can be a valid precomputed hash value, or 0 to ask for it to be computed. + + bool hv_exists_ent (HV* tb, SV* key, U32 hash) + +=item hv_fetch + +Returns the SV which corresponds to the specified key in the hash. The +C is the length of the key. If C is set then the fetch will be +part of a store. Check that the return value is non-null before +dereferencing it to a C. + +See L for more +information on how to use this function on tied hashes. + + SV** hv_fetch (HV* tb, char* key, U32 klen, I32 lval) + +=item hv_fetch_ent + +Returns the hash entry which corresponds to the specified key in the hash. +C must be a valid precomputed hash number for the given C, or +0 if you want the function to compute it. IF C is set then the +fetch will be part of a store. Make sure the return value is non-null +before accessing it. The return value when C is a tied hash +is a pointer to a static location, so be sure to make a copy of the +structure if you need to store it somewhere. + +See L for more +information on how to use this function on tied hashes. + + HE* hv_fetch_ent (HV* tb, SV* key, I32 lval, U32 hash) + +=item hv_free_ent + +Releases a hash entry, such as while iterating though the hash. See +C and C. + + void hv_free_ent (HV* hv, HE* entry) + +=item hv_iterinit + +Prepares a starting point to traverse a hash table. + + I32 hv_iterinit (HV* tb) + +Returns the number of keys in the hash (i.e. the same as C). +The return value is currently only meaningful for hashes without tie +magic. + +NOTE: Before version 5.004_65, C used to return the number +of hash buckets that happen to be in use. If you still need that +esoteric value, you can get it through the macro C. + +=item hv_iterkey + +Returns the key from the current position of the hash iterator. See +C. + + char* hv_iterkey (HE* entry, I32* retlen) + +=item hv_iterkeysv + +Returns the key as an C from the current position of the hash +iterator. The return value will always be a mortal copy of the +key. Also see C. + + SV* hv_iterkeysv (HE* entry) + +=item hv_iternext + +Returns entries from a hash iterator. See C. + + HE* hv_iternext (HV* tb) + +=item hv_iternextsv + +Performs an C, C, and C in one +operation. + + SV* hv_iternextsv (HV* hv, char** key, I32* retlen) + +=item hv_iterval + +Returns the value from the current position of the hash iterator. See +C. + + SV* hv_iterval (HV* tb, HE* entry) + +=item hv_magic + +Adds magic to a hash. See C. + + void hv_magic (HV* hv, GV* gv, int how) + +=item HvNAME + +Returns the package name of a stash. See C, C. + + char* HvNAME (HV* stash) + +=item hv_store + +Stores an SV in a hash. The hash key is specified as C and C is +the length of the key. The C parameter is the precomputed hash +value; if it is zero then Perl will compute it. The return value will be +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise it can +be dereferenced to get the original C. Note that the caller is +responsible for suitably incrementing the reference count of C +before the call, and decrementing it if the function returned NULL. + +See L for more +information on how to use this function on tied hashes. + + SV** hv_store (HV* tb, char* key, U32 klen, SV* val, U32 hash) + +=item hv_store_ent + +Stores C in a hash. The hash key is specified as C. The C +parameter is the precomputed hash value; if it is zero then Perl will +compute it. The return value is the new hash entry so created. It will be +NULL if the operation failed or if the value did not need to be actually +stored within the hash (as in the case of tied hashes). Otherwise the +contents of the return value can be accessed using the C macros +described here. Note that the caller is responsible for suitably +incrementing the reference count of C before the call, and decrementing +it if the function returned NULL. + +See L for more +information on how to use this function on tied hashes. + + HE* hv_store_ent (HV* tb, SV* key, SV* val, U32 hash) + +=item hv_undef + +Undefines the hash. + + void hv_undef (HV* tb) + +=item isALNUM + +Returns a boolean indicating whether the C C is an ascii alphanumeric +character or digit. + + int isALNUM (char c) + +=item isALPHA + +Returns a boolean indicating whether the C C is an ascii alphabetic +character. + + int isALPHA (char c) + +=item isDIGIT + +Returns a boolean indicating whether the C C is an ascii digit. + + int isDIGIT (char c) + +=item isLOWER + +Returns a boolean indicating whether the C C is a lowercase character. + + int isLOWER (char c) + +=item isSPACE + +Returns a boolean indicating whether the C C is whitespace. + + int isSPACE (char c) + +=item isUPPER + +Returns a boolean indicating whether the C C is an uppercase character. + + int isUPPER (char c) + +=item items + +Variable which is setup by C to indicate the number of items on the +stack. See L. + +=item ix + +Variable which is setup by C to indicate which of an XSUB's aliases +was used to invoke it. See L. + +=item LEAVE + +Closing bracket on a callback. See C and L. + + LEAVE; + +=item looks_like_number + +Test if an the content of an SV looks like a number (or is a number). + + int looks_like_number(SV*) + + +=item MARK + +Stack marker variable for the XSUB. See C. + +=item mg_clear + +Clear something magical that the SV represents. See C. + + int mg_clear (SV* sv) + +=item mg_copy + +Copies the magic from one SV to another. See C. + + int mg_copy (SV *, SV *, char *, STRLEN) + +=item mg_find + +Finds the magic pointer for type matching the SV. See C. + + MAGIC* mg_find (SV* sv, int type) + +=item mg_free + +Free any magic storage used by the SV. See C. + + int mg_free (SV* sv) + +=item mg_get + +Do magic after a value is retrieved from the SV. See C. + + int mg_get (SV* sv) + +=item mg_len + +Report on the SV's length. See C. + + U32 mg_len (SV* sv) + +=item mg_magical + +Turns on the magical status of an SV. See C. + + void mg_magical (SV* sv) + +=item mg_set + +Do magic after a value is assigned to the SV. See C. + + int mg_set (SV* sv) + +=item Move + +The XSUB-writer's interface to the C C function. The C is the +source, C is the destination, C is the number of items, and C is +the type. Can do overlapping moves. See also C. + + void Move( s, d, n, t ) + +=item PL_na + +A variable which may be used with C to tell Perl to calculate the +string length. + +=item New + +The XSUB-writer's interface to the C C function. + + void* New( x, void *ptr, int size, type ) + +=item newAV + +Creates a new AV. The reference count is set to 1. + + AV* newAV (void) + +=item Newc + +The XSUB-writer's interface to the C C function, with cast. + + void* Newc( x, void *ptr, int size, type, cast ) + +=item newCONSTSUB + +Creates a constant sub equivalent to Perl C +which is eligible for inlining at compile-time. + + void newCONSTSUB(HV* stash, char* name, SV* sv) + +=item newHV + +Creates a new HV. The reference count is set to 1. + + HV* newHV (void) + +=item newRV_inc + +Creates an RV wrapper for an SV. The reference count for the original SV is +incremented. + + SV* newRV_inc (SV* ref) + +For historical reasons, "newRV" is a synonym for "newRV_inc". + +=item newRV_noinc + +Creates an RV wrapper for an SV. The reference count for the original +SV is B incremented. + + SV* newRV_noinc (SV* ref) + +=item NEWSV + +Creates a new SV. A non-zero C parameter indicates the number of +bytes of preallocated string space the SV should have. An extra byte +for a tailing NUL is also reserved. (SvPOK is not set for the SV even +if string space is allocated.) The reference count for the new SV is +set to 1. C is an integer id between 0 and 1299 (used to identify +leaks). + + SV* NEWSV (int id, STRLEN len) + +=item newSViv + +Creates a new SV and copies an integer into it. The reference count for the +SV is set to 1. + + SV* newSViv (IV i) + +=item newSVnv + +Creates a new SV and copies a double into it. The reference count for the +SV is set to 1. + + SV* newSVnv (NV i) + +=item newSVpv + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. If C is zero then Perl will compute the length. + + SV* newSVpv (char* s, STRLEN len) + +=item newSVpvf + +Creates a new SV an initialize it with the string formatted like +C. + + SV* newSVpvf(const char* pat, ...); + +=item newSVpvn + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. If C is zero then Perl will create a zero length +string. + + SV* newSVpvn (char* s, STRLEN len) + +=item newSVrv + +Creates a new SV for the RV, C, to point to. If C is not an RV then +it will be upgraded to one. If C is non-null then the new SV will +be blessed in the specified package. The new SV is returned and its +reference count is 1. + + SV* newSVrv (SV* rv, char* classname) + +=item newSVsv + +Creates a new SV which is an exact duplicate of the original SV. + + SV* newSVsv (SV* old) + +=item newXS + +Used by C to hook up XSUBs as Perl subs. + +=item newXSproto + +Used by C to hook up XSUBs as Perl subs. Adds Perl prototypes to +the subs. + +=item Newz + +The XSUB-writer's interface to the C C function. The allocated +memory is zeroed with C. + + void* Newz( x, void *ptr, int size, type ) + +=item Nullav + +Null AV pointer. + +=item Nullch + +Null character pointer. + +=item Nullcv + +Null CV pointer. + +=item Nullhv + +Null HV pointer. + +=item Nullsv + +Null SV pointer. + +=item ORIGMARK + +The original stack mark for the XSUB. See C. + +=item perl_alloc + +Allocates a new Perl interpreter. See L. + +=item perl_call_argv + +Performs a callback to the specified Perl sub. See L. + + I32 perl_call_argv (char* subname, I32 flags, char** argv) + +=item perl_call_method + +Performs a callback to the specified Perl method. The blessed object must +be on the stack. See L. + + I32 perl_call_method (char* methname, I32 flags) + +=item perl_call_pv + +Performs a callback to the specified Perl sub. See L. + + I32 perl_call_pv (char* subname, I32 flags) + +=item perl_call_sv + +Performs a callback to the Perl sub whose name is in the SV. See +L. + + I32 perl_call_sv (SV* sv, I32 flags) + +=item perl_construct + +Initializes a new Perl interpreter. See L. + +=item perl_destruct + +Shuts down a Perl interpreter. See L. + +=item perl_eval_sv + +Tells Perl to C the string in the SV. + + I32 perl_eval_sv (SV* sv, I32 flags) + +=item perl_eval_pv + +Tells Perl to C the given string and return an SV* result. + + SV* perl_eval_pv (char* p, I32 croak_on_error) + +=item perl_free + +Releases a Perl interpreter. See L. + +=item perl_get_av + +Returns the AV of the specified Perl array. If C is set and the +Perl variable does not exist then it will be created. If C is not +set and the variable does not exist then NULL is returned. + + AV* perl_get_av (char* name, I32 create) + +=item perl_get_cv + +Returns the CV of the specified Perl sub. If C is set and the Perl +variable does not exist then it will be created. If C is not +set and the variable does not exist then NULL is returned. + + CV* perl_get_cv (char* name, I32 create) + +=item perl_get_hv + +Returns the HV of the specified Perl hash. If C is set and the Perl +variable does not exist then it will be created. If C is not +set and the variable does not exist then NULL is returned. + + HV* perl_get_hv (char* name, I32 create) + +=item perl_get_sv + +Returns the SV of the specified Perl scalar. If C is set and the +Perl variable does not exist then it will be created. If C is not +set and the variable does not exist then NULL is returned. + + SV* perl_get_sv (char* name, I32 create) + +=item perl_parse + +Tells a Perl interpreter to parse a Perl script. See L. + +=item perl_require_pv + +Tells Perl to C a module. + + void perl_require_pv (char* pv) + +=item perl_run + +Tells a Perl interpreter to run. See L. + +=item POPi + +Pops an integer off the stack. + + int POPi() + +=item POPl + +Pops a long off the stack. + + long POPl() + +=item POPp + +Pops a string off the stack. + + char* POPp() + +=item POPn + +Pops a double off the stack. + + double POPn() + +=item POPs + +Pops an SV off the stack. + + SV* POPs() + +=item PUSHMARK + +Opening bracket for arguments on a callback. See C and L. + + PUSHMARK(p) + +=item PUSHi + +Push an integer onto the stack. The stack must have room for this element. +Handles 'set' magic. See C. + + void PUSHi(int d) + +=item PUSHn + +Push a double onto the stack. The stack must have room for this element. +Handles 'set' magic. See C. + + void PUSHn(double d) + +=item PUSHp + +Push a string onto the stack. The stack must have room for this element. +The C indicates the length of the string. Handles 'set' magic. See +C. + + void PUSHp(char *c, int len ) + +=item PUSHs + +Push an SV onto the stack. The stack must have room for this element. Does +not handle 'set' magic. See C. + + void PUSHs(sv) + +=item PUSHu + +Push an unsigned integer onto the stack. The stack must have room for +this element. See C. + + void PUSHu(unsigned int d) + + +=item PUTBACK + +Closing bracket for XSUB arguments. This is usually handled by C. +See C and L for other uses. + + PUTBACK; + +=item Renew + +The XSUB-writer's interface to the C C function. + + void* Renew( void *ptr, int size, type ) + +=item Renewc + +The XSUB-writer's interface to the C C function, with cast. + + void* Renewc( void *ptr, int size, type, cast ) + +=item RETVAL + +Variable which is setup by C to hold the return value for an XSUB. +This is always the proper type for the XSUB. +See L. + +=item safefree + +The XSUB-writer's interface to the C C function. + +=item safemalloc + +The XSUB-writer's interface to the C C function. + +=item saferealloc + +The XSUB-writer's interface to the C C function. + +=item savepv + +Copy a string to a safe spot. This does not use an SV. + + char* savepv (char* sv) + +=item savepvn + +Copy a string to a safe spot. The C indicates number of bytes to +copy. This does not use an SV. + + char* savepvn (char* sv, I32 len) + +=item SAVETMPS + +Opening bracket for temporaries on a callback. See C and +L. + + SAVETMPS; + +=item SP + +Stack pointer. This is usually handled by C. See C and +C. + +=item SPAGAIN + +Refetch the stack pointer. Used after a callback. See L. + + SPAGAIN; + +=item ST + +Used to access elements on the XSUB's stack. + + SV* ST(int x) + +=item strEQ + +Test two strings to see if they are equal. Returns true or false. + + int strEQ( char *s1, char *s2 ) + +=item strGE + +Test two strings to see if the first, C, is greater than or equal to the +second, C. Returns true or false. + + int strGE( char *s1, char *s2 ) + +=item strGT + +Test two strings to see if the first, C, is greater than the second, +C. Returns true or false. + + int strGT( char *s1, char *s2 ) + +=item strLE + +Test two strings to see if the first, C, is less than or equal to the +second, C. Returns true or false. + + int strLE( char *s1, char *s2 ) + +=item strLT + +Test two strings to see if the first, C, is less than the second, +C. Returns true or false. + + int strLT( char *s1, char *s2 ) + +=item strNE + +Test two strings to see if they are different. Returns true or false. + + int strNE( char *s1, char *s2 ) + +=item strnEQ + +Test two strings to see if they are equal. The C parameter indicates +the number of bytes to compare. Returns true or false. + + int strnEQ( char *s1, char *s2 ) + +=item strnNE + +Test two strings to see if they are different. The C parameter +indicates the number of bytes to compare. Returns true or false. + + int strnNE( char *s1, char *s2, int len ) + +=item sv_2mortal + +Marks an SV as mortal. The SV will be destroyed when the current context +ends. + + SV* sv_2mortal (SV* sv) + +=item sv_bless + +Blesses an SV into a specified package. The SV must be an RV. The package +must be designated by its stash (see C). The reference count +of the SV is unaffected. + + SV* sv_bless (SV* sv, HV* stash) + +=item sv_catpv + +Concatenates the string onto the end of the string which is in the SV. +Handles 'get' magic, but not 'set' magic. See C. + + void sv_catpv (SV* sv, char* ptr) + +=item sv_catpv_mg + +Like C, but also handles 'set' magic. + + void sv_catpvn (SV* sv, char* ptr) + +=item sv_catpvn + +Concatenates the string onto the end of the string which is in the SV. The +C indicates number of bytes to copy. Handles 'get' magic, but not +'set' magic. See C. + + void sv_catpvn (SV* sv, char* ptr, STRLEN len) + +=item sv_catpvn_mg + +Like C, but also handles 'set' magic. + + void sv_catpvn_mg (SV* sv, char* ptr, STRLEN len) + +=item sv_catpvf + +Processes its arguments like C and appends the formatted output +to an SV. Handles 'get' magic, but not 'set' magic. C must +typically be called after calling this function to handle 'set' magic. + + void sv_catpvf (SV* sv, const char* pat, ...) + +=item sv_catpvf_mg + +Like C, but also handles 'set' magic. + + void sv_catpvf_mg (SV* sv, const char* pat, ...) + +=item sv_catsv + +Concatenates the string from SV C onto the end of the string in SV +C. Handles 'get' magic, but not 'set' magic. See C. + + void sv_catsv (SV* dsv, SV* ssv) + +=item sv_catsv_mg + +Like C, but also handles 'set' magic. + + void sv_catsv_mg (SV* dsv, SV* ssv) + +=item sv_chop + +Efficient removal of characters from the beginning of the string +buffer. SvPOK(sv) must be true and the C must be a pointer to +somewhere inside the string buffer. The C becomes the first +character of the adjusted string. + + void sv_chop(SV* sv, char *ptr) + + +=item sv_cmp + +Compares the strings in two SVs. Returns -1, 0, or 1 indicating whether the +string in C is less than, equal to, or greater than the string in +C. + + I32 sv_cmp (SV* sv1, SV* sv2) + +=item SvCUR + +Returns the length of the string which is in the SV. See C. + + int SvCUR (SV* sv) + +=item SvCUR_set + +Set the length of the string which is in the SV. See C. + + void SvCUR_set (SV* sv, int val ) + +=item sv_dec + +Auto-decrement of the value in the SV. + + void sv_dec (SV* sv) + +=item sv_derived_from + +Returns a boolean indicating whether the SV is a subclass of the +specified class. + + int sv_derived_from(SV* sv, char* class) + +=item sv_derived_from + +Returns a boolean indicating whether the SV is derived from the specified +class. This is the function that implements C. It works +for class names as well as for objects. + + bool sv_derived_from _((SV* sv, char* name)); + +=item SvEND + +Returns a pointer to the last character in the string which is in the SV. +See C. Access the character as + + char* SvEND(sv) + +=item sv_eq + +Returns a boolean indicating whether the strings in the two SVs are +identical. + + I32 sv_eq (SV* sv1, SV* sv2) + +=item SvGETMAGIC + +Invokes C on an SV if it has 'get' magic. This macro evaluates +its argument more than once. + + void SvGETMAGIC( SV *sv ) + +=item SvGROW + +Expands the character buffer in the SV so that it has room for the +indicated number of bytes (remember to reserve space for an extra +trailing NUL character). Calls C to perform the expansion if +necessary. Returns a pointer to the character buffer. + + char* SvGROW( SV* sv, int len ) + +=item sv_grow + +Expands the character buffer in the SV. This will use C and will +upgrade the SV to C. Returns a pointer to the character buffer. +Use C. + +=item sv_inc + +Auto-increment of the value in the SV. + + void sv_inc (SV* sv) + +=item sv_insert + +Inserts a string at the specified offset/length within the SV. +Similar to the Perl substr() function. + + void sv_insert(SV *sv, STRLEN offset, STRLEN len, + char *str, STRLEN strlen) + +=item SvIOK + +Returns a boolean indicating whether the SV contains an integer. + + int SvIOK (SV* SV) + +=item SvIOK_off + +Unsets the IV status of an SV. + + void SvIOK_off (SV* sv) + +=item SvIOK_on + +Tells an SV that it is an integer. + + void SvIOK_on (SV* sv) + +=item SvIOK_only + +Tells an SV that it is an integer and disables all other OK bits. + + void SvIOK_only (SV* sv) + +=item SvIOKp + +Returns a boolean indicating whether the SV contains an integer. Checks the +B setting. Use C. + + int SvIOKp (SV* SV) + +=item sv_isa + +Returns a boolean indicating whether the SV is blessed into the specified +class. This does not check for subtypes; use C to verify +an inheritance relationship. + + int sv_isa (SV* sv, char* name) + +=item sv_isobject + +Returns a boolean indicating whether the SV is an RV pointing to a blessed +object. If the SV is not an RV, or if the object is not blessed, then this +will return false. + + int sv_isobject (SV* sv) + +=item SvIV + +Returns the integer which is in the SV. + + int SvIV (SV* sv) + +=item SvIVX + +Returns the integer which is stored in the SV. + + int SvIVX (SV* sv) + +=item SvLEN + +Returns the size of the string buffer in the SV. See C. + + int SvLEN (SV* sv) + +=item sv_len + +Returns the length of the string in the SV. Use C. + + STRLEN sv_len (SV* sv) + +=item sv_magic + +Adds magic to an SV. + + void sv_magic (SV* sv, SV* obj, int how, char* name, I32 namlen) + +=item sv_mortalcopy + +Creates a new SV which is a copy of the original SV. The new SV is marked +as mortal. + + SV* sv_mortalcopy (SV* oldsv) + +=item sv_newmortal + +Creates a new SV which is mortal. The reference count of the SV is set to 1. + + SV* sv_newmortal (void) + +=item SvNIOK + +Returns a boolean indicating whether the SV contains a number, integer or +double. + + int SvNIOK (SV* SV) + +=item SvNIOK_off + +Unsets the NV/IV status of an SV. + + void SvNIOK_off (SV* sv) + +=item SvNIOKp + +Returns a boolean indicating whether the SV contains a number, integer or +double. Checks the B setting. Use C. + + int SvNIOKp (SV* SV) + +=item PL_sv_no + +This is the C SV. See C. Always refer to this as C<&PL_sv_no>. + +=item SvNOK + +Returns a boolean indicating whether the SV contains a double. + + int SvNOK (SV* SV) + +=item SvNOK_off + +Unsets the NV status of an SV. + + void SvNOK_off (SV* sv) + +=item SvNOK_on + +Tells an SV that it is a double. + + void SvNOK_on (SV* sv) + +=item SvNOK_only + +Tells an SV that it is a double and disables all other OK bits. + + void SvNOK_only (SV* sv) + +=item SvNOKp + +Returns a boolean indicating whether the SV contains a double. Checks the +B setting. Use C. + + int SvNOKp (SV* SV) + +=item SvNV + +Returns the double which is stored in the SV. + + double SvNV (SV* sv) + +=item SvNVX + +Returns the double which is stored in the SV. + + double SvNVX (SV* sv) + +=item SvOK + +Returns a boolean indicating whether the value is an SV. + + int SvOK (SV* sv) + +=item SvOOK + +Returns a boolean indicating whether the SvIVX is a valid offset value +for the SvPVX. This hack is used internally to speed up removal of +characters from the beginning of a SvPV. When SvOOK is true, then the +start of the allocated string buffer is really (SvPVX - SvIVX). + + int SvOOK(SV* sv) + +=item SvPOK + +Returns a boolean indicating whether the SV contains a character string. + + int SvPOK (SV* SV) + +=item SvPOK_off + +Unsets the PV status of an SV. + + void SvPOK_off (SV* sv) + +=item SvPOK_on + +Tells an SV that it is a string. + + void SvPOK_on (SV* sv) + +=item SvPOK_only + +Tells an SV that it is a string and disables all other OK bits. + + void SvPOK_only (SV* sv) + +=item SvPOKp + +Returns a boolean indicating whether the SV contains a character string. +Checks the B setting. Use C. + + int SvPOKp (SV* SV) + +=item SvPV + +Returns a pointer to the string in the SV, or a stringified form of the SV +if the SV does not contain a string. If C is C then Perl will +handle the length on its own. Handles 'get' magic. + + char* SvPV (SV* sv, int len ) + +=item SvPV_force + +Like but will force the SV into becoming a string (SvPOK). You +want force if you are going to update the SvPVX directly. + + char* SvPV_force(SV* sv, int len) + + +=item SvPVX + +Returns a pointer to the string in the SV. The SV must contain a string. + + char* SvPVX (SV* sv) + +=item SvREFCNT + +Returns the value of the object's reference count. + + int SvREFCNT (SV* sv) + +=item SvREFCNT_dec + +Decrements the reference count of the given SV. + + void SvREFCNT_dec (SV* sv) + +=item SvREFCNT_inc + +Increments the reference count of the given SV. + + void SvREFCNT_inc (SV* sv) + +=item SvROK + +Tests if the SV is an RV. + + int SvROK (SV* sv) + +=item SvROK_off + +Unsets the RV status of an SV. + + void SvROK_off (SV* sv) + +=item SvROK_on + +Tells an SV that it is an RV. + + void SvROK_on (SV* sv) + +=item SvRV + +Dereferences an RV to return the SV. + + SV* SvRV (SV* sv) + +=item SvSETMAGIC + +Invokes C on an SV if it has 'set' magic. This macro evaluates +its argument more than once. + + void SvSETMAGIC( SV *sv ) + +=item sv_setiv + +Copies an integer into the given SV. Does not handle 'set' magic. +See C. + + void sv_setiv (SV* sv, IV num) + +=item sv_setiv_mg + +Like C, but also handles 'set' magic. + + void sv_setiv_mg (SV* sv, IV num) + +=item sv_setnv + +Copies a double into the given SV. Does not handle 'set' magic. +See C. + + void sv_setnv (SV* sv, double num) + +=item sv_setnv_mg + +Like C, but also handles 'set' magic. + + void sv_setnv_mg (SV* sv, double num) + +=item sv_setpv + +Copies a string into an SV. The string must be null-terminated. +Does not handle 'set' magic. See C. + + void sv_setpv (SV* sv, char* ptr) + +=item sv_setpv_mg + +Like C, but also handles 'set' magic. + + void sv_setpv_mg (SV* sv, char* ptr) + +=item sv_setpviv + +Copies an integer into the given SV, also updating its string value. +Does not handle 'set' magic. See C. + + void sv_setpviv (SV* sv, IV num) + +=item sv_setpviv_mg + +Like C, but also handles 'set' magic. + + void sv_setpviv_mg (SV* sv, IV num) + +=item sv_setpvn + +Copies a string into an SV. The C parameter indicates the number of +bytes to be copied. Does not handle 'set' magic. See C. + + void sv_setpvn (SV* sv, char* ptr, STRLEN len) + +=item sv_setpvn_mg + +Like C, but also handles 'set' magic. + + void sv_setpvn_mg (SV* sv, char* ptr, STRLEN len) + +=item sv_setpvf + +Processes its arguments like C and sets an SV to the formatted +output. Does not handle 'set' magic. See C. + + void sv_setpvf (SV* sv, const char* pat, ...) + +=item sv_setpvf_mg + +Like C, but also handles 'set' magic. + + void sv_setpvf_mg (SV* sv, const char* pat, ...) + +=item sv_setref_iv + +Copies an integer into a new SV, optionally blessing the SV. The C +argument will be upgraded to an RV. That RV will be modified to point to +the new SV. The C argument indicates the package for the +blessing. Set C to C to avoid the blessing. The new SV +will be returned and will have a reference count of 1. + + SV* sv_setref_iv (SV *rv, char *classname, IV iv) + +=item sv_setref_nv + +Copies a double into a new SV, optionally blessing the SV. The C +argument will be upgraded to an RV. That RV will be modified to point to +the new SV. The C argument indicates the package for the +blessing. Set C to C to avoid the blessing. The new SV +will be returned and will have a reference count of 1. + + SV* sv_setref_nv (SV *rv, char *classname, double nv) + +=item sv_setref_pv + +Copies a pointer into a new SV, optionally blessing the SV. The C +argument will be upgraded to an RV. That RV will be modified to point to +the new SV. If the C argument is NULL then C will be placed +into the SV. The C argument indicates the package for the +blessing. Set C to C to avoid the blessing. The new SV +will be returned and will have a reference count of 1. + + SV* sv_setref_pv (SV *rv, char *classname, void* pv) + +Do not use with integral Perl types such as HV, AV, SV, CV, because those +objects will become corrupted by the pointer copy process. + +Note that C copies the string while this copies the pointer. + +=item sv_setref_pvn + +Copies a string into a new SV, optionally blessing the SV. The length of the +string must be specified with C. The C argument will be upgraded to +an RV. That RV will be modified to point to the new SV. The C +argument indicates the package for the blessing. Set C to +C to avoid the blessing. The new SV will be returned and will have +a reference count of 1. + + SV* sv_setref_pvn (SV *rv, char *classname, char* pv, I32 n) + +Note that C copies the pointer while this copies the string. + +=item SvSetSV + +Calls C if dsv is not the same as ssv. May evaluate arguments +more than once. + + void SvSetSV (SV* dsv, SV* ssv) + +=item SvSetSV_nosteal + +Calls a non-destructive version of C if dsv is not the same as ssv. +May evaluate arguments more than once. + + void SvSetSV_nosteal (SV* dsv, SV* ssv) + +=item sv_setsv + +Copies the contents of the source SV C into the destination SV C. +The source SV may be destroyed if it is mortal. Does not handle 'set' magic. +See the macro forms C, C and C. + + void sv_setsv (SV* dsv, SV* ssv) + +=item sv_setsv_mg + +Like C, but also handles 'set' magic. + + void sv_setsv_mg (SV* dsv, SV* ssv) + +=item sv_setuv + +Copies an unsigned integer into the given SV. Does not handle 'set' magic. +See C. + + void sv_setuv (SV* sv, UV num) + +=item sv_setuv_mg + +Like C, but also handles 'set' magic. + + void sv_setuv_mg (SV* sv, UV num) + +=item SvSTASH + +Returns the stash of the SV. + + HV* SvSTASH (SV* sv) + +=item SvTAINT + +Taints an SV if tainting is enabled + + void SvTAINT (SV* sv) + +=item SvTAINTED + +Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not. + + int SvTAINTED (SV* sv) + +=item SvTAINTED_off + +Untaints an SV. Be I careful with this routine, as it short-circuits +some of Perl's fundamental security features. XS module authors should +not use this function unless they fully understand all the implications +of unconditionally untainting the value. Untainting should be done in +the standard perl fashion, via a carefully crafted regexp, rather than +directly untainting variables. + + void SvTAINTED_off (SV* sv) + +=item SvTAINTED_on + +Marks an SV as tainted. + + void SvTAINTED_on (SV* sv) + +=item SVt_IV + +Integer type flag for scalars. See C. + +=item SVt_PV + +Pointer type flag for scalars. See C. + +=item SVt_PVAV + +Type flag for arrays. See C. + +=item SVt_PVCV + +Type flag for code refs. See C. + +=item SVt_PVHV + +Type flag for hashes. See C. + +=item SVt_PVMG + +Type flag for blessed scalars. See C. + +=item SVt_NV + +Double type flag for scalars. See C. + +=item SvTRUE + +Returns a boolean indicating whether Perl would evaluate the SV as true or +false, defined or undefined. Does not handle 'get' magic. + + int SvTRUE (SV* sv) + +=item SvTYPE + +Returns the type of the SV. See C. + + svtype SvTYPE (SV* sv) + +=item svtype + +An enum of flags for Perl types. These are found in the file B in the +C enum. Test these flags with the C macro. + +=item PL_sv_undef + +This is the C SV. Always refer to this as C<&PL_sv_undef>. + +=item sv_unref + +Unsets the RV status of the SV, and decrements the reference count of +whatever was being referenced by the RV. This can almost be thought of +as a reversal of C. See C. + + void sv_unref (SV* sv) + +=item SvUPGRADE + +Used to upgrade an SV to a more complex form. Uses C to perform +the upgrade if necessary. See C. + + bool SvUPGRADE (SV* sv, svtype mt) + +=item sv_upgrade + +Upgrade an SV to a more complex form. Use C. See C. + +=item sv_usepvn + +Tells an SV to use C to find its string value. Normally the string is +stored inside the SV but sv_usepvn allows the SV to use an outside string. +The C should point to memory that was allocated by C. The +string length, C, must be supplied. This function will realloc the +memory pointed to by C, so that pointer should not be freed or used by +the programmer after giving it to sv_usepvn. Does not handle 'set' magic. +See C. + + void sv_usepvn (SV* sv, char* ptr, STRLEN len) + +=item sv_usepvn_mg + +Like C, but also handles 'set' magic. + + void sv_usepvn_mg (SV* sv, char* ptr, STRLEN len) + +=item sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) + +Processes its arguments like C and appends the formatted output +to an SV. Uses an array of SVs if the C style variable argument list is +missing (NULL). Indicates if locale information has been used for formatting. + + void sv_catpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list *args, SV **svargs, I32 svmax, + bool *used_locale)); + +=item sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) + +Works like C but copies the text into the SV instead of +appending it. + + void sv_setpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list *args, SV **svargs, I32 svmax, + bool *used_locale)); + +=item SvUV + +Returns the unsigned integer which is in the SV. + + UV SvUV(SV* sv) + +=item SvUVX + +Returns the unsigned integer which is stored in the SV. + + UV SvUVX(SV* sv) + +=item PL_sv_yes + +This is the C SV. See C. Always refer to this as C<&PL_sv_yes>. + +=item THIS + +Variable which is setup by C to designate the object in a C++ XSUB. +This is always the proper type for the C++ object. See C and +L. + +=item toLOWER + +Converts the specified character to lowercase. + + int toLOWER (char c) + +=item toUPPER + +Converts the specified character to uppercase. + + int toUPPER (char c) + +=item warn + +This is the XSUB-writer's interface to Perl's C function. Use this +function the same way you use the C C function. See C. + +=item XPUSHi + +Push an integer onto the stack, extending the stack if necessary. Handles +'set' magic. See C. + + XPUSHi(int d) + +=item XPUSHn + +Push a double onto the stack, extending the stack if necessary. Handles 'set' +magic. See C. + + XPUSHn(double d) + +=item XPUSHp + +Push a string onto the stack, extending the stack if necessary. The C +indicates the length of the string. Handles 'set' magic. See C. + + XPUSHp(char *c, int len) + +=item XPUSHs + +Push an SV onto the stack, extending the stack if necessary. Does not +handle 'set' magic. See C. + + XPUSHs(sv) + +=item XPUSHu + +Push an unsigned integer onto the stack, extending the stack if +necessary. See C. + +=item XS + +Macro to declare an XSUB and its C parameter list. This is handled by +C. + +=item XSRETURN + +Return from XSUB, indicating number of items on the stack. This is usually +handled by C. + + XSRETURN(int x) + +=item XSRETURN_EMPTY + +Return an empty list from an XSUB immediately. + + XSRETURN_EMPTY; + +=item XSRETURN_IV + +Return an integer from an XSUB immediately. Uses C. + + XSRETURN_IV(IV v) + +=item XSRETURN_NO + +Return C<&PL_sv_no> from an XSUB immediately. Uses C. + + XSRETURN_NO; + +=item XSRETURN_NV + +Return an double from an XSUB immediately. Uses C. + + XSRETURN_NV(NV v) + +=item XSRETURN_PV + +Return a copy of a string from an XSUB immediately. Uses C. + + XSRETURN_PV(char *v) + +=item XSRETURN_UNDEF + +Return C<&PL_sv_undef> from an XSUB immediately. Uses C. + + XSRETURN_UNDEF; + +=item XSRETURN_YES + +Return C<&PL_sv_yes> from an XSUB immediately. Uses C. + + XSRETURN_YES; + +=item XST_mIV + +Place an integer into the specified position C on the stack. The value is +stored in a new mortal SV. + + XST_mIV( int i, IV v ) + +=item XST_mNV + +Place a double into the specified position C on the stack. The value is +stored in a new mortal SV. + + XST_mNV( int i, NV v ) + +=item XST_mNO + +Place C<&PL_sv_no> into the specified position C on the stack. + + XST_mNO( int i ) + +=item XST_mPV + +Place a copy of a string into the specified position C on the stack. The +value is stored in a new mortal SV. + + XST_mPV( int i, char *v ) + +=item XST_mUNDEF + +Place C<&PL_sv_undef> into the specified position C on the stack. + + XST_mUNDEF( int i ) + +=item XST_mYES + +Place C<&PL_sv_yes> into the specified position C on the stack. + + XST_mYES( int i ) + +=item XS_VERSION + +The version identifier for an XS module. This is usually handled +automatically by C. See C. + +=item XS_VERSION_BOOTCHECK + +Macro to verify that a PM module's $VERSION variable matches the XS module's +C variable. This is usually handled automatically by +C. See L. + +=item Zero + +The XSUB-writer's interface to the C C function. The C is the +destination, C is the number of items, and C is the type. + + void Zero( d, n, t ) + +=back + +=head1 AUTHORS + +Until May 1997, this document was maintained by Jeff Okamoto +. It is now maintained as part of Perl itself. + +With lots of help and suggestions from Dean Roehrich, Malcolm Beattie, +Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil +Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer, +Stephen McCamant, and Gurusamy Sarathy. + +API Listing originally by Dean Roehrich . diff --git a/contrib/perl5/pod/perlhist.pod b/contrib/perl5/pod/perlhist.pod new file mode 100644 index 00000000000..9ed8b6f52e6 --- /dev/null +++ b/contrib/perl5/pod/perlhist.pod @@ -0,0 +1,518 @@ +=pod + +=head1 NAME + +perlhist - the Perl history records + +=for RCS +# +# $Id: perlhist.pod,v 1.48 1998/08/03 08:50:12 jhi Exp $ +# +=end RCS + +=head1 DESCRIPTION + +This document aims to record the Perl source code releases. + +=head1 INTRODUCTION + +Perl history in brief, by Larry Wall: + + Perl 0 introduced Perl to my officemates. + Perl 1 introduced Perl to the world, and changed /\(...\|...\)/ to + /(...|...)/. \(Dan Faigin still hasn't forgiven me. :-\) + Perl 2 introduced Henry Spencer's regular expression package. + Perl 3 introduced the ability to handle binary data (embedded nulls). + Perl 4 introduced the first Camel book. Really. We mostly just + switched version numbers so the book could refer to 4.000. + Perl 5 introduced everything else, including the ability to + introduce everything else. + +=head1 THE KEEPERS OF THE PUMPKIN + +Larry Wall, Andy Dougherty, Tom Christiansen, Charles Bailey, Nick +Ing-Simmons, Chip Salzenberg, Tim Bunce, Malcolm Beattie, Gurusamy +Sarathy, Graham Barr. + +=head2 PUMPKIN? + +[from Porting/pumpkin.pod in the Perl source code distribution] + +Chip Salzenberg gets credit for that, with a nod to his cow orker, +David Croy. We had passed around various names (baton, token, hot +potato) but none caught on. Then, Chip asked: + +[begin quote] + + Who has the patch pumpkin? + +To explain: David Croy once told me once that at a previous job, +there was one tape drive and multiple systems that used it for backups. +But instead of some high-tech exclusion software, they used a low-tech +method to prevent multiple simultaneous backups: a stuffed pumpkin. +No one was allowed to make backups unless they had the "backup pumpkin". + +[end quote] + +The name has stuck. The holder of the pumpkin is sometimes called +the pumpking (keeping the source afloat?) or the pumpkineer (pulling +the strings?). + +=head1 THE RECORDS + + Pump- Release Date Notes + king (by no means + comprehensive, + see Changes* + for details) + =========================================================================== + + Larry 0 Classified. Don't ask. + + Larry 1.000 1987-Dec-18 + + 1.001..10 1988-Jan-30 + 1.011..14 1988-Feb-02 + + Larry 2.000 1988-Jun-05 + + 2.001 1988-Jun-28 + + Larry 3.000 1989-Oct-18 + + 3.001 1989-Oct-26 + 3.002..4 1989-Nov-11 + 3.005 1989-Nov-18 + 3.006..8 1989-Dec-22 + 3.009..13 1990-Mar-02 + 3.014 1990-Mar-13 + 3.015 1990-Mar-14 + 3.016..18 1990-Mar-28 + 3.019..27 1990-Aug-10 User subs. + 3.028 1990-Aug-14 + 3.029..36 1990-Oct-17 + 3.037 1990-Oct-20 + 3.040 1990-Nov-10 + 3.041 1990-Nov-13 + 3.042..43 1990-Jan-?? + 3.044 1991-Jan-12 + + Larry 4.000 1991-Mar-21 + + 4.001..3 1991-Apr-12 + 4.004..9 1991-Jun-07 + 4.010 1991-Jun-10 + 4.011..18 1991-Nov-05 + 4.019 1991-Nov-11 Stable. + 4.020..33 1992-Jun-08 + 4.034 1992-Jun-11 + 4.035 1992-Jun-23 + Larry 4.036 1993-Feb-05 Very stable. + + 5.000alpha1 1993-Jul-31 + 5.000alpha2 1993-Aug-16 + 5.000alpha3 1993-Oct-10 + 5.000alpha4 1993-???-?? + 5.000alpha5 1993-???-?? + 5.000alpha6 1994-Mar-18 + 5.003alpha7 1994-Mar-25 + Andy 5.000alpha8 1994-Apr-04 + Larry 5.000alpha9 1994-May-05 ext appears. + 5.000alpha10 1994-???-?? + 5.000alpha11 1994-???-?? + Andy 5.000a11a 1994-Jul-07 To fit 14. + 5.000a11b 1994-Jul-14 + 5.000a11c 1994-Jul-19 + 5.000a11d 1994-Jul-22 + Larry 5.000alpha12 1994-???-?? + Andy 5.000a12a 1994-Aug-08 + 5.000a12b 1994-Aug-15 + 5.000a12c 1994-Aug-22 + 5.000a12d 1994-Aug-22 + 5.000a12e 1994-Aug-22 + 5.000a12f 1994-Aug-24 + 5.000a12g 1994-Aug-24 + 5.000a12h 1994-Aug-24 + Larry 5.000beta1 1994-???-?? + Andy 5.000b1a 1994-???-?? + Larry 5.000beta2 1994-Sep-14 Core slushified. + Andy 5.000b2a 1994-Sep-14 + 5.000b2b 1994-Sep-17 + 5.000b2c 1994-Sep-17 + Larry 5.000beta3 1994-Sep-?? + Andy 5.000b3a 1994-Sep-18 + 5.000b3b 1994-Sep-22 + 5.000b3c 1994-Sep-23 + 5.000b3d 1994-Sep-27 + 5.000b3e 1994-Sep-28 + 5.000b3f 1994-Sep-30 + 5.000b3g 1994-Oct-04 + Andy 5.000b3h 1994-Oct-07 + + Larry 5.000 1994-Oct-18 + + Andy 5.000a 1994-Dec-19 + 5.000b 1995-Jan-18 + 5.000c 1995-Jan-18 + 5.000d 1995-Jan-18 + 5.000e 1995-Jan-18 + 5.000f 1995-Jan-18 + 5.000g 1995-Jan-18 + 5.000h 1995-Jan-18 + 5.000i 1995-Jan-26 + 5.000j 1995-Feb-07 + 5.000k 1995-Feb-11 + 5.000l 1995-Feb-21 + 5.000m 1995-???-?? + 5.000n 1995-Mar-07 + + Larry 5.001 1995-Mar-13 + + Andy 5.001a 1995-Mar-15 + 5.001b 1995-Mar-31 + 5.001c 1995-Apr-07 + 5.001d 1995-Apr-14 + 5.001e 1995-Apr-18 Stable. + 5.001f 1995-May-31 + 5.001g 1995-May-25 + 5.001h 1995-May-25 + 5.001i 1995-May-30 + 5.001j 1995-Jun-05 + 5.001k 1995-Jun-06 + 5.001l 1995-Jun-06 Stable. + 5.001m 1995-Jul-02 Very stable. + 5.001n 1995-Oct-31 Very unstable. + 5.002beta1 1995-Nov-21 + 5.002b1a 1995-Nov-?? + 5.002b1b 1995-Dec-04 + 5.002b1c 1995-Dec-04 + 5.002b1d 1995-Dec-04 + 5.002b1e 1995-Dec-08 + 5.002b1f 1995-Dec-08 + Tom 5.002b1g 1995-Dec-21 Doc release. + Andy 5.002b1h 1996-Jan-05 + 5.002b2 1996-Jan-14 + Larry 5.002b3 1996-Feb-02 + Andy 5.002gamma 1996-Feb-11 + Larry 5.002delta 1996-Feb-27 + + Larry 5.002 1996-Feb-29 Prototypes. + + Charles 5.002_01 1996-Mar-25 + + 5.003 1996-Jun-25 Security release. + + 5.003_01 1996-Jul-31 + Nick 5.003_02 1996-Aug-10 + Andy 5.003_03 1996-Aug-28 + 5.003_04 1996-Sep-02 + 5.003_05 1996-Sep-12 + 5.003_06 1996-Oct-07 + 5.003_07 1996-Oct-10 + Chip 5.003_08 1996-Nov-19 + 5.003_09 1996-Nov-26 + 5.003_10 1996-Nov-29 + 5.003_11 1996-Dec-06 + 5.003_12 1996-Dec-19 + 5.003_13 1996-Dec-20 + 5.003_14 1996-Dec-23 + 5.003_15 1996-Dec-23 + 5.003_16 1996-Dec-24 + 5.003_17 1996-Dec-27 + 5.003_18 1996-Dec-31 + 5.003_19 1997-Jan-04 + 5.003_20 1997-Jan-07 + 5.003_21 1997-Jan-15 + 5.003_22 1997-Jan-16 + 5.003_23 1997-Jan-25 + 5.003_24 1997-Jan-29 + 5.003_25 1997-Feb-04 + 5.003_26 1997-Feb-10 + 5.003_27 1997-Feb-18 + 5.003_28 1997-Feb-21 + 5.003_90 1997-Feb-25 Ramping up to the 5.004 release. + 5.003_91 1997-Mar-01 + 5.003_92 1997-Mar-06 + 5.003_93 1997-Mar-10 + 5.003_94 1997-Mar-22 + 5.003_95 1997-Mar-25 + 5.003_96 1997-Apr-01 + 5.003_97 1997-Apr-03 Fairly widely used. + 5.003_97a 1997-Apr-05 + 5.003_97b 1997-Apr-08 + 5.003_97c 1997-Apr-10 + 5.003_97d 1997-Apr-13 + 5.003_97e 1997-Apr-15 + 5.003_97f 1997-Apr-17 + 5.003_97g 1997-Apr-18 + 5.003_97h 1997-Apr-24 + 5.003_97i 1997-Apr-25 + 5.003_97j 1997-Apr-28 + 5.003_98 1997-Apr-30 + 5.003_99 1997-May-01 + 5.003_99a 1997-May-09 + p54rc1 1997-May-12 Release Candidates. + p54rc2 1997-May-14 + + Chip 5.004 1997-May-15 A major maintenance release. + + Tim 5.004_01 1997-Jun-13 The 5.004 maintenance track. + 5.004_02 1997-Aug-07 + 5.004_03 1997-Sep-05 + 5.004_04 1997-Oct-15 + 5.004m5t1 1998-Mar-04 Maintenance Trials (for 5.004_05). + 5.004_04-m2 1997-May-01 + 5.004_04-m3 1998-May-15 + 5.004_04-m4 1998-May-19 + 5.004_04-MT5 1998-Jul-21 + + Malcolm 5.004_50 1997-Sep-09 The 5.005 development track. + 5.004_51 1997-Oct-02 + 5.004_52 1997-Oct-15 + 5.004_53 1997-Oct-16 + 5.004_54 1997-Nov-14 + 5.004_55 1997-Nov-25 + 5.004_56 1997-Dec-18 + 5.004_57 1998-Feb-03 + 5.004_58 1998-Feb-06 + 5.004_59 1998-Feb-13 + 5.004_60 1998-Feb-20 + 5.004_61 1998-Feb-27 + 5.004_62 1998-Mar-06 + 5.004_63 1998-Mar-17 + 5.004_64 1998-Apr-03 + 5.004_65 1998-May-15 + 5.004_66 1998-May-29 + Sarathy 5.004_67 1998-Jun-15 + 5.004_68 1998-Jun-23 + 5.004_69 1998-Jun-29 + 5.004_70 1998-Jul-06 + 5.004_71 1998-Jul-09 + 5.004_72 1998-Jul-12 + 5.004_73 1998-Jul-13 + 5.004_74 1998-Jul-14 5.005 beta candidate. + 5.004_75 1998-Jul-15 5.005 beta1. + 5.004_76 1998-Jul-21 5.005 beta2. + 5.005 1998-Jul-22 Oneperl. + + Sarathy 5.005_01 1998-Jul-27 The 5.005 maintenance track. + 5.005_02-T1 1998-Aug-02 + 5.005_02-T2 1998-Aug-05 + 5.005_02 1998-Aug-08 + Graham 5.005_03 1998- + + Sarathy 5.005_50 1998-Jul-26 The 5.006 development track. + +=head2 SELECTED RELEASE SIZES + +For example the notation "core: 212 29" in the release 1.000 means that +it had in the core 212 kilobytes, in 29 files. The "core".."doc" are +explained below. + + release core lib ext t doc + ====================================================================== + + 1.000 212 29 - - - - 38 51 62 3 + 1.014 219 29 - - - - 39 52 68 4 + 2.000 309 31 2 3 - - 55 57 92 4 + 2.001 312 31 2 3 - - 55 57 94 4 + 3.000 508 36 24 11 - - 79 73 156 5 + 3.044 645 37 61 20 - - 90 74 190 6 + 4.000 635 37 59 20 - - 91 75 198 4 + 4.019 680 37 85 29 - - 98 76 199 4 + 4.036 709 37 89 30 - - 98 76 208 5 + 5.000alpha2 785 50 114 32 - - 112 86 209 5 + 5.000alpha3 801 50 117 33 - - 121 87 209 5 + 5.000alpha9 1022 56 149 43 116 29 125 90 217 6 + 5.000a12h 978 49 140 49 205 46 152 97 228 9 + 5.000b3h 1035 53 232 70 216 38 162 94 218 21 + 5.000 1038 53 250 76 216 38 154 92 536 62 + 5.001m 1071 54 388 82 240 38 159 95 544 29 + 5.002 1121 54 661 101 287 43 155 94 847 35 + 5.003 1129 54 680 102 291 43 166 100 853 35 + 5.003_07 1231 60 748 106 396 53 213 137 976 39 + 5.004 1351 60 1230 136 408 51 355 161 1587 55 + 5.004_01 1356 60 1258 138 410 51 358 161 1587 55 + 5.004_04 1375 60 1294 139 413 51 394 162 1629 55 + 5.004_51 1401 61 1260 140 413 53 358 162 1594 56 + 5.004_53 1422 62 1295 141 438 70 394 162 1637 56 + 5.004_56 1501 66 1301 140 447 74 408 165 1648 57 + 5.004_59 1555 72 1317 142 448 74 424 171 1678 58 + 5.004_62 1602 77 1327 144 629 92 428 173 1674 58 + 5.004_65 1626 77 1358 146 615 92 446 179 1698 60 + 5.004_68 1856 74 1382 152 619 92 463 187 1784 60 + 5.004_70 1863 75 1456 154 675 92 494 194 1809 60 + 5.004_73 1874 76 1467 152 762 102 506 196 1883 61 + 5.004_75 1877 76 1467 152 770 103 508 196 1896 62 + 5.005 1896 76 1469 152 795 103 509 197 1945 63 + +The "core"..."doc" mean the following files from the Perl source code +distribution. The glob notation ** means recursively, (.) means +regular files. + + core *.[hcy] + lib lib/**/*.p[ml] + ext ext/**/*.{[hcyt],xs,pm} + t t/**/*(.) + doc {README*,INSTALL,*[_.]man{,.?},pod/**/*.pod} + +Here are some statistics for the other subdirectories and one file in +the Perl source distribution for somewhat more selected releases. + + ====================================================================== + Legend: kB # + + 1.014 2.001 3.044 4.000 4.019 4.036 + + atarist - - - - - - - - - - 113 31 + Configure 31 1 37 1 62 1 73 1 83 1 86 1 + eg - - 34 28 47 39 47 39 47 39 47 39 + emacs - - - - - - 67 4 67 4 67 4 + h2pl - - - - 12 12 12 12 12 12 12 12 + hints - - - - - - - - 5 42 11 56 + msdos - - - - 41 13 57 15 58 15 60 15 + os2 - - - - 63 22 81 29 81 29 113 31 + usub - - - - 21 16 25 7 43 8 43 8 + x2p 103 17 104 17 137 17 147 18 152 19 154 19 + + ====================================================================== + + 5.000a2 5.000a12h 5.000b3h 5.000 5.001m 5.002 5.003 + + atarist 113 31 113 31 - - - - - - - - - - + bench - - 0 1 - - - - - - - - - - + Bugs 2 5 26 1 - - - - - - - - - - + dlperl 40 5 - - - - - - - - - - - - + do 127 71 - - - - - - - - - - - - + Configure - - 153 1 159 1 160 1 180 1 201 1 201 1 + Doc - - 26 1 75 7 11 1 11 1 - - - - + eg 79 58 53 44 51 43 54 44 54 44 54 44 54 44 + emacs 67 4 104 6 104 6 104 1 104 6 108 1 108 1 + h2pl 12 12 12 12 12 12 12 12 12 12 12 12 12 12 + hints 11 56 12 46 18 48 18 48 44 56 73 59 77 60 + msdos 60 15 60 15 - - - - - - - - - - + os2 113 31 113 31 - - - - - - 84 17 56 10 + U - - 62 8 112 42 - - - - - - - - + usub 43 8 - - - - - - - - - - - - + utils - - - - - - - - - - 87 7 88 7 + vms - - 80 7 123 9 184 15 304 20 500 24 475 26 + x2p 171 22 171 21 162 20 162 20 279 20 280 20 280 20 + + ====================================================================== + + 5.003_07 5.004 5.004_04 5.004_62 5.004_65 5.004_68 + + beos - - - - - - - - 1 1 1 1 + Configure 217 1 225 1 225 1 240 1 248 1 256 1 + cygwin32 - - 23 5 23 5 23 5 24 5 24 5 + djgpp - - - - - - 14 5 14 5 14 5 + eg 54 44 81 62 81 62 81 62 81 62 81 62 + emacs 143 1 194 1 204 1 212 2 212 2 212 2 + h2pl 12 12 12 12 12 12 12 12 12 12 12 12 + hints 90 62 129 69 132 71 144 72 151 74 155 74 + os2 117 42 121 42 127 42 127 44 129 44 129 44 + plan9 79 15 82 15 82 15 82 15 82 15 82 15 + Porting 51 1 94 2 109 4 203 6 234 8 241 9 + qnx - - 1 2 1 2 1 2 1 2 1 2 + utils 97 7 112 8 118 8 124 8 156 9 159 9 + vms 505 27 518 34 524 34 538 34 569 34 569 34 + win32 - - 285 33 378 36 470 39 493 39 575 41 + x2p 280 19 281 19 281 19 281 19 282 19 281 19 + + ====================================================================== + + 5.004_70 5.004_73 5.004_75 5.005 + + beos 1 1 1 1 1 1 1 1 + Configure 256 1 256 1 264 1 264 1 + cygwin32 24 5 24 5 24 5 24 5 + djgpp 14 5 14 5 14 5 14 5 + eg 86 65 86 65 86 65 86 65 + emacs 262 2 262 2 262 2 262 2 + h2pl 12 12 12 12 12 12 12 12 + hints 157 74 157 74 159 74 160 74 + mpeix - - - - 5 3 5 3 + os2 129 44 139 44 142 44 143 44 + plan9 82 15 82 15 82 15 82 15 + Porting 241 9 253 9 259 10 264 12 + qnx 1 2 1 2 1 2 1 2 + utils 160 9 160 9 160 9 160 9 + vms 570 34 572 34 573 34 575 34 + win32 577 41 585 41 585 41 587 41 + x2p 281 19 281 19 281 19 281 19 + +=head2 SELECTED PATCH SIZES + +The "diff lines kb" means that for example the patch 5.003_08, to be +applied on top of the 5.003_07 (or whatever was before the 5.003_08) +added lines for 110 kilobytes, it removed lines for 19 kilobytes, and +changed lines for 424 kilobytes. Just the lines themselves are +counted, not their context. The "+ - !" become from the diff(1)s +context diff output format. + + Pump- Release Date diff lines kB + king + - ! + =========================================================================== + + Chip 5.003_08 1996-Nov-19 110 19 424 + 5.003_09 1996-Nov-26 38 9 248 + 5.003_10 1996-Nov-29 29 2 27 + 5.003_11 1996-Dec-06 73 12 165 + 5.003_12 1996-Dec-19 275 6 436 + 5.003_13 1996-Dec-20 95 1 56 + 5.003_14 1996-Dec-23 23 7 333 + 5.003_15 1996-Dec-23 0 0 1 + 5.003_16 1996-Dec-24 12 3 50 + 5.003_17 1996-Dec-27 19 1 14 + 5.003_18 1996-Dec-31 21 1 32 + 5.003_19 1997-Jan-04 80 3 85 + 5.003_20 1997-Jan-07 18 1 146 + 5.003_21 1997-Jan-15 38 10 221 + 5.003_22 1997-Jan-16 4 0 18 + 5.003_23 1997-Jan-25 71 15 119 + 5.003_24 1997-Jan-29 426 1 20 + 5.003_25 1997-Feb-04 21 8 169 + 5.003_26 1997-Feb-10 16 1 15 + 5.003_27 1997-Feb-18 32 10 38 + 5.003_28 1997-Feb-21 58 4 66 + 5.003_90 1997-Feb-25 22 2 34 + 5.003_91 1997-Mar-01 37 1 39 + 5.003_92 1997-Mar-06 16 3 69 + 5.003_93 1997-Mar-10 12 3 15 + 5.003_94 1997-Mar-22 407 7 200 + 5.003_95 1997-Mar-25 41 1 37 + 5.003_96 1997-Apr-01 283 5 261 + 5.003_97 1997-Apr-03 13 2 34 + 5.003_97a 1997-Apr-05 57 1 27 + 5.003_97b 1997-Apr-08 14 1 20 + 5.003_97c 1997-Apr-10 20 1 16 + 5.003_97d 1997-Apr-13 8 0 16 + 5.003_97e 1997-Apr-15 15 4 46 + 5.003_97f 1997-Apr-17 7 1 33 + 5.003_97g 1997-Apr-18 6 1 42 + 5.003_97h 1997-Apr-24 23 3 68 + 5.003_97i 1997-Apr-25 23 1 31 + 5.003_97j 1997-Apr-28 36 1 49 + 5.003_98 1997-Apr-30 171 12 539 + 5.003_99 1997-May-01 6 0 7 + 5.003_99a 1997-May-09 36 2 61 + p54rc1 1997-May-12 8 1 11 + p54rc2 1997-May-14 6 0 40 + + 5.004 1997-May-15 4 0 4 + + Tim 5.004_01 1997-Jun-13 222 14 57 + 5.004_02 1997-Aug-07 112 16 119 + 5.004_03 1997-Sep-05 109 0 17 + 5.004_04 1997-Oct-15 66 8 173 + +=head1 THE KEEPERS OF THE RECORDS + +Jarkko Hietaniemi >. + +Thanks to the collective memory of the Perlfolk. In addition to the +Keepers of the Pumpkin also Alan Champion, Andreas König, John +Macdonald, Matthias Neeracher, Michael Peppler, Randal Schwartz, and +Paul D. Smith sent corrections and additions. + +=cut diff --git a/contrib/perl5/pod/perlipc.pod b/contrib/perl5/pod/perlipc.pod new file mode 100644 index 00000000000..59c5ad9f015 --- /dev/null +++ b/contrib/perl5/pod/perlipc.pod @@ -0,0 +1,1443 @@ +=head1 NAME + +perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores) + +=head1 DESCRIPTION + +The basic IPC facilities of Perl are built out of the good old Unix +signals, named pipes, pipe opens, the Berkeley socket routines, and SysV +IPC calls. Each is used in slightly different situations. + +=head1 Signals + +Perl uses a simple signal handling model: the %SIG hash contains names or +references of user-installed signal handlers. These handlers will be called +with an argument which is the name of the signal that triggered it. A +signal may be generated intentionally from a particular keyboard sequence like +control-C or control-Z, sent to you from another process, or +triggered automatically by the kernel when special events transpire, like +a child process exiting, your process running out of stack space, or +hitting file size limit. + +For example, to trap an interrupt signal, set up a handler like this. +Do as little as you possibly can in your handler; notice how all we do is +set a global variable and then raise an exception. That's because on most +systems, libraries are not re-entrant; particularly, memory allocation and +I/O routines are not. That means that doing nearly I in your +handler could in theory trigger a memory fault and subsequent core dump. + + sub catch_zap { + my $signame = shift; + $shucks++; + die "Somebody sent me a SIG$signame"; + } + $SIG{INT} = 'catch_zap'; # could fail in modules + $SIG{INT} = \&catch_zap; # best strategy + +The names of the signals are the ones listed out by C on your +system, or you can retrieve them from the Config module. Set up an +@signame list indexed by number to get the name and a %signo table +indexed by name to get the number: + + use Config; + defined $Config{sig_name} || die "No sigs?"; + foreach $name (split(' ', $Config{sig_name})) { + $signo{$name} = $i; + $signame[$i] = $name; + $i++; + } + +So to check whether signal 17 and SIGALRM were the same, do just this: + + print "signal #17 = $signame[17]\n"; + if ($signo{ALRM}) { + print "SIGALRM is $signo{ALRM}\n"; + } + +You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as +the handler, in which case Perl will try to discard the signal or do the +default thing. Some signals can be neither trapped nor ignored, such as +the KILL and STOP (but not the TSTP) signals. One strategy for +temporarily ignoring signals is to use a local() statement, which will be +automatically restored once your block is exited. (Remember that local() +values are "inherited" by functions called from within that block.) + + sub precious { + local $SIG{INT} = 'IGNORE'; + &more_functions; + } + sub more_functions { + # interrupts still ignored, for now... + } + +Sending a signal to a negative process ID means that you send the signal +to the entire Unix process-group. This code sends a hang-up signal to all +processes in the current process group (and sets $SIG{HUP} to IGNORE so +it doesn't kill itself): + + { + local $SIG{HUP} = 'IGNORE'; + kill HUP => -$$; + # snazzy writing of: kill('HUP', -$$) + } + +Another interesting signal to send is signal number zero. This doesn't +actually affect another process, but instead checks whether it's alive +or has changed its UID. + + unless (kill 0 => $kid_pid) { + warn "something wicked happened to $kid_pid"; + } + +You might also want to employ anonymous functions for simple signal +handlers: + + $SIG{INT} = sub { die "\nOutta here!\n" }; + +But that will be problematic for the more complicated handlers that need +to reinstall themselves. Because Perl's signal mechanism is currently +based on the signal(3) function from the C library, you may sometimes be so +misfortunate as to run on systems where that function is "broken", that +is, it behaves in the old unreliable SysV way rather than the newer, more +reasonable BSD and POSIX fashion. So you'll see defensive people writing +signal handlers like this: + + sub REAPER { + $waitedpid = wait; + # loathe sysV: it makes us not only reinstate + # the handler, but place it after the wait + $SIG{CHLD} = \&REAPER; + } + $SIG{CHLD} = \&REAPER; + # now do something that forks... + +or even the more elaborate: + + use POSIX ":sys_wait_h"; + sub REAPER { + my $child; + while ($child = waitpid(-1,WNOHANG)) { + $Kid_Status{$child} = $?; + } + $SIG{CHLD} = \&REAPER; # still loathe sysV + } + $SIG{CHLD} = \&REAPER; + # do something that forks... + +Signal handling is also used for timeouts in Unix, While safely +protected within an C block, you set a signal handler to trap +alarm signals and then schedule to have one delivered to you in some +number of seconds. Then try your blocking operation, clearing the alarm +when it's done but not before you've exited your C block. If it +goes off, you'll use die() to jump out of the block, much as you might +using longjmp() or throw() in other languages. + +Here's an example: + + eval { + local $SIG{ALRM} = sub { die "alarm clock restart" }; + alarm 10; + flock(FH, 2); # blocking write lock + alarm 0; + }; + if ($@ and $@ !~ /alarm clock restart/) { die } + +For more complex signal handling, you might see the standard POSIX +module. Lamentably, this is almost entirely undocumented, but +the F file from the Perl source distribution has some +examples in it. + +=head1 Named Pipes + +A named pipe (often referred to as a FIFO) is an old Unix IPC +mechanism for processes communicating on the same machine. It works +just like a regular, connected anonymous pipes, except that the +processes rendezvous using a filename and don't have to be related. + +To create a named pipe, use the Unix command mknod(1) or on some +systems, mkfifo(1). These may not be in your normal path. + + # system return val is backwards, so && not || + # + $ENV{PATH} .= ":/etc:/usr/etc"; + if ( system('mknod', $path, 'p') + && system('mkfifo', $path) ) + { + die "mk{nod,fifo} $path failed"; + } + + +A fifo is convenient when you want to connect a process to an unrelated +one. When you open a fifo, the program will block until there's something +on the other end. + +For example, let's say you'd like to have your F<.signature> file be a +named pipe that has a Perl program on the other end. Now every time any +program (like a mailer, news reader, finger program, etc.) tries to read +from that file, the reading program will block and your program will +supply the new signature. We'll use the pipe-checking file test B<-p> +to find out whether anyone (or anything) has accidentally removed our fifo. + + chdir; # go home + $FIFO = '.signature'; + $ENV{PATH} .= ":/etc:/usr/games"; + + while (1) { + unless (-p $FIFO) { + unlink $FIFO; + system('mknod', $FIFO, 'p') + && die "can't mknod $FIFO: $!"; + } + + # next line blocks until there's a reader + open (FIFO, "> $FIFO") || die "can't write $FIFO: $!"; + print FIFO "John Smith (smith\@host.org)\n", `fortune -s`; + close FIFO; + sleep 2; # to avoid dup signals + } + +=head2 WARNING + +By installing Perl code to deal with signals, you're exposing yourself +to danger from two things. First, few system library functions are +re-entrant. If the signal interrupts while Perl is executing one function +(like malloc(3) or printf(3)), and your signal handler then calls the +same function again, you could get unpredictable behavior--often, a +core dump. Second, Perl isn't itself re-entrant at the lowest levels. +If the signal interrupts Perl while Perl is changing its own internal +data structures, similarly unpredictable behaviour may result. + +There are two things you can do, knowing this: be paranoid or be +pragmatic. The paranoid approach is to do as little as possible in your +signal handler. Set an existing integer variable that already has a +value, and return. This doesn't help you if you're in a slow system call, +which will just restart. That means you have to C to longjump(3) out +of the handler. Even this is a little cavalier for the true paranoiac, +who avoids C in a handler because the system I out to get you. +The pragmatic approach is to say ``I know the risks, but prefer the +convenience'', and to do anything you want in your signal handler, +prepared to clean up core dumps now and again. + +To forbid signal handlers altogether would bars you from +many interesting programs, including virtually everything in this manpage, +since you could no longer even write SIGCHLD handlers. Their dodginess +is expected to be addresses in the 5.005 release. + + +=head1 Using open() for IPC + +Perl's basic open() statement can also be used for unidirectional interprocess +communication by either appending or prepending a pipe symbol to the second +argument to open(). Here's how to start something up in a child process you +intend to write to: + + open(SPOOLER, "| cat -v | lpr -h 2>/dev/null") + || die "can't fork: $!"; + local $SIG{PIPE} = sub { die "spooler pipe broke" }; + print SPOOLER "stuff\n"; + close SPOOLER || die "bad spool: $! $?"; + +And here's how to start up a child process you intend to read from: + + open(STATUS, "netstat -an 2>&1 |") + || die "can't fork: $!"; + while () { + next if /^(tcp|udp)/; + print; + } + close STATUS || die "bad netstat: $! $?"; + +If one can be sure that a particular program is a Perl script that is +expecting filenames in @ARGV, the clever programmer can write something +like this: + + % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile + +and irrespective of which shell it's called from, the Perl program will +read from the file F, the process F, standard input (F +in this case), the F file, the F command, and finally the F +file. Pretty nifty, eh? + +You might notice that you could use backticks for much the +same effect as opening a pipe for reading: + + print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`; + die "bad netstat" if $?; + +While this is true on the surface, it's much more efficient to process the +file one line or record at a time because then you don't have to read the +whole thing into memory at once. It also gives you finer control of the +whole process, letting you to kill off the child process early if you'd +like. + +Be careful to check both the open() and the close() return values. If +you're I to a pipe, you should also trap SIGPIPE. Otherwise, +think of what happens when you start up a pipe to a command that doesn't +exist: the open() will in all likelihood succeed (it only reflects the +fork()'s success), but then your output will fail--spectacularly. Perl +can't know whether the command worked because your command is actually +running in a separate process whose exec() might have failed. Therefore, +while readers of bogus commands return just a quick end of file, writers +to bogus command will trigger a signal they'd better be prepared to +handle. Consider: + + open(FH, "|bogus") or die "can't fork: $!"; + print FH "bang\n" or die "can't write: $!"; + close FH or die "can't close: $!"; + +That won't blow up until the close, and it will blow up with a SIGPIPE. +To catch it, you could use this: + + $SIG{PIPE} = 'IGNORE'; + open(FH, "|bogus") or die "can't fork: $!"; + print FH "bang\n" or die "can't write: $!"; + close FH or die "can't close: status=$?"; + +=head2 Filehandles + +Both the main process and any child processes it forks share the same +STDIN, STDOUT, and STDERR filehandles. If both processes try to access +them at once, strange things can happen. You'll certainly want to any +stdio flush output buffers before forking. You may also want to close +or reopen the filehandles for the child. You can get around this by +opening your pipe with open(), but on some systems this means that the +child process cannot outlive the parent. + +=head2 Background Processes + +You can run a command in the background with: + + system("cmd &"); + +The command's STDOUT and STDERR (and possibly STDIN, depending on your +shell) will be the same as the parent's. You won't need to catch +SIGCHLD because of the double-fork taking place (see below for more +details). + +=head2 Complete Dissociation of Child from Parent + +In some cases (starting server processes, for instance) you'll want to +complete dissociate the child process from the parent. The easiest +way is to use: + + use POSIX qw(setsid); + setsid() or die "Can't start a new session: $!"; + +However, you may not be on POSIX. The following process is reported +to work on most Unixish systems. Non-Unix users should check their +Your_OS::Process module for other solutions. + +=over 4 + +=item * + +Open /dev/tty and use the TIOCNOTTY ioctl on it. See L +for details. + +=item * + +Change directory to / + +=item * + +Reopen STDIN, STDOUT, and STDERR so they're not connected to the old +tty. + +=item * + +Background yourself like this: + + fork && exit; + +=item * + +Ignore hangup signals in case you're running on a shell that doesn't +automatically no-hup you: + + $SIG{HUP} = 'IGNORE'; # or whatever you'd like + +=back + +=head2 Safe Pipe Opens + +Another interesting approach to IPC is making your single program go +multiprocess and communicate between (or even amongst) yourselves. The +open() function will accept a file argument of either C<"-|"> or C<"|-"> +to do a very interesting thing: it forks a child connected to the +filehandle you've opened. The child is running the same program as the +parent. This is useful for safely opening a file when running under an +assumed UID or GID, for example. If you open a pipe I minus, you can +write to the filehandle you opened and your kid will find it in his +STDIN. If you open a pipe I minus, you can read from the filehandle +you opened whatever your kid writes to his STDOUT. + + use English; + my $sleep_count = 0; + + do { + $pid = open(KID_TO_WRITE, "|-"); + unless (defined $pid) { + warn "cannot fork: $!"; + die "bailing out" if $sleep_count++ > 6; + sleep 10; + } + } until defined $pid; + + if ($pid) { # parent + print KID_TO_WRITE @some_data; + close(KID_TO_WRITE) || warn "kid exited $?"; + } else { # child + ($EUID, $EGID) = ($UID, $GID); # suid progs only + open (FILE, "> /safe/file") + || die "can't open /safe/file: $!"; + while () { + print FILE; # child's STDIN is parent's KID + } + exit; # don't forget this + } + +Another common use for this construct is when you need to execute +something without the shell's interference. With system(), it's +straightforward, but you can't use a pipe open or backticks safely. +That's because there's no way to stop the shell from getting its hands on +your arguments. Instead, use lower-level control to call exec() directly. + +Here's a safe backtick or pipe open for read: + + # add error processing as above + $pid = open(KID_TO_READ, "-|"); + + if ($pid) { # parent + while () { + # do something interesting + } + close(KID_TO_READ) || warn "kid exited $?"; + + } else { # child + ($EUID, $EGID) = ($UID, $GID); # suid only + exec($program, @options, @args) + || die "can't exec program: $!"; + # NOTREACHED + } + + +And here's a safe pipe open for writing: + + # add error processing as above + $pid = open(KID_TO_WRITE, "|-"); + $SIG{ALRM} = sub { die "whoops, $program pipe broke" }; + + if ($pid) { # parent + for (@data) { + print KID_TO_WRITE; + } + close(KID_TO_WRITE) || warn "kid exited $?"; + + } else { # child + ($EUID, $EGID) = ($UID, $GID); + exec($program, @options, @args) + || die "can't exec program: $!"; + # NOTREACHED + } + +Note that these operations are full Unix forks, which means they may not be +correctly implemented on alien systems. Additionally, these are not true +multithreading. If you'd like to learn more about threading, see the +F file mentioned below in the SEE ALSO section. + +=head2 Bidirectional Communication with Another Process + +While this works reasonably well for unidirectional communication, what +about bidirectional communication? The obvious thing you'd like to do +doesn't actually work: + + open(PROG_FOR_READING_AND_WRITING, "| some program |") + +and if you forget to use the B<-w> flag, then you'll miss out +entirely on the diagnostic message: + + Can't do bidirectional pipe at -e line 1. + +If you really want to, you can use the standard open2() library function +to catch both ends. There's also an open3() for tridirectional I/O so you +can also catch your child's STDERR, but doing so would then require an +awkward select() loop and wouldn't allow you to use normal Perl input +operations. + +If you look at its source, you'll see that open2() uses low-level +primitives like Unix pipe() and exec() calls to create all the connections. +While it might have been slightly more efficient by using socketpair(), it +would have then been even less portable than it already is. The open2() +and open3() functions are unlikely to work anywhere except on a Unix +system or some other one purporting to be POSIX compliant. + +Here's an example of using open2(): + + use FileHandle; + use IPC::Open2; + $pid = open2(*Reader, *Writer, "cat -u -n" ); + Writer->autoflush(); # default here, actually + print Writer "stuff\n"; + $got = ; + +The problem with this is that Unix buffering is really going to +ruin your day. Even though your C filehandle is auto-flushed, +and the process on the other end will get your data in a timely manner, +you can't usually do anything to force it to give it back to you +in a similarly quick fashion. In this case, we could, because we +gave I a B<-u> flag to make it unbuffered. But very few Unix +commands are designed to operate over pipes, so this seldom works +unless you yourself wrote the program on the other end of the +double-ended pipe. + +A solution to this is the nonstandard F library. It uses +pseudo-ttys to make your program behave more reasonably: + + require 'Comm.pl'; + $ph = open_proc('cat -n'); + for (1..10) { + print $ph "a line\n"; + print "got back ", scalar <$ph>; + } + +This way you don't have to have control over the source code of the +program you're using. The F library also has expect() +and interact() functions. Find the library (and we hope its +successor F) at your nearest CPAN archive as detailed +in the SEE ALSO section below. + +The newer Expect.pm module from CPAN also addresses this kind of thing. +This module requires two other modules from CPAN: IO::Pty and IO::Stty. +It sets up a pseudo-terminal to interact with programs that insist on +using talking to the terminal device driver. If your system is +amongst those supported, this may be your best bet. + +=head2 Bidirectional Communication with Yourself + +If you want, you may make low-level pipe() and fork() +to stitch this together by hand. This example only +talks to itself, but you could reopen the appropriate +handles to STDIN and STDOUT and call other processes. + + #!/usr/bin/perl -w + # pipe1 - bidirectional communication using two pipe pairs + # designed for the socketpair-challenged + use IO::Handle; # thousands of lines just for autoflush :-( + pipe(PARENT_RDR, CHILD_WTR); # XXX: failure? + pipe(CHILD_RDR, PARENT_WTR); # XXX: failure? + CHILD_WTR->autoflush(1); + PARENT_WTR->autoflush(1); + + if ($pid = fork) { + close PARENT_RDR; close PARENT_WTR; + print CHILD_WTR "Parent Pid $$ is sending this\n"; + chomp($line = ); + print "Parent Pid $$ just read this: `$line'\n"; + close CHILD_RDR; close CHILD_WTR; + waitpid($pid,0); + } else { + die "cannot fork: $!" unless defined $pid; + close CHILD_RDR; close CHILD_WTR; + chomp($line = ); + print "Child Pid $$ just read this: `$line'\n"; + print PARENT_WTR "Child Pid $$ is sending this\n"; + close PARENT_RDR; close PARENT_WTR; + exit; + } + +But you don't actually have to make two pipe calls. If you +have the socketpair() system call, it will do this all for you. + + #!/usr/bin/perl -w + # pipe2 - bidirectional communication using socketpair + # "the best ones always go both ways" + + use Socket; + use IO::Handle; # thousands of lines just for autoflush :-( + # We say AF_UNIX because although *_LOCAL is the + # POSIX 1003.1g form of the constant, many machines + # still don't have it. + socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or die "socketpair: $!"; + + CHILD->autoflush(1); + PARENT->autoflush(1); + + if ($pid = fork) { + close PARENT; + print CHILD "Parent Pid $$ is sending this\n"; + chomp($line = ); + print "Parent Pid $$ just read this: `$line'\n"; + close CHILD; + waitpid($pid,0); + } else { + die "cannot fork: $!" unless defined $pid; + close CHILD; + chomp($line = ); + print "Child Pid $$ just read this: `$line'\n"; + print PARENT "Child Pid $$ is sending this\n"; + close PARENT; + exit; + } + +=head1 Sockets: Client/Server Communication + +While not limited to Unix-derived operating systems (e.g., WinSock on PCs +provides socket support, as do some VMS libraries), you may not have +sockets on your system, in which case this section probably isn't going to do +you much good. With sockets, you can do both virtual circuits (i.e., TCP +streams) and datagrams (i.e., UDP packets). You may be able to do even more +depending on your system. + +The Perl function calls for dealing with sockets have the same names as +the corresponding system calls in C, but their arguments tend to differ +for two reasons: first, Perl filehandles work differently than C file +descriptors. Second, Perl already knows the length of its strings, so you +don't need to pass that information. + +One of the major problems with old socket code in Perl was that it used +hard-coded values for some of the constants, which severely hurt +portability. If you ever see code that does anything like explicitly +setting C<$AF_INET = 2>, you know you're in for big trouble: An +immeasurably superior approach is to use the C module, which more +reliably grants access to various constants and functions you'll need. + +If you're not writing a server/client for an existing protocol like +NNTP or SMTP, you should give some thought to how your server will +know when the client has finished talking, and vice-versa. Most +protocols are based on one-line messages and responses (so one party +knows the other has finished when a "\n" is received) or multi-line +messages and responses that end with a period on an empty line +("\n.\n" terminates a message/response). + +=head2 Internet Line Terminators + +The Internet line terminator is "\015\012". Under ASCII variants of +Unix, that could usually be written as "\r\n", but under other systems, +"\r\n" might at times be "\015\015\012", "\012\012\015", or something +completely different. The standards specify writing "\015\012" to be +conformant (be strict in what you provide), but they also recommend +accepting a lone "\012" on input (but be lenient in what you require). +We haven't always been very good about that in the code in this manpage, +but unless you're on a Mac, you'll probably be ok. + +=head2 Internet TCP Clients and Servers + +Use Internet-domain sockets when you want to do client-server +communication that might extend to machines outside of your own system. + +Here's a sample TCP client using Internet-domain sockets: + + #!/usr/bin/perl -w + use strict; + use Socket; + my ($remote,$port, $iaddr, $paddr, $proto, $line); + + $remote = shift || 'localhost'; + $port = shift || 2345; # random port + if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') } + die "No port" unless $port; + $iaddr = inet_aton($remote) || die "no host: $remote"; + $paddr = sockaddr_in($port, $iaddr); + + $proto = getprotobyname('tcp'); + socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + connect(SOCK, $paddr) || die "connect: $!"; + while (defined($line = )) { + print $line; + } + + close (SOCK) || die "close: $!"; + exit; + +And here's a corresponding server to go along with it. We'll +leave the address as INADDR_ANY so that the kernel can choose +the appropriate interface on multihomed hosts. If you want sit +on a particular interface (like the external side of a gateway +or firewall machine), you should fill this in with your real address +instead. + + #!/usr/bin/perl -Tw + use strict; + BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + use Socket; + use Carp; + $EOL = "\015\012"; + + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + + my $port = shift || 2345; + my $proto = getprotobyname('tcp'); + $port = $1 if $port =~ /(\d+)/; # untaint port number + + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; + + logmsg "server started on port $port"; + + my $paddr; + + $SIG{CHLD} = \&REAPER; + + for ( ; $paddr = accept(Client,Server); close Client) { + my($port,$iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr,AF_INET); + + logmsg "connection from $name [", + inet_ntoa($iaddr), "] + at port $port"; + + print Client "Hello there, $name, it's now ", + scalar localtime, $EOL; + } + +And here's a multithreaded version. It's multithreaded in that +like most typical servers, it spawns (forks) a slave server to +handle the client request so that the master server can quickly +go back to service a new client. + + #!/usr/bin/perl -Tw + use strict; + BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + use Socket; + use Carp; + $EOL = "\015\012"; + + sub spawn; # forward declaration + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + + my $port = shift || 2345; + my $proto = getprotobyname('tcp'); + $port = $1 if $port =~ /(\d+)/; # untaint port number + + socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; + bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; + + logmsg "server started on port $port"; + + my $waitedpid = 0; + my $paddr; + + sub REAPER { + $waitedpid = wait; + $SIG{CHLD} = \&REAPER; # loathe sysV + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); + } + + $SIG{CHLD} = \&REAPER; + + for ( $waitedpid = 0; + ($paddr = accept(Client,Server)) || $waitedpid; + $waitedpid = 0, close Client) + { + next if $waitedpid and not $paddr; + my($port,$iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr,AF_INET); + + logmsg "connection from $name [", + inet_ntoa($iaddr), "] + at port $port"; + + spawn sub { + print "Hello there, $name, it's now ", scalar localtime, $EOL; + exec '/usr/games/fortune' # XXX: `wrong' line terminators + or confess "can't exec fortune: $!"; + }; + + } + + sub spawn { + my $coderef = shift; + + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + confess "usage: spawn CODEREF"; + } + + my $pid; + if (!defined($pid = fork)) { + logmsg "cannot fork: $!"; + return; + } elsif ($pid) { + logmsg "begat $pid"; + return; # I'm the parent + } + # else I'm the child -- go spawn + + open(STDIN, "<&Client") || die "can't dup client to stdin"; + open(STDOUT, ">&Client") || die "can't dup client to stdout"; + ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; + exit &$coderef(); + } + +This server takes the trouble to clone off a child version via fork() for +each incoming request. That way it can handle many requests at once, +which you might not always want. Even if you don't fork(), the listen() +will allow that many pending connections. Forking servers have to be +particularly careful about cleaning up their dead children (called +"zombies" in Unix parlance), because otherwise you'll quickly fill up your +process table. + +We suggest that you use the B<-T> flag to use taint checking (see L) +even if we aren't running setuid or setgid. This is always a good idea +for servers and other programs run on behalf of someone else (like CGI +scripts), because it lessens the chances that people from the outside will +be able to compromise your system. + +Let's look at another TCP client. This one connects to the TCP "time" +service on a number of different machines and shows how far their clocks +differ from the system on which it's being run: + + #!/usr/bin/perl -w + use strict; + use Socket; + + my $SECS_of_70_YEARS = 2208988800; + sub ctime { scalar localtime(shift) } + + my $iaddr = gethostbyname('localhost'); + my $proto = getprotobyname('tcp'); + my $port = getservbyname('time', 'tcp'); + my $paddr = sockaddr_in(0, $iaddr); + my($host); + + $| = 1; + printf "%-24s %8s %s\n", "localhost", 0, ctime(time()); + + foreach $host (@ARGV) { + printf "%-24s ", $host; + my $hisiaddr = inet_aton($host) || die "unknown host"; + my $hispaddr = sockaddr_in($port, $hisiaddr); + socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + connect(SOCKET, $hispaddr) || die "bind: $!"; + my $rtime = ' '; + read(SOCKET, $rtime, 4); + close(SOCKET); + my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ; + printf "%8d %s\n", $histime - time, ctime($histime); + } + +=head2 Unix-Domain TCP Clients and Servers + +That's fine for Internet-domain clients and servers, but what about local +communications? While you can use the same setup, sometimes you don't +want to. Unix-domain sockets are local to the current host, and are often +used internally to implement pipes. Unlike Internet domain sockets, Unix +domain sockets can show up in the file system with an ls(1) listing. + + % ls -l /dev/log + srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log + +You can test for these with Perl's B<-S> file test: + + unless ( -S '/dev/log' ) { + die "something's wicked with the print system"; + } + +Here's a sample Unix-domain client: + + #!/usr/bin/perl -w + use Socket; + use strict; + my ($rendezvous, $line); + + $rendezvous = shift || '/tmp/catsock'; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!"; + connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!"; + while (defined($line = )) { + print $line; + } + exit; + +And here's a corresponding server. You don't have to worry about silly +network terminators here because Unix domain sockets are guaranteed +to be on the localhost, and thus everything works right. + + #!/usr/bin/perl -Tw + use strict; + use Socket; + use Carp; + + BEGIN { $ENV{PATH} = '/usr/ucb:/bin' } + sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } + + my $NAME = '/tmp/catsock'; + my $uaddr = sockaddr_un($NAME); + my $proto = getprotobyname('tcp'); + + socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!"; + unlink($NAME); + bind (Server, $uaddr) || die "bind: $!"; + listen(Server,SOMAXCONN) || die "listen: $!"; + + logmsg "server started on $NAME"; + + my $waitedpid; + + sub REAPER { + $waitedpid = wait; + $SIG{CHLD} = \&REAPER; # loathe sysV + logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); + } + + $SIG{CHLD} = \&REAPER; + + + for ( $waitedpid = 0; + accept(Client,Server) || $waitedpid; + $waitedpid = 0, close Client) + { + next if $waitedpid; + logmsg "connection on $NAME"; + spawn sub { + print "Hello there, it's now ", scalar localtime, "\n"; + exec '/usr/games/fortune' or die "can't exec fortune: $!"; + }; + } + +As you see, it's remarkably similar to the Internet domain TCP server, so +much so, in fact, that we've omitted several duplicate functions--spawn(), +logmsg(), ctime(), and REAPER()--which are exactly the same as in the +other server. + +So why would you ever want to use a Unix domain socket instead of a +simpler named pipe? Because a named pipe doesn't give you sessions. You +can't tell one process's data from another's. With socket programming, +you get a separate session for each client: that's why accept() takes two +arguments. + +For example, let's say that you have a long running database server daemon +that you want folks from the World Wide Web to be able to access, but only +if they go through a CGI interface. You'd have a small, simple CGI +program that does whatever checks and logging you feel like, and then acts +as a Unix-domain client and connects to your private server. + +=head1 TCP Clients with IO::Socket + +For those preferring a higher-level interface to socket programming, the +IO::Socket module provides an object-oriented approach. IO::Socket is +included as part of the standard Perl distribution as of the 5.004 +release. If you're running an earlier version of Perl, just fetch +IO::Socket from CPAN, where you'll also find find modules providing easy +interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and +NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just +to name a few. + +=head2 A Simple Client + +Here's a client that creates a TCP connection to the "daytime" +service at port 13 of the host name "localhost" and prints out everything +that the server there cares to provide. + + #!/usr/bin/perl -w + use IO::Socket; + $remote = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => "localhost", + PeerPort => "daytime(13)", + ) + or die "cannot connect to daytime port at localhost"; + while ( <$remote> ) { print } + +When you run this program, you should get something back that +looks like this: + + Wed May 14 08:40:46 MDT 1997 + +Here are what those parameters to the C constructor mean: + +=over + +=item C + +This is which protocol to use. In this case, the socket handle returned +will be connected to a TCP socket, because we want a stream-oriented +connection, that is, one that acts pretty much like a plain old file. +Not all sockets are this of this type. For example, the UDP protocol +can be used to make a datagram socket, used for message-passing. + +=item C + +This is the name or Internet address of the remote host the server is +running on. We could have specified a longer name like C<"www.perl.com">, +or an address like C<"204.148.40.9">. For demonstration purposes, we've +used the special hostname C<"localhost">, which should always mean the +current machine you're running on. The corresponding Internet address +for localhost is C<"127.1">, if you'd rather use that. + +=item C + +This is the service name or port number we'd like to connect to. +We could have gotten away with using just C<"daytime"> on systems with a +well-configured system services file,[FOOTNOTE: The system services file +is in I under Unix] but just in case, we've specified the +port number (13) in parentheses. Using just the number would also have +worked, but constant numbers make careful programmers nervous. + +=back + +Notice how the return value from the C constructor is used as +a filehandle in the C loop? That's what's called an indirect +filehandle, a scalar variable containing a filehandle. You can use +it the same way you would a normal filehandle. For example, you +can read one line from it this way: + + $line = <$handle>; + +all remaining lines from is this way: + + @lines = <$handle>; + +and send a line of data to it this way: + + print $handle "some data\n"; + +=head2 A Webget Client + +Here's a simple client that takes a remote host to fetch a document +from, and then a list of documents to get from that host. This is a +more interesting client than the previous one because it first sends +something to the server before fetching the server's response. + + #!/usr/bin/perl -w + use IO::Socket; + unless (@ARGV > 1) { die "usage: $0 host document ..." } + $host = shift(@ARGV); + $EOL = "\015\012"; + $BLANK = $EOL x 2; + foreach $document ( @ARGV ) { + $remote = IO::Socket::INET->new( Proto => "tcp", + PeerAddr => $host, + PeerPort => "http(80)", + ); + unless ($remote) { die "cannot connect to http daemon on $host" } + $remote->autoflush(1); + print $remote "GET $document HTTP/1.0" . $BLANK; + while ( <$remote> ) { print } + close $remote; + } + +The web server handing the "http" service, which is assumed to be at +its standard port, number 80. If your the web server you're trying to +connect to is at a different port (like 1080 or 8080), you should specify +as the named-parameter pair, C 8080>. The C +method is used on the socket because otherwise the system would buffer +up the output we sent it. (If you're on a Mac, you'll also need to +change every C<"\n"> in your code that sends data over the network to +be a C<"\015\012"> instead.) + +Connecting to the server is only the first part of the process: once you +have the connection, you have to use the server's language. Each server +on the network has its own little command language that it expects as +input. The string that we send to the server starting with "GET" is in +HTTP syntax. In this case, we simply request each specified document. +Yes, we really are making a new connection for each document, even though +it's the same host. That's the way you always used to have to speak HTTP. +Recent versions of web browsers may request that the remote server leave +the connection open a little while, but the server doesn't have to honor +such a request. + +Here's an example of running that program, which we'll call I: + + % webget www.perl.com /guanaco.html + HTTP/1.1 404 File Not Found + Date: Thu, 08 May 1997 18:02:32 GMT + Server: Apache/1.2b6 + Connection: close + Content-type: text/html + + 404 File Not Found +

    File Not Found

    + The requested URL /guanaco.html was not found on this server.

    + + +Ok, so that's not very interesting, because it didn't find that +particular document. But a long response wouldn't have fit on this page. + +For a more fully-featured version of this program, you should look to +the I program included with the LWP modules from CPAN. + +=head2 Interactive Client with IO::Socket + +Well, that's all fine if you want to send one command and get one answer, +but what about setting up something fully interactive, somewhat like +the way I works? That way you can type a line, get the answer, +type a line, get the answer, etc. + +This client is more complicated than the two we've done so far, but if +you're on a system that supports the powerful C call, the solution +isn't that rough. Once you've made the connection to whatever service +you'd like to chat with, call C to clone your process. Each of +these two identical process has a very simple job to do: the parent +copies everything from the socket to standard output, while the child +simultaneously copies everything from standard input to the socket. +To accomplish the same thing using just one process would be I +harder, because it's easier to code two processes to do one thing than it +is to code one process to do two things. (This keep-it-simple principle +a cornerstones of the Unix philosophy, and good software engineering as +well, which is probably why it's spread to other systems.) + +Here's the code: + + #!/usr/bin/perl -w + use strict; + use IO::Socket; + my ($host, $port, $kidpid, $handle, $line); + + unless (@ARGV == 2) { die "usage: $0 host port" } + ($host, $port) = @ARGV; + + # create a tcp connection to the specified host and port + $handle = IO::Socket::INET->new(Proto => "tcp", + PeerAddr => $host, + PeerPort => $port) + or die "can't connect to port $port on $host: $!"; + + $handle->autoflush(1); # so output gets there right away + print STDERR "[Connected to $host:$port]\n"; + + # split the program into two processes, identical twins + die "can't fork: $!" unless defined($kidpid = fork()); + + # the if{} block runs only in the parent process + if ($kidpid) { + # copy the socket to standard output + while (defined ($line = <$handle>)) { + print STDOUT $line; + } + kill("TERM", $kidpid); # send SIGTERM to child + } + # the else{} block runs only in the child process + else { + # copy standard input to the socket + while (defined ($line = )) { + print $handle $line; + } + } + +The C function in the parent's C block is there to send a +signal to our child process (current running in the C block) +as soon as the remote server has closed its end of the connection. + +If the remote server sends data a byte at time, and you need that +data immediately without waiting for a newline (which might not happen), +you may wish to replace the C loop in the parent with the +following: + + my $byte; + while (sysread($handle, $byte, 1) == 1) { + print STDOUT $byte; + } + +Making a system call for each byte you want to read is not very efficient +(to put it mildly) but is the simplest to explain and works reasonably +well. + +=head1 TCP Servers with IO::Socket + +As always, setting up a server is little bit more involved than running a client. +The model is that the server creates a special kind of socket that +does nothing but listen on a particular port for incoming connections. +It does this by calling the Cnew()> method with +slightly different arguments than the client did. + +=over + +=item Proto + +This is which protocol to use. Like our clients, we'll +still specify C<"tcp"> here. + +=item LocalPort + +We specify a local +port in the C argument, which we didn't do for the client. +This is service name or port number for which you want to be the +server. (Under Unix, ports under 1024 are restricted to the +superuser.) In our sample, we'll use port 9000, but you can use +any port that's not currently in use on your system. If you try +to use one already in used, you'll get an "Address already in use" +message. Under Unix, the C command will show +which services current have servers. + +=item Listen + +The C parameter is set to the maximum number of +pending connections we can accept until we turn away incoming clients. +Think of it as a call-waiting queue for your telephone. +The low-level Socket module has a special symbol for the system maximum, which +is SOMAXCONN. + +=item Reuse + +The C parameter is needed so that we restart our server +manually without waiting a few minutes to allow system buffers to +clear out. + +=back + +Once the generic server socket has been created using the parameters +listed above, the server then waits for a new client to connect +to it. The server blocks in the C method, which eventually an +bidirectional connection to the remote client. (Make sure to autoflush +this handle to circumvent buffering.) + +To add to user-friendliness, our server prompts the user for commands. +Most servers don't do this. Because of the prompt without a newline, +you'll have to use the C variant of the interactive client above. + +This server accepts one of five different commands, sending output +back to the client. Note that unlike most network servers, this one +only handles one incoming client at a time. Multithreaded servers are +covered in Chapter 6 of the Camel as well as later in this manpage. + +Here's the code. We'll + + #!/usr/bin/perl -w + use IO::Socket; + use Net::hostent; # for OO version of gethostbyaddr + + $PORT = 9000; # pick something not in use + + $server = IO::Socket::INET->new( Proto => 'tcp', + LocalPort => $PORT, + Listen => SOMAXCONN, + Reuse => 1); + + die "can't setup server" unless $server; + print "[Server $0 accepting clients]\n"; + + while ($client = $server->accept()) { + $client->autoflush(1); + print $client "Welcome to $0; type help for command list.\n"; + $hostinfo = gethostbyaddr($client->peeraddr); + printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost; + print $client "Command? "; + while ( <$client>) { + next unless /\S/; # blank line + if (/quit|exit/i) { last; } + elsif (/date|time/i) { printf $client "%s\n", scalar localtime; } + elsif (/who/i ) { print $client `who 2>&1`; } + elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; } + elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; } + else { + print $client "Commands: quit date who cookie motd\n"; + } + } continue { + print $client "Command? "; + } + close $client; + } + +=head1 UDP: Message Passing + +Another kind of client-server setup is one that uses not connections, but +messages. UDP communications involve much lower overhead but also provide +less reliability, as there are no promises that messages will arrive at +all, let alone in order and unmangled. Still, UDP offers some advantages +over TCP, including being able to "broadcast" or "multicast" to a whole +bunch of destination hosts at once (usually on your local subnet). If you +find yourself overly concerned about reliability and start building checks +into your message system, then you probably should use just TCP to start +with. + +Here's a UDP program similar to the sample Internet TCP client given +earlier. However, instead of checking one host at a time, the UDP version +will check many of them asynchronously by simulating a multicast and then +using select() to do a timed-out wait for I/O. To do something similar +with TCP, you'd have to use a different socket handle for each host. + + #!/usr/bin/perl -w + use strict; + use Socket; + use Sys::Hostname; + + my ( $count, $hisiaddr, $hispaddr, $histime, + $host, $iaddr, $paddr, $port, $proto, + $rin, $rout, $rtime, $SECS_of_70_YEARS); + + $SECS_of_70_YEARS = 2208988800; + + $iaddr = gethostbyname(hostname()); + $proto = getprotobyname('udp'); + $port = getservbyname('time', 'udp'); + $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick + + socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!"; + bind(SOCKET, $paddr) || die "bind: $!"; + + $| = 1; + printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time; + $count = 0; + for $host (@ARGV) { + $count++; + $hisiaddr = inet_aton($host) || die "unknown host"; + $hispaddr = sockaddr_in($port, $hisiaddr); + defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!"; + } + + $rin = ''; + vec($rin, fileno(SOCKET), 1) = 1; + + # timeout after 10.0 seconds + while ($count && select($rout = $rin, undef, undef, 10.0)) { + $rtime = ''; + ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!"; + ($port, $hisiaddr) = sockaddr_in($hispaddr); + $host = gethostbyaddr($hisiaddr, AF_INET); + $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ; + printf "%-12s ", $host; + printf "%8d %s\n", $histime - time, scalar localtime($histime); + $count--; + } + +=head1 SysV IPC + +While System V IPC isn't so widely used as sockets, it still has some +interesting uses. You can't, however, effectively use SysV IPC or +Berkeley mmap() to have shared memory so as to share a variable amongst +several processes. That's because Perl would reallocate your string when +you weren't wanting it to. + +Here's a small example showing shared memory usage. + + use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO); + + $size = 2000; + $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!"; + print "shm key $key\n"; + + $message = "Message #1"; + shmwrite($key, $message, 0, 60) || die "$!"; + print "wrote: '$message'\n"; + shmread($key, $buff, 0, 60) || die "$!"; + print "read : '$buff'\n"; + + # the buffer of shmread is zero-character end-padded. + substr($buff, index($buff, "\0")) = ''; + print "un" unless $buff eq $message; + print "swell\n"; + + print "deleting shm $key\n"; + shmctl($key, IPC_RMID, 0) || die "$!"; + +Here's an example of a semaphore: + + use IPC::SysV qw(IPC_CREAT); + + $IPC_KEY = 1234; + $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!"; + print "shm key $key\n"; + +Put this code in a separate file to be run in more than one process. +Call the file F: + + # create a semaphore + + $IPC_KEY = 1234; + $key = semget($IPC_KEY, 0 , 0 ); + die if !defined($key); + + $semnum = 0; + $semflag = 0; + + # 'take' semaphore + # wait for semaphore to be zero + $semop = 0; + $opstring1 = pack("sss", $semnum, $semop, $semflag); + + # Increment the semaphore count + $semop = 1; + $opstring2 = pack("sss", $semnum, $semop, $semflag); + $opstring = $opstring1 . $opstring2; + + semop($key,$opstring) || die "$!"; + +Put this code in a separate file to be run in more than one process. +Call this file F: + + # 'give' the semaphore + # run this in the original process and you will see + # that the second process continues + + $IPC_KEY = 1234; + $key = semget($IPC_KEY, 0, 0); + die if !defined($key); + + $semnum = 0; + $semflag = 0; + + # Decrement the semaphore count + $semop = -1; + $opstring = pack("sss", $semnum, $semop, $semflag); + + semop($key,$opstring) || die "$!"; + +The SysV IPC code above was written long ago, and it's definitely +clunky looking. For a more modern look, see the IPC::SysV module +which is included with Perl starting from Perl 5.005. + +=head1 NOTES + +Most of these routines quietly but politely return C when they +fail instead of causing your program to die right then and there due to +an uncaught exception. (Actually, some of the new I conversion +functions croak() on bad arguments.) It is therefore essential to +check return values from these functions. Always begin your socket +programs this way for optimal success, and don't forget to add B<-T> +taint checking flag to the #! line for servers: + + #!/usr/bin/perl -Tw + use strict; + use sigtrap; + use Socket; + +=head1 BUGS + +All these routines create system-specific portability problems. As noted +elsewhere, Perl is at the mercy of your C libraries for much of its system +behaviour. It's probably safest to assume broken SysV semantics for +signals and to stick with simple TCP and UDP socket operations; e.g., don't +try to pass open file descriptors over a local UDP datagram socket if you +want your code to stand a chance of being portable. + +As mentioned in the signals section, because few vendors provide C +libraries that are safely re-entrant, the prudent programmer will do +little else within a handler beyond setting a numeric variable that +already exists; or, if locked into a slow (restarting) system call, +using die() to raise an exception and longjmp(3) out. In fact, even +these may in some cases cause a core dump. It's probably best to avoid +signals except where they are absolutely inevitable. This +will be addressed in a future release of Perl. + +=head1 AUTHOR + +Tom Christiansen, with occasional vestiges of Larry Wall's original +version and suggestions from the Perl Porters. + +=head1 SEE ALSO + +There's a lot more to networking than this, but this should get you +started. + +For intrepid programmers, the indispensable textbook is I by W. Richard Stevens (published by Addison-Wesley). Note +that most books on networking address networking from the perspective of +a C programmer; translation to Perl is left as an exercise for the reader. + +The IO::Socket(3) manpage describes the object library, and the Socket(3) +manpage describes the low-level interface to sockets. Besides the obvious +functions in L, you should also check out the F file +at your nearest CPAN site. (See L or best yet, the F for a description of what CPAN is and where to get it.) + +Section 5 of the F file is devoted to "Networking, Device Control +(modems), and Interprocess Communication", and contains numerous unbundled +modules numerous networking modules, Chat and Expect operations, CGI +programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet, +Threads, and ToolTalk--just to name a few. diff --git a/contrib/perl5/pod/perllocale.pod b/contrib/perl5/pod/perllocale.pod new file mode 100644 index 00000000000..4401be20535 --- /dev/null +++ b/contrib/perl5/pod/perllocale.pod @@ -0,0 +1,976 @@ +=head1 NAME + +perllocale - Perl locale handling (internationalization and localization) + +=head1 DESCRIPTION + +Perl supports language-specific notions of data such as "is this +a letter", "what is the uppercase equivalent of this letter", and +"which of these letters comes first". These are important issues, +especially for languages other than English--but also for English: it +would be naEve to imagine that C defines all the "letters" +needed to write in English. Perl is also aware that some character other +than '.' may be preferred as a decimal point, and that output date +representations may be language-specific. The process of making an +application take account of its users' preferences in such matters is +called B (often abbreviated as B); telling +such an application about a particular set of preferences is known as +B (B). + +Perl can understand language-specific data via the standardized (ISO C, +XPG4, POSIX 1.c) method called "the locale system". The locale system is +controlled per application using one pragma, one function call, and +several environment variables. + +B: This feature is new in Perl 5.004, and does not apply unless an +application specifically requests it--see L. +The one exception is that write() now B uses the current locale +- see L<"NOTES">. + +=head1 PREPARING TO USE LOCALES + +If Perl applications are to understand and present your data +correctly according a locale of your choice, B of the following +must be true: + +=over 4 + +=item * + +B. If it does, +you should find that the setlocale() function is a documented part of +its C library. + +=item * + +B. You, or +your system administrator, must make sure that this is the case. The +available locales, the location in which they are kept, and the manner +in which they are installed all vary from system to system. Some systems +provide only a few, hard-wired locales and do not allow more to be +added. Others allow you to add "canned" locales provided by the system +supplier. Still others allow you or the system administrator to define +and add arbitrary locales. (You may have to ask your supplier to +provide canned locales that are not delivered with your operating +system.) Read your system documentation for further illumination. + +=item * + +B. If it does, +C will say that the value for C is +C. + +=back + +If you want a Perl application to process and present your data +according to a particular locale, the application code should include +the S> pragma (see L) where +appropriate, and B of the following must be true: + +=over 4 + +=item * + +B) +must be correctly set up> at the time the application is started, either +by yourself or by whoever set up your system account. + +=item * + +B using the method described in +L. + +=back + +=head1 USING LOCALES + +=head2 The use locale pragma + +By default, Perl ignores the current locale. The S> +pragma tells Perl to use the current locale for some operations: + +=over 4 + +=item * + +B (C, C, C, C, and C) and +the POSIX string collation functions strcoll() and strxfrm() use +C. sort() is also affected if used without an +explicit comparison function, because it uses C by default. + +B C and C are unaffected by locale: they always +perform a byte-by-byte comparison of their scalar operands. What's +more, if C finds that its operands are equal according to the +collation sequence specified by the current locale, it goes on to +perform a byte-by-byte comparison, and only returns I<0> (equal) if the +operands are bit-for-bit identical. If you really want to know whether +two strings--which C and C may consider different--are equal +as far as collation in the locale is concerned, see the discussion in +L. + +=item * + +B (uc(), lc(), +ucfirst(), and lcfirst()) use C + +=item * + +B (printf(), sprintf() and write()) use +C + +=item * + +B (strftime()) uses C. + +=back + +C, C, and so on, are discussed further in L. + +The default behavior is restored with the S> pragma, or +upon reaching the end of block enclosing C. + +The string result of any operation that uses locale +information is tainted, as it is possible for a locale to be +untrustworthy. See L<"SECURITY">. + +=head2 The setlocale function + +You can switch locales as often as you wish at run time with the +POSIX::setlocale() function: + + # This functionality not usable prior to Perl 5.004 + require 5.004; + + # Import locale-handling tool set from POSIX module. + # This example uses: setlocale -- the function call + # LC_CTYPE -- explained below + use POSIX qw(locale_h); + + # query and save the old locale + $old_locale = setlocale(LC_CTYPE); + + setlocale(LC_CTYPE, "fr_CA.ISO8859-1"); + # LC_CTYPE now in locale "French, Canada, codeset ISO 8859-1" + + setlocale(LC_CTYPE, ""); + # LC_CTYPE now reset to default defined by LC_ALL/LC_CTYPE/LANG + # environment variables. See below for documentation. + + # restore the old locale + setlocale(LC_CTYPE, $old_locale); + +The first argument of setlocale() gives the B, the second the +B. The category tells in what aspect of data processing you +want to apply locale-specific rules. Category names are discussed in +L and L<"ENVIRONMENT">. The locale is the name of a +collection of customization information corresponding to a particular +combination of language, country or territory, and codeset. Read on for +hints on the naming of locales: not all systems name locales as in the +example. + +If no second argument is provided and the category is something else +than LC_ALL, the function returns a string naming the current locale +for the category. You can use this value as the second argument in a +subsequent call to setlocale(). + +If no second argument is provided and the category is LC_ALL, the +result is implementation-dependent. It may be a string of +concatenated locales names (separator also implementation-dependent) +or a single locale name. Please consult your L for +details. + +If a second argument is given and it corresponds to a valid locale, +the locale for the category is set to that value, and the function +returns the now-current locale value. You can then use this in yet +another call to setlocale(). (In some implementations, the return +value may sometimes differ from the value you gave as the second +argument--think of it as an alias for the value you gave.) + +As the example shows, if the second argument is an empty string, the +category's locale is returned to the default specified by the +corresponding environment variables. Generally, this results in a +return to the default that was in force when Perl started up: changes +to the environment made by the application after startup may or may not +be noticed, depending on your system's C library. + +If the second argument does not correspond to a valid locale, the locale +for the category is not changed, and the function returns I. + +For further information about the categories, consult L. + +=head2 Finding locales + +For locales available in your system, consult also L to +see whether it leads to the list of available locales (search for the +I section). If that fails, try the following command lines: + + locale -a + + nlsinfo + + ls /usr/lib/nls/loc + + ls /usr/lib/locale + + ls /usr/lib/nls + +and see whether they list something resembling these + + en_US.ISO8859-1 de_DE.ISO8859-1 ru_RU.ISO8859-5 + en_US.iso88591 de_DE.iso88591 ru_RU.iso88595 + en_US de_DE ru_RU + en de ru + english german russian + english.iso88591 german.iso88591 russian.iso88595 + english.roman8 russian.koi8r + +Sadly, even though the calling interface for setlocale() has +been standardized, names of locales and the directories where the +configuration resides have not been. The basic form of the name is +IB<.>I, but the latter parts after +I are not always present. The I and I are +usually from the standards B and B, the two-letter +abbreviations for the countries and the languages of the world, +respectively. The I part often mentions some B +character set, the Latin codesets. For example, C is the +so-called "Western codeset" that can be used to encode most Western +European languages. Again, there are several ways to write even the +name of that one standard. Lamentably. + +Two special locales are worth particular mention: "C" and "POSIX". +Currently these are effectively the same locale: the difference is +mainly that the first one is defined by the C standard, the second by +the POSIX standard. They define the B in which +every program starts in the absence of locale information in its +environment. (The I default locale, if you will.) Its language +is (American) English and its character codeset ASCII. + +B: Not all systems have the "POSIX" locale (not all systems are +POSIX-conformant), so use "C" when you need explicitly to specify this +default locale. + +=head2 LOCALE PROBLEMS + +You may encounter the following warning message at Perl startup: + + perl: warning: Setting locale failed. + perl: warning: Please check that your locale settings: + LC_ALL = "En_US", + LANG = (unset) + are supported and installed on your system. + perl: warning: Falling back to the standard locale ("C"). + +This means that your locale settings had LC_ALL set to "En_US" and +LANG exists but has no value. Perl tried to believe you but could not. +Instead, Perl gave up and fell back to the "C" locale, the default locale +that is supposed to work no matter what. This usually means your locale +settings were wrong, they mention locales your system has never heard +of, or the locale installation in your system has problems (for example, +some system files are broken or missing). There are quick and temporary +fixes to these problems, as well as more thorough and lasting fixes. + +=head2 Temporarily fixing locale problems + +The two quickest fixes are either to render Perl silent about any +locale inconsistencies or to run Perl under the default locale "C". + +Perl's moaning about locale problems can be silenced by setting the +environment variable PERL_BADLANG to a non-zero value, for example +"1". This method really just sweeps the problem under the carpet: you +tell Perl to shut up even when Perl sees that something is wrong. Do +not be surprised if later something locale-dependent misbehaves. + +Perl can be run under the "C" locale by setting the environment +variable LC_ALL to "C". This method is perhaps a bit more civilized +than the PERL_BADLANG approach, but setting LC_ALL (or +other locale variables) may affect other programs as well, not just +Perl. In particular, external programs run from within Perl will see +these changes. If you make the new settings permanent (read on), all +programs you run see the changes. See L for for +the full list of relevant environment variables and L +for their effects in Perl. Effects in other programs are +easily deducible. For example, the variable LC_COLLATE may well affect +your B program (or whatever the program that arranges `records' +alphabetically in your system is called). + +You can test out changing these variables temporarily, and if the +new settings seem to help, put those settings into your shell startup +files. Consult your local documentation for the exact details. For in +Bourne-like shells (B, B, B, B): + + LC_ALL=en_US.ISO8859-1 + export LC_ALL + +This assumes that we saw the locale "en_US.ISO8859-1" using the commands +discussed above. We decided to try that instead of the above faulty +locale "En_US"--and in Cshish shells (B, B) + + setenv LC_ALL en_US.ISO8859-1 + +If you do not know what shell you have, consult your local +helpdesk or the equivalent. + +=head2 Permanently fixing locale problems + +The slower but superior fixes are when you may be able to yourself +fix the misconfiguration of your own environment variables. The +mis(sing)configuration of the whole system's locales usually requires +the help of your friendly system administrator. + +First, see earlier in this document about L. That tells +how to find which locales are really supported--and more importantly, +installed--on your system. In our example error message, environment +variables affecting the locale are listed in the order of decreasing +importance (and unset variables do not matter). Therefore, having +LC_ALL set to "En_US" must have been the bad choice, as shown by the +error message. First try fixing locale settings listed first. + +Second, if using the listed commands you see something B +(prefix matches do not count and case usually counts) like "En_US" +without the quotes, then you should be okay because you are using a +locale name that should be installed and available in your system. +In this case, see L. + +=head2 Permanently fixing your locale configuration + +This is when you see something like: + + perl: warning: Please check that your locale settings: + LC_ALL = "En_US", + LANG = (unset) + are supported and installed on your system. + +but then cannot see that "En_US" listed by the above-mentioned +commands. You may see things like "en_US.ISO8859-1", but that isn't +the same. In this case, try running under a locale +that you can list and which somehow matches what you tried. The +rules for matching locale names are a bit vague because +standardization is weak in this area. See again the L about general rules. + +=head2 Permanently fixing system locale configuration + +Contact a system administrator (preferably your own) and report the exact +error message you get, and ask them to read this same documentation you +are now reading. They should be able to check whether there is something +wrong with the locale configuration of the system. The L +section is unfortunately a bit vague about the exact commands and places +because these things are not that standardized. + +=head2 The localeconv function + +The POSIX::localeconv() function allows you to get particulars of the +locale-dependent numeric formatting information specified by the current +C and C locales. (If you just want the name of +the current locale for a particular category, use POSIX::setlocale() +with a single parameter--see L.) + + use POSIX qw(locale_h); + + # Get a reference to a hash of locale-dependent info + $locale_values = localeconv(); + + # Output sorted list of the values + for (sort keys %$locale_values) { + printf "%-20s = %s\n", $_, $locale_values->{$_} + } + +localeconv() takes no arguments, and returns B a hash. +The keys of this hash are variable names for formatting, such as +C and C. The values are the +corresponding, er, values. See L for a longer +example listing the categories an implementation might be expected to +provide; some provide more and others fewer. You don't need an +explicit C, because localeconv() always observes the +current locale. + +Here's a simple-minded example program that rewrites its command-line +parameters as integers correctly formatted in the current locale: + + # See comments in previous example + require 5.004; + use POSIX qw(locale_h); + + # Get some of locale's numeric formatting parameters + my ($thousands_sep, $grouping) = + @{localeconv()}{'thousands_sep', 'grouping'}; + + # Apply defaults if values are missing + $thousands_sep = ',' unless $thousands_sep; + + # grouping and mon_grouping are packed lists + # of small integers (characters) telling the + # grouping (thousand_seps and mon_thousand_seps + # being the group dividers) of numbers and + # monetary quantities. The integers' meanings: + # 255 means no more grouping, 0 means repeat + # the previous grouping, 1-254 means use that + # as the current grouping. Grouping goes from + # right to left (low to high digits). In the + # below we cheat slightly by never using anything + # else than the first grouping (whatever that is). + if ($grouping) { + @grouping = unpack("C*", $grouping); + } else { + @grouping = (3); + } + + # Format command line params for current locale + for (@ARGV) { + $_ = int; # Chop non-integer part + 1 while + s/(\d)(\d{$grouping[0]}($|$thousands_sep))/$1$thousands_sep$2/; + print "$_"; + } + print "\n"; + +=head1 LOCALE CATEGORIES + +The following subsections describe basic locale categories. Beyond these, +some combination categories allow manipulation of more than one +basic category at a time. See L<"ENVIRONMENT"> for a discussion of these. + +=head2 Category LC_COLLATE: Collation + +In the scope of S>, Perl looks to the C +environment variable to determine the application's notions on collation +(ordering) of characters. For example, 'b' follows 'a' in Latin +alphabets, but where do 'E' and 'E' belong? And while +'color' follows 'chocolate' in English, what about in Spanish? + +The following collations all make sense and you may meet any of them +if you "use locale". + + A B C D E a b c d e + A a B b C c D d D e + a A b B c C d D e E + a b c d e A B C D E + +Here is a code snippet to tell what alphanumeric +characters are in the current locale, in that locale's order: + + use locale; + print +(sort grep /\w/, map { chr() } 0..255), "\n"; + +Compare this with the characters that you see and their order if you +state explicitly that the locale should be ignored: + + no locale; + print +(sort grep /\w/, map { chr() } 0..255), "\n"; + +This machine-native collation (which is what you get unless S> has appeared earlier in the same block) must be used for +sorting raw binary data, whereas the locale-dependent collation of the +first example is useful for natural text. + +As noted in L, C compares according to the current +collation locale when C is in effect, but falls back to a +byte-by-byte comparison for strings that the locale says are equal. You +can use POSIX::strcoll() if you don't want this fall-back: + + use POSIX qw(strcoll); + $equal_in_locale = + !strcoll("space and case ignored", "SpaceAndCaseIgnored"); + +$equal_in_locale will be true if the collation locale specifies a +dictionary-like ordering that ignores space characters completely and +which folds case. + +If you have a single string that you want to check for "equality in +locale" against several others, you might think you could gain a little +efficiency by using POSIX::strxfrm() in conjunction with C: + + use POSIX qw(strxfrm); + $xfrm_string = strxfrm("Mixed-case string"); + print "locale collation ignores spaces\n" + if $xfrm_string eq strxfrm("Mixed-casestring"); + print "locale collation ignores hyphens\n" + if $xfrm_string eq strxfrm("Mixedcase string"); + print "locale collation ignores case\n" + if $xfrm_string eq strxfrm("mixed-case string"); + +strxfrm() takes a string and maps it into a transformed string for use +in byte-by-byte comparisons against other transformed strings during +collation. "Under the hood", locale-affected Perl comparison operators +call strxfrm() for both operands, then do a byte-by-byte +comparison of the transformed strings. By calling strxfrm() explicitly +and using a non locale-affected comparison, the example attempts to save +a couple of transformations. But in fact, it doesn't save anything: Perl +magic (see L) creates the transformed version of a +string the first time it's needed in a comparison, then keeps this version around +in case it's needed again. An example rewritten the easy way with +C runs just about as fast. It also copes with null characters +embedded in strings; if you call strxfrm() directly, it treats the first +null it finds as a terminator. don't expect the transformed strings +it produces to be portable across systems--or even from one revision +of your operating system to the next. In short, don't call strxfrm() +directly: let Perl do it for you. + +Note: C isn't shown in some of these examples because it isn't +needed: strcoll() and strxfrm() exist only to generate locale-dependent +results, and so always obey the current C locale. + +=head2 Category LC_CTYPE: Character Types + +In the scope of S>, Perl obeys the C locale +setting. This controls the application's notion of which characters are +alphabetic. This affects Perl's C<\w> regular expression metanotation, +which stands for alphanumeric characters--that is, alphabetic and +numeric characters. (Consult L for more information about +regular expressions.) Thanks to C, depending on your locale +setting, characters like 'E', 'E', 'E', and +'E' may be understood as C<\w> characters. + +The C locale also provides the map used in transliterating +characters between lower and uppercase. This affects the case-mapping +functions--lc(), lcfirst, uc(), and ucfirst(); case-mapping +interpolation with C<\l>, C<\L>, C<\u>, or C<\U> in double-quoted strings +and C substitutions; and case-independent regular expression +pattern matching using the C modifier. + +Finally, C affects the POSIX character-class test +functions--isalpha(), islower(), and so on. For example, if you move +from the "C" locale to a 7-bit Scandinavian one, you may find--possibly +to your surprise--that "|" moves from the ispunct() class to isalpha(). + +B A broken or malicious C locale definition may result +in clearly ineligible characters being considered to be alphanumeric by +your application. For strict matching of (mundane) letters and +digits--for example, in command strings--locale-aware applications +should use C<\w> inside a C block. See L<"SECURITY">. + +=head2 Category LC_NUMERIC: Numeric Formatting + +In the scope of S>, Perl obeys the C locale +information, which controls an application's idea of how numbers should +be formatted for human readability by the printf(), sprintf(), and +write() functions. String-to-numeric conversion by the POSIX::strtod() +function is also affected. In most implementations the only effect is to +change the character used for the decimal point--perhaps from '.' to ','. +These functions aren't aware of such niceties as thousands separation and +so on. (See L if you care about these things.) + +Output produced by print() is B affected by the +current locale: it is independent of whether C or C is in effect, and corresponds to what you'd get from printf() +in the "C" locale. The same is true for Perl's internal conversions +between numeric and string formats: + + use POSIX qw(strtod); + use locale; + + $n = 5/2; # Assign numeric 2.5 to $n + + $a = " $n"; # Locale-independent conversion to string + + print "half five is $n\n"; # Locale-independent output + + printf "half five is %g\n", $n; # Locale-dependent output + + print "DECIMAL POINT IS COMMA\n" + if $n == (strtod("2,5"))[0]; # Locale-dependent conversion + +=head2 Category LC_MONETARY: Formatting of monetary amounts + +The C standard defines the C category, but no function +that is affected by its contents. (Those with experience of standards +committees will recognize that the working group decided to punt on the +issue.) Consequently, Perl takes no notice of it. If you really want +to use C, you can query its contents--see L--and use the information that it returns in your application's +own formatting of currency amounts. However, you may well find that +the information, voluminous and complex though it may be, still does not +quite meet your requirements: currency formatting is a hard nut to crack. + +=head2 LC_TIME + +Output produced by POSIX::strftime(), which builds a formatted +human-readable date/time string, is affected by the current C +locale. Thus, in a French locale, the output produced by the C<%B> +format element (full month name) for the first month of the year would +be "janvier". Here's how to get a list of long month names in the +current locale: + + use POSIX qw(strftime); + for (0..11) { + $long_month_name[$_] = + strftime("%B", 0, 0, 0, 1, $_, 96); + } + +Note: C isn't needed in this example: as a function that +exists only to generate locale-dependent results, strftime() always +obeys the current C locale. + +=head2 Other categories + +The remaining locale category, C (possibly supplemented +by others in particular implementations) is not currently used by +Perl--except possibly to affect the behavior of library functions called +by extensions outside the standard Perl distribution. + +=head1 SECURITY + +Although the main discussion of Perl security issues can be found in +L, a discussion of Perl's locale handling would be incomplete +if it did not draw your attention to locale-dependent security issues. +Locales--particularly on systems that allow unprivileged users to +build their own locales--are untrustworthy. A malicious (or just plain +broken) locale can make a locale-aware application give unexpected +results. Here are a few possibilities: + +=over 4 + +=item * + +Regular expression checks for safe file names or mail addresses using +C<\w> may be spoofed by an C locale that claims that +characters such as "E" and "|" are alphanumeric. + +=item * + +String interpolation with case-mapping, as in, say, C<$dest = +"C:\U$name.$ext">, may produce dangerous results if a bogus LC_CTYPE +case-mapping table is in effect. + +=item * + +If the decimal point character in the C locale is +surreptitiously changed from a dot to a comma, C produces a string result of "123,456". Many people would +interpret this as one hundred and twenty-three thousand, four hundred +and fifty-six. + +=item * + +A sneaky C locale could result in the names of students with +"D" grades appearing ahead of those with "A"s. + +=item * + +An application that takes the trouble to use information in +C may format debits as if they were credits and vice versa +if that locale has been subverted. Or it might make payments in US +dollars instead of Hong Kong dollars. + +=item * + +The date and day names in dates formatted by strftime() could be +manipulated to advantage by a malicious user able to subvert the +C locale. ("Look--it says I wasn't in the building on +Sunday.") + +=back + +Such dangers are not peculiar to the locale system: any aspect of an +application's environment which may be modified maliciously presents +similar challenges. Similarly, they are not specific to Perl: any +programming language that allows you to write programs that take +account of their environment exposes you to these issues. + +Perl cannot protect you from all possibilities shown in the +examples--there is no substitute for your own vigilance--but, when +C is in effect, Perl uses the tainting mechanism (see +L) to mark string results that become locale-dependent, and +which may be untrustworthy in consequence. Here is a summary of the +tainting behavior of operators and functions that may be affected by +the locale: + +=over 4 + +=item B (C, C, C, C and C): + +Scalar true/false (or less/equal/greater) result is never tainted. + +=item B (with C<\l>, C<\L>, C<\u> or C<\U>) + +Result string containing interpolated material is tainted if +C is in effect. + +=item B (C): + +Scalar true/false result never tainted. + +Subpatterns, either delivered as a list-context result or as $1 etc. +are tainted if C is in effect, and the subpattern regular +expression contains C<\w> (to match an alphanumeric character), C<\W> +(non-alphanumeric character), C<\s> (white-space character), or C<\S> +(non white-space character). The matched-pattern variable, $&, $` +(pre-match), $' (post-match), and $+ (last match) are also tainted if +C is in effect and the regular expression contains C<\w>, +C<\W>, C<\s>, or C<\S>. + +=item B (C): + +Has the same behavior as the match operator. Also, the left +operand of C<=~> becomes tainted when C in effect +if modified as a result of a substitution based on a regular +expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of +case-mapping with C<\l>, C<\L>,C<\u> or C<\U>. + +=item B (sprintf()): + +Result is tainted if "use locale" is in effect. + +=item B (printf() and write()): + +Success/failure result is never tainted. + +=item B (lc(), lcfirst(), uc(), ucfirst()): + +Results are tainted if C is in effect. + +=item B (localeconv(), strcoll(), +strftime(), strxfrm()): + +Results are never tainted. + +=item B (isalnum(), isalpha(), isdigit(), +isgraph(), islower(), isprint(), ispunct(), isspace(), isupper(), +isxdigit()): + +True/false results are never tainted. + +=back + +Three examples illustrate locale-dependent tainting. +The first program, which ignores its locale, won't run: a value taken +directly from the command line may not be used to name an output file +when taint checks are enabled. + + #/usr/local/bin/perl -T + # Run with taint checking + + # Command line sanity check omitted... + $tainted_output_file = shift; + + open(F, ">$tainted_output_file") + or warn "Open of $untainted_output_file failed: $!\n"; + +The program can be made to run by "laundering" the tainted value through +a regular expression: the second example--which still ignores locale +information--runs, creating the file named on its command line +if it can. + + #/usr/local/bin/perl -T + + $tainted_output_file = shift; + $tainted_output_file =~ m%[\w/]+%; + $untainted_output_file = $&; + + open(F, ">$untainted_output_file") + or warn "Open of $untainted_output_file failed: $!\n"; + +Compare this with a similar but locale-aware program: + + #/usr/local/bin/perl -T + + $tainted_output_file = shift; + use locale; + $tainted_output_file =~ m%[\w/]+%; + $localized_output_file = $&; + + open(F, ">$localized_output_file") + or warn "Open of $localized_output_file failed: $!\n"; + +This third program fails to run because $& is tainted: it is the result +of a match involving C<\w> while C is in effect. + +=head1 ENVIRONMENT + +=over 12 + +=item PERL_BADLANG + +A string that can suppress Perl's warning about failed locale settings +at startup. Failure can occur if the locale support in the operating +system is lacking (broken) in some way--or if you mistyped the name of +a locale when you set up your environment. If this environment variable +is absent, or has a value that does not evaluate to integer zero--that +is, "0" or ""--Perl will complain about locale setting failures. + +B: PERL_BADLANG only gives you a way to hide the warning message. +The message tells about some problem in your system's locale support, +and you should investigate what the problem is. + +=back + +The following environment variables are not specific to Perl: They are +part of the standardized (ISO C, XPG4, POSIX 1.c) setlocale() method +for controlling an application's opinion on data. + +=over 12 + +=item LC_ALL + +C is the "override-all" locale environment variable. If +set, it overrides all the rest of the locale environment variables. + +=item LC_CTYPE + +In the absence of C, C chooses the character type +locale. In the absence of both C and C, C +chooses the character type locale. + +=item LC_COLLATE + +In the absence of C, C chooses the collation +(sorting) locale. In the absence of both C and C, +C chooses the collation locale. + +=item LC_MONETARY + +In the absence of C, C chooses the monetary +formatting locale. In the absence of both C and C, +C chooses the monetary formatting locale. + +=item LC_NUMERIC + +In the absence of C, C chooses the numeric format +locale. In the absence of both C and C, C +chooses the numeric format. + +=item LC_TIME + +In the absence of C, C chooses the date and time +formatting locale. In the absence of both C and C, +C chooses the date and time formatting locale. + +=item LANG + +C is the "catch-all" locale environment variable. If it is set, it +is used as the last resort after the overall C and the +category-specific C. + +=back + +=head1 NOTES + +=head2 Backward compatibility + +Versions of Perl prior to 5.004 B ignored locale information, +generally behaving as if something similar to the C<"C"> locale were +always in force, even if the program environment suggested otherwise +(see L). By default, Perl still behaves this +way for backward compatibility. If you want a Perl application to pay +attention to locale information, you B use the S> +pragma (see L) to instruct it to do so. + +Versions of Perl from 5.002 to 5.003 did use the C +information if available; that is, C<\w> did understand what +were the letters according to the locale environment variables. +The problem was that the user had no control over the feature: +if the C library supported locales, Perl used them. + +=head2 I18N:Collate obsolete + +In versions of Perl prior to 5.004, per-locale collation was possible +using the C library module. This module is now mildly +obsolete and should be avoided in new applications. The C +functionality is now integrated into the Perl core language: One can +use locale-specific scalar data completely normally with C, +so there is no longer any need to juggle with the scalar references of +C. + +=head2 Sort speed and memory use impacts + +Comparing and sorting by locale is usually slower than the default +sorting; slow-downs of two to four times have been observed. It will +also consume more memory: once a Perl scalar variable has participated +in any string comparison or sorting operation obeying the locale +collation rules, it will take 3-15 times more memory than before. (The +exact multiplier depends on the string's contents, the operating system +and the locale.) These downsides are dictated more by the operating +system's implementation of the locale system than by Perl. + +=head2 write() and LC_NUMERIC + +Formats are the only part of Perl that unconditionally use information +from a program's locale; if a program's environment specifies an +LC_NUMERIC locale, it is always used to specify the decimal point +character in formatted output. Formatted output cannot be controlled by +C because the pragma is tied to the block structure of the +program, and, for historical reasons, formats exist outside that block +structure. + +=head2 Freely available locale definitions + +There is a large collection of locale definitions at +C. You should be aware that it is +unsupported, and is not claimed to be fit for any purpose. If your +system allows installation of arbitrary locales, you may find the +definitions useful as they are, or as a basis for the development of +your own locales. + +=head2 I18n and l10n + +"Internationalization" is often abbreviated as B because its first +and last letters are separated by eighteen others. (You may guess why +the internalin ... internaliti ... i18n tends to get abbreviated.) In +the same way, "localization" is often abbreviated to B. + +=head2 An imperfect standard + +Internationalization, as defined in the C and POSIX standards, can be +criticized as incomplete, ungainly, and having too large a granularity. +(Locales apply to a whole process, when it would arguably be more useful +to have them apply to a single thread, window group, or whatever.) They +also have a tendency, like standards groups, to divide the world into +nations, when we all know that the world can equally well be divided +into bankers, bikers, gamers, and so on. But, for now, it's the only +standard we've got. This may be construed as a bug. + +=head1 BUGS + +=head2 Broken systems + +In certain systems, the operating system's locale support +is broken and cannot be fixed or used by Perl. Such deficiencies can +and will result in mysterious hangs and/or Perl core dumps when the +C is in effect. When confronted with such a system, +please report in excruciating detail to >, and +complain to your vendor: bug fixes may exist for these problems +in your operating system. Sometimes such bug fixes are called an +operating system upgrade. + +=head1 SEE ALSO + +L + +L + +L + +L + +L + +L, + +L + +L + +L, + +L + +L + +L, + +L + +L + +L, + +L + +=head1 HISTORY + +Jarkko Hietaniemi's original F heavily hacked by Dominic +Dunlop, assisted by the perl5-porters. Prose worked over a bit by +Tom Christiansen. + +Last update: Thu Jun 11 08:44:13 MDT 1998 diff --git a/contrib/perl5/pod/perllol.pod b/contrib/perl5/pod/perllol.pod new file mode 100644 index 00000000000..0e6796b50f6 --- /dev/null +++ b/contrib/perl5/pod/perllol.pod @@ -0,0 +1,303 @@ +=head1 NAME + +perlLoL - Manipulating Lists of Lists in Perl + +=head1 DESCRIPTION + +=head1 Declaration and Access of Lists of Lists + +The simplest thing to build is a list of lists (sometimes called an array +of arrays). It's reasonably easy to understand, and almost everything +that applies here will also be applicable later on with the fancier data +structures. + +A list of lists, or an array of an array if you would, is just a regular +old array @LoL that you can get at with two subscripts, like C<$LoL[3][2]>. Here's +a declaration of the array: + + # assign to our array a list of list references + @LoL = ( + [ "fred", "barney" ], + [ "george", "jane", "elroy" ], + [ "homer", "marge", "bart" ], + ); + + print $LoL[2][2]; + bart + +Now you should be very careful that the outer bracket type +is a round one, that is, a parenthesis. That's because you're assigning to +an @list, so you need parentheses. If you wanted there I to be an @LoL, +but rather just a reference to it, you could do something more like this: + + # assign a reference to list of list references + $ref_to_LoL = [ + [ "fred", "barney", "pebbles", "bambam", "dino", ], + [ "homer", "bart", "marge", "maggie", ], + [ "george", "jane", "alroy", "judy", ], + ]; + + print $ref_to_LoL->[2][2]; + +Notice that the outer bracket type has changed, and so our access syntax +has also changed. That's because unlike C, in perl you can't freely +interchange arrays and references thereto. $ref_to_LoL is a reference to an +array, whereas @LoL is an array proper. Likewise, C<$LoL[2]> is not an +array, but an array ref. So how come you can write these: + + $LoL[2][2] + $ref_to_LoL->[2][2] + +instead of having to write these: + + $LoL[2]->[2] + $ref_to_LoL->[2]->[2] + +Well, that's because the rule is that on adjacent brackets only (whether +square or curly), you are free to omit the pointer dereferencing arrow. +But you cannot do so for the very first one if it's a scalar containing +a reference, which means that $ref_to_LoL always needs it. + +=head1 Growing Your Own + +That's all well and good for declaration of a fixed data structure, +but what if you wanted to add new elements on the fly, or build +it up entirely from scratch? + +First, let's look at reading it in from a file. This is something like +adding a row at a time. We'll assume that there's a flat file in which +each line is a row and each word an element. If you're trying to develop an +@LoL list containing all these, here's the right way to do that: + + while (<>) { + @tmp = split; + push @LoL, [ @tmp ]; + } + +You might also have loaded that from a function: + + for $i ( 1 .. 10 ) { + $LoL[$i] = [ somefunc($i) ]; + } + +Or you might have had a temporary variable sitting around with the +list in it. + + for $i ( 1 .. 10 ) { + @tmp = somefunc($i); + $LoL[$i] = [ @tmp ]; + } + +It's very important that you make sure to use the C<[]> list reference +constructor. That's because this will be very wrong: + + $LoL[$i] = @tmp; + +You see, assigning a named list like that to a scalar just counts the +number of elements in @tmp, which probably isn't what you want. + +If you are running under C, you'll have to add some +declarations to make it happy: + + use strict; + my(@LoL, @tmp); + while (<>) { + @tmp = split; + push @LoL, [ @tmp ]; + } + +Of course, you don't need the temporary array to have a name at all: + + while (<>) { + push @LoL, [ split ]; + } + +You also don't have to use push(). You could just make a direct assignment +if you knew where you wanted to put it: + + my (@LoL, $i, $line); + for $i ( 0 .. 10 ) { + $line = <>; + $LoL[$i] = [ split ' ', $line ]; + } + +or even just + + my (@LoL, $i); + for $i ( 0 .. 10 ) { + $LoL[$i] = [ split ' ', <> ]; + } + +You should in general be leery of using potential list functions +in a scalar context without explicitly stating such. +This would be clearer to the casual reader: + + my (@LoL, $i); + for $i ( 0 .. 10 ) { + $LoL[$i] = [ split ' ', scalar(<>) ]; + } + +If you wanted to have a $ref_to_LoL variable as a reference to an array, +you'd have to do something like this: + + while (<>) { + push @$ref_to_LoL, [ split ]; + } + +Now you can add new rows. What about adding new columns? If you're +dealing with just matrices, it's often easiest to use simple assignment: + + for $x (1 .. 10) { + for $y (1 .. 10) { + $LoL[$x][$y] = func($x, $y); + } + } + + for $x ( 3, 7, 9 ) { + $LoL[$x][20] += func2($x); + } + +It doesn't matter whether those elements are already +there or not: it'll gladly create them for you, setting +intervening elements to C as need be. + +If you wanted just to append to a row, you'd have +to do something a bit funnier looking: + + # add new columns to an existing row + push @{ $LoL[0] }, "wilma", "betty"; + +Notice that I I say just: + + push $LoL[0], "wilma", "betty"; # WRONG! + +In fact, that wouldn't even compile. How come? Because the argument +to push() must be a real array, not just a reference to such. + +=head1 Access and Printing + +Now it's time to print your data structure out. How +are you going to do that? Well, if you want only one +of the elements, it's trivial: + + print $LoL[0][0]; + +If you want to print the whole thing, though, you can't +say + + print @LoL; # WRONG + +because you'll get just references listed, and perl will never +automatically dereference things for you. Instead, you have to +roll yourself a loop or two. This prints the whole structure, +using the shell-style for() construct to loop across the outer +set of subscripts. + + for $aref ( @LoL ) { + print "\t [ @$aref ],\n"; + } + +If you wanted to keep track of subscripts, you might do this: + + for $i ( 0 .. $#LoL ) { + print "\t elt $i is [ @{$LoL[$i]} ],\n"; + } + +or maybe even this. Notice the inner loop. + + for $i ( 0 .. $#LoL ) { + for $j ( 0 .. $#{$LoL[$i]} ) { + print "elt $i $j is $LoL[$i][$j]\n"; + } + } + +As you can see, it's getting a bit complicated. That's why +sometimes is easier to take a temporary on your way through: + + for $i ( 0 .. $#LoL ) { + $aref = $LoL[$i]; + for $j ( 0 .. $#{$aref} ) { + print "elt $i $j is $LoL[$i][$j]\n"; + } + } + +Hmm... that's still a bit ugly. How about this: + + for $i ( 0 .. $#LoL ) { + $aref = $LoL[$i]; + $n = @$aref - 1; + for $j ( 0 .. $n ) { + print "elt $i $j is $LoL[$i][$j]\n"; + } + } + +=head1 Slices + +If you want to get at a slice (part of a row) in a multidimensional +array, you're going to have to do some fancy subscripting. That's +because while we have a nice synonym for single elements via the +pointer arrow for dereferencing, no such convenience exists for slices. +(Remember, of course, that you can always write a loop to do a slice +operation.) + +Here's how to do one operation using a loop. We'll assume an @LoL +variable as before. + + @part = (); + $x = 4; + for ($y = 7; $y < 13; $y++) { + push @part, $LoL[$x][$y]; + } + +That same loop could be replaced with a slice operation: + + @part = @{ $LoL[4] } [ 7..12 ]; + +but as you might well imagine, this is pretty rough on the reader. + +Ah, but what if you wanted a I, such as having +$x run from 4..8 and $y run from 7 to 12? Hmm... here's the simple way: + + @newLoL = (); + for ($startx = $x = 4; $x <= 8; $x++) { + for ($starty = $y = 7; $y <= 12; $y++) { + $newLoL[$x - $startx][$y - $starty] = $LoL[$x][$y]; + } + } + +We can reduce some of the looping through slices + + for ($x = 4; $x <= 8; $x++) { + push @newLoL, [ @{ $LoL[$x] } [ 7..12 ] ]; + } + +If you were into Schwartzian Transforms, you would probably +have selected map for that + + @newLoL = map { [ @{ $LoL[$_] } [ 7..12 ] ] } 4 .. 8; + +Although if your manager accused of seeking job security (or rapid +insecurity) through inscrutable code, it would be hard to argue. :-) +If I were you, I'd put that in a function: + + @newLoL = splice_2D( \@LoL, 4 => 8, 7 => 12 ); + sub splice_2D { + my $lrr = shift; # ref to list of list refs! + my ($x_lo, $x_hi, + $y_lo, $y_hi) = @_; + + return map { + [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] + } $x_lo .. $x_hi; + } + + +=head1 SEE ALSO + +perldata(1), perlref(1), perldsc(1) + +=head1 AUTHOR + +Tom Christiansen > + +Last update: Thu Jun 4 16:16:23 MDT 1998 diff --git a/contrib/perl5/pod/perlmod.pod b/contrib/perl5/pod/perlmod.pod new file mode 100644 index 00000000000..6da31dee3c9 --- /dev/null +++ b/contrib/perl5/pod/perlmod.pod @@ -0,0 +1,375 @@ +=head1 NAME + +perlmod - Perl modules (packages and symbol tables) + +=head1 DESCRIPTION + +=head2 Packages + +Perl provides a mechanism for alternative namespaces to protect packages +from stomping on each other's variables. In fact, there's really no such +thing as a global variable in Perl (although some identifiers default +to the main package instead of the current one). The package statement +declares the compilation unit as +being in the given namespace. The scope of the package declaration +is from the declaration itself through the end of the enclosing block, +C, C, or end of file, whichever comes first (the same scope +as the my() and local() operators). All further unqualified dynamic +identifiers will be in this namespace. A package statement only affects +dynamic variables--including those you've used local() on--but +I lexical variables created with my(). Typically it would be +the first declaration in a file to be included by the C or +C operator. You can switch into a package in more than one place; +it merely influences which symbol table is used by the compiler for the +rest of that block. You can refer to variables and filehandles in other +packages by prefixing the identifier with the package name and a double +colon: C<$Package::Variable>. If the package name is null, the C

    +package is assumed. That is, C<$::sail> is equivalent to C<$main::sail>. + +The old package delimiter was a single quote, but double colon is now the +preferred delimiter, in part because it's more readable to humans, and +in part because it's more readable to B macros. It also makes C++ +programmers feel like they know what's going on--as opposed to using the +single quote as separator, which was there to make Ada programmers feel +like they knew what's going on. Because the old-fashioned syntax is still +supported for backwards compatibility, if you try to use a string like +C<"This is $owner's house">, you'll be accessing C<$owner::s>; that is, +the $s variable in package C, which is probably not what you meant. +Use braces to disambiguate, as in C<"This is ${owner}'s house">. + +Packages may be nested inside other packages: C<$OUTER::INNER::var>. This +implies nothing about the order of name lookups, however. All symbols +are either local to the current package, or must be fully qualified +from the outer package name down. For instance, there is nowhere +within package C that C<$INNER::var> refers to C<$OUTER::INNER::var>. +It would treat package C as a totally separate global package. + +Only identifiers starting with letters (or underscore) are stored in a +package's symbol table. All other symbols are kept in package C
    , +including all of the punctuation variables like $_. In addition, when +unqualified, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, +INC, and SIG are forced to be in package C
    , even when used for other +purposes than their builtin one. Note also that, if you have a package +called C, C, or C, then you can't use the qualified form of an +identifier because it will be interpreted instead as a pattern match, +a substitution, or a transliteration. + +(Variables beginning with underscore used to be forced into package +main, but we decided it was more useful for package writers to be able +to use leading underscore to indicate private variables and method names. +$_ is still global though.) + +Eval()ed strings are compiled in the package in which the eval() was +compiled. (Assignments to C<$SIG{}>, however, assume the signal +handler specified is in the C
    package. Qualify the signal handler +name if you wish to have a signal handler in a package.) For an +example, examine F in the Perl library. It initially switches +to the C package so that the debugger doesn't interfere with variables +in the script you are trying to debug. At various points, however, it +temporarily switches back to the C
    package to evaluate various +expressions in the context of the C
    package (or wherever you came +from). See L. + +The special symbol C<__PACKAGE__> contains the current package, but cannot +(easily) be used to construct variables. + +See L for other scoping issues related to my() and local(), +and L regarding closures. + +=head2 Symbol Tables + +The symbol table for a package happens to be stored in the hash of that +name with two colons appended. The main symbol table's name is thus +C<%main::>, or C<%::> for short. Likewise symbol table for the nested +package mentioned earlier is named C<%OUTER::INNER::>. + +The value in each entry of the hash is what you are referring to when you +use the C<*name> typeglob notation. In fact, the following have the same +effect, though the first is more efficient because it does the symbol +table lookups at compile time: + + local *main::foo = *main::bar; + local $main::{foo} = $main::{bar}; + +You can use this to print out all the variables in a package, for +instance. The standard F library and the CPAN module +Devel::Symdump make use of this. + +Assignment to a typeglob performs an aliasing operation, i.e., + + *dick = *richard; + +causes variables, subroutines, formats, and file and directory handles +accessible via the identifier C also to be accessible via the +identifier C. If you want to alias only a particular variable or +subroutine, you can assign a reference instead: + + *dick = \$richard; + +Which makes $richard and $dick the same variable, but leaves +@richard and @dick as separate arrays. Tricky, eh? + +This mechanism may be used to pass and return cheap references +into or from subroutines if you won't want to copy the whole +thing. It only works when assigning to dynamic variables, not +lexicals. + + %some_hash = (); # can't be my() + *some_hash = fn( \%another_hash ); + sub fn { + local *hashsym = shift; + # now use %hashsym normally, and you + # will affect the caller's %another_hash + my %nhash = (); # do what you want + return \%nhash; + } + +On return, the reference will overwrite the hash slot in the +symbol table specified by the *some_hash typeglob. This +is a somewhat tricky way of passing around references cheaply +when you won't want to have to remember to dereference variables +explicitly. + +Another use of symbol tables is for making "constant" scalars. + + *PI = \3.14159265358979; + +Now you cannot alter $PI, which is probably a good thing all in all. +This isn't the same as a constant subroutine, which is subject to +optimization at compile-time. This isn't. A constant subroutine is one +prototyped to take no arguments and to return a constant expression. +See L for details on these. The C pragma is a +convenient shorthand for these. + +You can say C<*foo{PACKAGE}> and C<*foo{NAME}> to find out what name and +package the *foo symbol table entry comes from. This may be useful +in a subroutine that gets passed typeglobs as arguments: + + sub identify_typeglob { + my $glob = shift; + print 'You gave me ', *{$glob}{PACKAGE}, '::', *{$glob}{NAME}, "\n"; + } + identify_typeglob *foo; + identify_typeglob *bar::baz; + +This prints + + You gave me main::foo + You gave me bar::baz + +The *foo{THING} notation can also be used to obtain references to the +individual elements of *foo, see L. + +=head2 Package Constructors and Destructors + +There are two special subroutine definitions that function as package +constructors and destructors. These are the C and C +routines. The C is optional for these routines. + +A C subroutine is executed as soon as possible, that is, the moment +it is completely defined, even before the rest of the containing file +is parsed. You may have multiple C blocks within a file--they +will execute in order of definition. Because a C block executes +immediately, it can pull in definitions of subroutines and such from other +files in time to be visible to the rest of the file. Once a C +has run, it is immediately undefined and any code it used is returned to +Perl's memory pool. This means you can't ever explicitly call a C. + +An C subroutine is executed as late as possible, that is, when +the interpreter is being exited, even if it is exiting as a result of +a die() function. (But not if it's polymorphing into another program +via C, or being blown out of the water by a signal--you have to +trap that yourself (if you can).) You may have multiple C blocks +within a file--they will execute in reverse order of definition; that is: +last in, first out (LIFO). + +Inside an C subroutine, C<$?> contains the value that the script is +going to pass to C. You can modify C<$?> to change the exit +value of the script. Beware of changing C<$?> by accident (e.g. by +running something via C). + +Note that when you use the B<-n> and B<-p> switches to Perl, C and +C work just as they do in B, as a degenerate case. As currently +implemented (and subject to change, since its inconvenient at best), +both C I C blocks are run when you use the B<-c> switch +for a compile-only syntax check, although your main code is not. + +=head2 Perl Classes + +There is no special class syntax in Perl, but a package may function +as a class if it provides subroutines to act as methods. Such a +package may also derive some of its methods from another class (package) +by listing the other package name in its global @ISA array (which +must be a package global, not a lexical). + +For more on this, see L and L. + +=head2 Perl Modules + +A module is just a package that is defined in a library file of +the same name, and is designed to be reusable. It may do this by +providing a mechanism for exporting some of its symbols into the symbol +table of any package using it. Or it may function as a class +definition and make its semantics available implicitly through method +calls on the class and its objects, without explicit exportation of any +symbols. Or it can do a little of both. + +For example, to start a normal module called Some::Module, create +a file called Some/Module.pm and start with this template: + + package Some::Module; # assumes Some/Module.pm + + use strict; + + BEGIN { + use Exporter (); + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 1.00; + # if using RCS/CVS, this may be preferred + $VERSION = do { my @r = (q$Revision: 2.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker + + @ISA = qw(Exporter); + @EXPORT = qw(&func1 &func2 &func4); + %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw($Var1 %Hashit &func3); + } + use vars @EXPORT_OK; + + # non-exported package globals go here + use vars qw(@more $stuff); + + # initalize package globals, first exported ones + $Var1 = ''; + %Hashit = (); + + # then the others (which are still accessible as $Some::Module::stuff) + $stuff = ''; + @more = (); + + # all file-scoped lexicals must be created before + # the functions below that use them. + + # file-private lexicals go here + my $priv_var = ''; + my %secret_hash = (); + + # here's a file-private function as a closure, + # callable as &$priv_func; it cannot be prototyped. + my $priv_func = sub { + # stuff goes here. + }; + + # make all your functions, whether exported or not; + # remember to put something interesting in the {} stubs + sub func1 {} # no prototype + sub func2() {} # proto'd void + sub func3($$) {} # proto'd to 2 scalars + + # this one isn't exported, but could be called! + sub func4(\%) {} # proto'd to 1 hash ref + + END { } # module clean-up code here (global destructor) + +Then go on to declare and use your variables in functions +without any qualifications. +See L and the L for details on +mechanics and style issues in module creation. + +Perl modules are included into your program by saying + + use Module; + +or + + use Module LIST; + +This is exactly equivalent to + + BEGIN { require Module; import Module; } + +or + + BEGIN { require Module; import Module LIST; } + +As a special case + + use Module (); + +is exactly equivalent to + + BEGIN { require Module; } + +All Perl module files have the extension F<.pm>. C assumes this so +that you don't have to spell out "F" in quotes. This also +helps to differentiate new modules from old F<.pl> and F<.ph> files. +Module names are also capitalized unless they're functioning as pragmas, +"Pragmas" are in effect compiler directives, and are sometimes called +"pragmatic modules" (or even "pragmata" if you're a classicist). + +The two statements: + + require SomeModule; + require "SomeModule.pm"; + +differ from each other in two ways. In the first case, any double +colons in the module name, such as C, are translated +into your system's directory separator, usually "/". The second +case does not, and would have to be specified literally. The other difference +is that seeing the first C clues in the compiler that uses of +indirect object notation involving "SomeModule", as in C<$ob = purge SomeModule>, +are method calls, not function calls. (Yes, this really can make a difference.) + +Because the C statement implies a C block, the importation +of semantics happens at the moment the C statement is compiled, +before the rest of the file is compiled. This is how it is able +to function as a pragma mechanism, and also how modules are able to +declare subroutines that are then visible as list operators for +the rest of the current file. This will not work if you use C +instead of C. With require you can get into this problem: + + require Cwd; # make Cwd:: accessible + $here = Cwd::getcwd(); + + use Cwd; # import names from Cwd:: + $here = getcwd(); + + require Cwd; # make Cwd:: accessible + $here = getcwd(); # oops! no main::getcwd() + +In general, C is recommended over C, +because it determines module availability at compile time, not in the +middle of your program's execution. An exception would be if two modules +each tried to C each other, and each also called a function from +that other module. In that case, it's easy to use Cs instead. + +Perl packages may be nested inside other package names, so we can have +package names containing C<::>. But if we used that package name +directly as a filename it would makes for unwieldy or impossible +filenames on some systems. Therefore, if a module's name is, say, +C, then its definition is actually found in the library +file F. + +Perl modules always have a F<.pm> file, but there may also be dynamically +linked executables or autoloaded subroutine definitions associated with +the module. If so, these will be entirely transparent to the user of +the module. It is the responsibility of the F<.pm> file to load (or +arrange to autoload) any additional functionality. The POSIX module +happens to do both dynamic loading and autoloading, but the user can +say just C to get it all. + +For more information on writing extension modules, see L +and L. + +=head1 SEE ALSO + +See L for general style issues related to building Perl +modules and classes as well as descriptions of the standard library and +CPAN, L for how Perl's standard import/export mechanism works, +L for an in-depth tutorial on creating classes, L +for a hard-core reference document on objects, and L for an +explanation of functions and scoping. diff --git a/contrib/perl5/pod/perlmodinstall.pod b/contrib/perl5/pod/perlmodinstall.pod new file mode 100644 index 00000000000..1c65f1c3e18 --- /dev/null +++ b/contrib/perl5/pod/perlmodinstall.pod @@ -0,0 +1,410 @@ +=head1 NAME + +perlmodinstall - Installing CPAN Modules + +=head1 DESCRIPTION + +You can think of a module as the fundamental unit of reusable Perl +code; see L for details. Whenever anyone creates a chunk of +Perl code that they think will be useful to the world, they register +as a Perl developer at http://www.perl.com/CPAN/modules/04pause.html +so that they can then upload their code to the CPAN. The CPAN is the +Comprehensive Perl Archive Network and can be accessed at +http://www.perl.com/CPAN/. + +This documentation is for people who want to download CPAN modules +and install them on their own computer. + +=head2 PREAMBLE + +You have a file ending in .tar.gz (or, less often, .zip). You know +there's a tasty module inside. There are four steps you must now +take: + +=over 5 + +=item B the file + +=item B the file into a directory + +=item B the module (sometimes unnecessary) + +=item B the module. + +=back + +Here's how to perform each step for each operating system. This is +I a substitute for reading the README and INSTALL files that +might have come with your module! + +Also note that these instructions are tailored for installing the +module into your system's repository of Perl modules. But you can +install modules into any directory you wish. For instance, where I +say C, you can substitute C to install the modules +into C. Then you can use the modules +from your Perl programs with C or sometimes just C. + +=over 4 + +=item * + +B + +You can use Andreas Koenig's CPAN module +( http://www.perl.com/CPAN/modules/by-module/CPAN ) +to automate the following steps, from DECOMPRESS through INSTALL. + +A. DECOMPRESS + +Decompress the file with C + +You can get gzip from ftp://prep.ai.mit.edu/pub/gnu. + +Or, you can combine this step with the next to save disk space: + + gzip -dc yourmodule.tar.gz | tar -xof - + +B. UNPACK + +Unpack the result with C + +C. BUILD + +Go into the newly-created directory and type: + + perl Makefile.PL + make + make test + +D. INSTALL + +While still in that directory, type: + + make install + +Make sure you have the appropriate permissions to install the module +in your Perl 5 library directory. Often, you'll need to be root. + +That's all you need to do on Unix systems with dynamic linking. +Most Unix systems have dynamic linking -- if yours doesn't, or if for +another reason you have a statically-linked perl, B the +module requires compilation, you'll need to build a new Perl binary +that includes the module. Again, you'll probably need to be root. + +=item * + +B + + A. DECOMPRESS + +You can use the shareware Winzip ( http://www.winzip.com ) to +decompress and unpack modules. + + B. UNPACK + +If you used WinZip, this was already done for you. + + C. BUILD + +Does the module require compilation (i.e. does it have files +that end in .xs, .c, .h, .y, .cc, .cxx, or .C)? If it does, you're on +your own. You can try compiling it yourself if you have a C compiler. +If you're successful, consider uploading the resulting binary to the +CPAN for others to use. If it doesn't, go to INSTALL. + + D. INSTALL + +Copy the module into your Perl's I directory. That'll be one +of the directories you see when you type + + perl -e 'print "@INC"' + +=item * + +B + + A. DECOMPRESS + +When you download the module, make sure it ends in either +C<.tar.gz> or C<.zip>. Windows browsers sometimes +download C<.tar.gz> files as C<_tar.tar>, because +early versions of Windows prohibited more than one dot in a filename. + +You can use the shareware WinZip ( http://www.winzip.com ) to +decompress and unpack modules. + +Or, you can use InfoZip's C utility ( +http://www.cdrom.com/pub/infozip/Info-Zip.html ) to uncompress +C<.zip> files; type C in +your shell. + +Or, if you have a working C and C, you can +type + + gzip -cd yourmodule.tar.gz | tar xvf - + +in the shell to decompress C. This will +UNPACK your module as well. + + B. UNPACK + +All of the methods in DECOMPRESS will have done this for you. + + C. BUILD + +Go into the newly-created directory and type: + + perl Makefile.PL + dmake + dmake test + +Depending on your perl configuration, C might not be +available. You might have to substitute whatever C says. (Usually, that will be C or +C.) + + D. INSTALL + +While still in that directory, type: + + dmake install + +=item * + +B + +A. DECOMPRESS + +You can either use StuffIt Expander ( http://www.aladdinsys.com/ ) in +combination with I +(shareware), or the freeware MacGzip ( +http://persephone.cps.unizar.es/general/gente/spd/gzip/gzip.html ). + +B. UNPACK + +If you're using DropStuff or Stuffit, you can just extract the tar +archive. Otherwise, you can use the freeware I ( +http://www.cirfid.unibo.it/~speranza ). + +C. BUILD + +Does the module require compilation? + +1. If it does, + +Overview: You need MPW and a combination of new and old CodeWarrior +compilers for MPW and libraries. Makefiles created for building under +MPW use the Metrowerks compilers. It's most likely possible to build +without other compilers, but it has not been done successfully, to our +knowledge. Read the documentation in MacPerl: Power and Ease ( +http://www.ptf.com/macperl/ ) on porting/building extensions, or find +an existing precompiled binary, or hire someone to build it for you. + +Or, ask someone on the mac-perl mailing list (mac-perl@iis.ee.ethz.ch) +to build it for you. To subscribe to the mac-perl mailing list, send +mail to mac-perl-request@iis.ee.ethz.ch. + +2. If the module doesn't require compilation, go to INSTALL. + +D. INSTALL + +Make sure the newlines for the modules are in Mac format, not Unix format. +Move the files manually into the correct folders. + +Move the files to their final destination: This will +most likely be in C<$ENV{MACPERL}site_lib:> (i.e., +C). You can add new paths to +the default C<@INC> in the Preferences menu item in the +MacPerl application (C<$ENV{MACPERL}site_lib:> is added +automagically). Create whatever directory structures are required +(i.e., for C, create +C<$ENV{MACPERL}site_lib:Some:> and put +C in that directory). + +Run the following script (or something like it): + + #!perl -w + use AutoSplit; + my $dir = "${MACPERL}site_perl"; + autosplit("$dir:Some:Module.pm", "$dir:auto", 0, 1, 1); + +Eventually there should be a way to automate the installation process; some +solutions exist, but none are ready for the general public yet. + +=item * + +B + + A. DECOMPRESS + +djtarx ( ftp://ftp.simtel.net/pub/simtelnet/gnu/djgpp/v2/ ) +will both uncompress and unpack. + + B. UNPACK + +See above. + + C. BUILD + +Go into the newly-created directory and type: + + perl Makefile.PL + make + make test + +You will need the packages mentioned in C +in the Perl distribution. + + D. INSTALL + +While still in that directory, type: + + make install + +You will need the packages mentioned in Readme.dos in the Perl distribution. + +=item * + +B + +Get the EMX development suite and gzip/tar, from either Hobbes ( +http://hobbes.nmsu.edu ) or Leo ( http://www.leo.org ), and then follow +the instructions for Unix. + +=item * + +B + +When downloading from CPAN, save your file with a C<.tgz> +extension instead of C<.tar.gz>. All other periods in the +filename should be replaced with underscores. For example, +C should be downloaded as +C. + +A. DECOMPRESS + +Type + + gzip -d Your-Module.tgz + +or, for zipped modules, type + + unzip Your-Module.zip + +Executables for gzip, zip, and VMStar ( Alphas: +http://www.openvms.digital.com/cd/000TOOLS/ALPHA/ and Vaxen: +http://www.openvms.digital.com/cd/000TOOLS/VAX/ ). + +gzip and tar +are also available at ftp://ftp.digital.com/pub/VMS. + +Note that GNU's gzip/gunzip is not the same as Info-ZIP's zip/unzip +package. The former is a simple compression tool; the latter permits +creation of multi-file archives. + +B. UNPACK + +If you're using VMStar: + + VMStar xf Your-Module.tar + +Or, if you're fond of VMS command syntax: + + tar/extract/verbose Your_Module.tar + +C. BUILD + +Make sure you have MMS (from Digital) or the freeware MMK ( available from MadGoat at http://www.madgoat.com ). Then type this to create the +DESCRIP.MMS for the module: + + perl Makefile.PL + +Now you're ready to build: + + mms + mms test + +Substitute C for C above if you're using MMK. + +D. INSTALL + +Type + + mms install + +Substitute C for C above if you're using MMK. + +=item * + +B, + +Introduce the .tar.gz file into an HFS as binary; don't translate from +ASCII to EBCDIC. + +A. DECOMPRESS + + Decompress the file with C + + You can get gzip from + http://www.s390.ibm.com/products/oe/bpxqp1.html. + +B. UNPACK + +Unpack the result with + + pax -o to=IBM-1047,from=ISO8859-1 -r < yourmodule.tar + +The BUILD and INSTALL steps are identical to those for Unix. Some +modules generate Makefiles that work better with GNU make, which is +available from http://www.mks.com/s390/gnu/index.htm. + +=back + +=head1 HEY + +If you have any suggested changes for this page, let me know. Please +don't send me mail asking for help on how to install your modules. +There are too many modules, and too few Orwants, for me to be able to +answer or even acknowledge all your questions. Contact the module +author instead, or post to comp.lang.perl.modules, or ask someone +familiar with Perl on your operating system. + +=head1 AUTHOR + +Jon Orwant + +orwant@tpj.com + +The Perl Journal, http://tpj.com + +with invaluable help from Brandon Allbery, Charles Bailey, Graham +Barr, Dominic Dunlop, Jarkko Hietaniemi, Ben Holzman, Tom Horsley, +Nick Ing-Simmons, Tuomas J. Lukka, Laszlo Molnar, Chris Nandor, Alan +Olsen, Peter Prymmer, Gurusamy Sarathy, Christoph Spalinger, Dan +Sugalski, Larry Virden, and Ilya Zakharevich. + +July 22, 1998 + +=head1 COPYRIGHT + +Copyright (C) 1998 Jon Orwant. All Rights Reserved. + +Permission is granted to make and distribute verbatim copies of this +documentation provided the copyright notice and this permission notice are +preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +documentation under the conditions for verbatim copying, provided also +that they are marked clearly as modified versions, that the authors' +names and title are unchanged (though subtitles and additional +authors' names may be added), and that the entire resulting derived +work is distributed under the terms of a permission notice identical +to this one. + +Permission is granted to copy and distribute translations of this +documentation into another language, under the above conditions for +modified versions. + diff --git a/contrib/perl5/pod/perlmodlib.pod b/contrib/perl5/pod/perlmodlib.pod new file mode 100644 index 00000000000..5d0e5b048a9 --- /dev/null +++ b/contrib/perl5/pod/perlmodlib.pod @@ -0,0 +1,1102 @@ +=head1 NAME + +perlmodlib - constructing new Perl modules and finding existing ones + +=head1 DESCRIPTION + +=head1 THE PERL MODULE LIBRARY + +A number of modules are included the Perl distribution. These are +described below, and all end in F<.pm>. You may also discover files in +the library directory that end in either F<.pl> or F<.ph>. These are old +libraries supplied so that old programs that use them still run. The +F<.pl> files will all eventually be converted into standard modules, and +the F<.ph> files made by B will probably end up as extension modules +made by B. (Some F<.ph> values may already be available through the +POSIX module.) The B file in the distribution may help in your +conversion, but it's just a mechanical process and therefore far from +bulletproof. + +=head2 Pragmatic Modules + +They work somewhat like pragmas in that they tend to affect the compilation of +your program, and thus will usually work well only when used within a +C, or C. Most of these are locally scoped, so an inner BLOCK +may countermand any of these by saying: + + no integer; + no strict 'refs'; + +which lasts until the end of that BLOCK. + +Unlike the pragmas that effect the C<$^H> hints variable, the C and C declarations are not BLOCK-scoped. They allow +you to predeclare a variables or subroutines within a particular +I rather than just a block. Such declarations are effective +for the entire file for which they were declared. You cannot rescind +them with C or C. + +The following pragmas are defined (and have their own documentation). + +=over 12 + +=item use autouse MODULE => qw(sub1 sub2 sub3) + +Defers C until someone calls one of the specified +subroutines (which must be exported by MODULE). This pragma should be +used with caution, and only when necessary. + +=item blib + +manipulate @INC at compile time to use MakeMaker's uninstalled version +of a package + +=item diagnostics + +force verbose warning diagnostics + +=item integer + +compute arithmetic in integer instead of double + +=item less + +request less of something from the compiler + +=item lib + +manipulate @INC at compile time + +=item locale + +use or ignore current locale for builtin operations (see L) + +=item ops + +restrict named opcodes when compiling or running Perl code + +=item overload + +overload basic Perl operations + +=item re + +alter behaviour of regular expressions + +=item sigtrap + +enable simple signal handling + +=item strict + +restrict unsafe constructs + +=item subs + +predeclare sub names + +=item vmsish + +adopt certain VMS-specific behaviors + +=item vars + +predeclare global variable names + +=back + +=head2 Standard Modules + +Standard, bundled modules are all expected to behave in a well-defined +manner with respect to namespace pollution because they use the +Exporter module. See their own documentation for details. + +=over 12 + +=item AnyDBM_File + +provide framework for multiple DBMs + +=item AutoLoader + +load functions only on demand + +=item AutoSplit + +split a package for autoloading + +=item Benchmark + +benchmark running times of code + +=item CPAN + +interface to Comprehensive Perl Archive Network + +=item CPAN::FirstTime + +create a CPAN configuration file + +=item CPAN::Nox + +run CPAN while avoiding compiled extensions + +=item Carp + +warn of errors (from perspective of caller) + +=item Class::Struct + +declare struct-like datatypes + +=item Config + +access Perl configuration information + +=item Cwd + +get pathname of current working directory + +=item DB_File + +access to Berkeley DB + +=item Devel::SelfStubber + +generate stubs for a SelfLoading module + +=item DirHandle + +supply object methods for directory handles + +=item DynaLoader + +dynamically load C libraries into Perl code + +=item English + +use nice English (or awk) names for ugly punctuation variables + +=item Env + +import environment variables + +=item Exporter + +implements default import method for modules + +=item ExtUtils::Embed + +utilities for embedding Perl in C/C++ applications + +=item ExtUtils::Install + +install files from here to there + +=item ExtUtils::Liblist + +determine libraries to use and how to use them + +=item ExtUtils::MM_OS2 + +methods to override Unix behaviour in ExtUtils::MakeMaker + +=item ExtUtils::MM_Unix + +methods used by ExtUtils::MakeMaker + +=item ExtUtils::MM_VMS + +methods to override Unix behaviour in ExtUtils::MakeMaker + +=item ExtUtils::MakeMaker + +create an extension Makefile + +=item ExtUtils::Manifest + +utilities to write and check a MANIFEST file + +=item ExtUtils::Mkbootstrap + +make a bootstrap file for use by DynaLoader + +=item ExtUtils::Mksymlists + +write linker options files for dynamic extension + +=item ExtUtils::testlib + +add blib/* directories to @INC + +=item Fatal + +make errors in builtins or Perl functions fatal + +=item Fcntl + +load the C Fcntl.h defines + +=item File::Basename + +split a pathname into pieces + +=item File::CheckTree + +run many filetest checks on a tree + +=item File::Compare + +compare files or filehandles + +=item File::Copy + +copy files or filehandles + +=item File::Find + +traverse a file tree + +=item File::Path + +create or remove a series of directories + +=item File::stat + +by-name interface to Perl's builtin stat() functions + +=item FileCache + +keep more files open than the system permits + +=item FileHandle + +supply object methods for filehandles + +=item FindBin + +locate directory of original Perl script + +=item GDBM_File + +access to the gdbm library + +=item Getopt::Long + +extended processing of command line options + +=item Getopt::Std + +process single-character switches with switch clustering + +=item I18N::Collate + +compare 8-bit scalar data according to the current locale + +=item IO + +load various IO modules + +=item IO::File + +supply object methods for filehandles + +=item IO::Handle + +supply object methods for I/O handles + +=item IO::Pipe + +supply object methods for pipes + +=item IO::Seekable + +supply seek based methods for I/O objects + +=item IO::Select + +OO interface to the select system call + +=item IO::Socket + +object interface to socket communications + +=item IPC::Open2 + +open a process for both reading and writing + +=item IPC::Open3 + +open a process for reading, writing, and error handling + +=item Math::BigFloat + +arbitrary length float math package + +=item Math::BigInt + +arbitrary size integer math package + +=item Math::Complex + +complex numbers and associated mathematical functions + +=item Math::Trig + +simple interface to parts of Math::Complex for those who +need trigonometric functions only for real numbers + +=item NDBM_File + +tied access to ndbm files + +=item Net::Ping + +Hello, anybody home? + +=item Net::hostent + +by-name interface to Perl's builtin gethost*() functions + +=item Net::netent + +by-name interface to Perl's builtin getnet*() functions + +=item Net::protoent + +by-name interface to Perl's builtin getproto*() functions + +=item Net::servent + +by-name interface to Perl's builtin getserv*() functions + +=item Opcode + +disable named opcodes when compiling or running Perl code + +=item Pod::Text + +convert POD data to formatted ASCII text + +=item POSIX + +interface to IEEE Standard 1003.1 + +=item SDBM_File + +tied access to sdbm files + +=item Safe + +compile and execute code in restricted compartments + +=item Search::Dict + +search for key in dictionary file + +=item SelectSaver + +save and restore selected file handle + +=item SelfLoader + +load functions only on demand + +=item Shell + +run shell commands transparently within Perl + +=item Socket + +load the C socket.h defines and structure manipulators + +=item Symbol + +manipulate Perl symbols and their names + +=item Sys::Hostname + +try every conceivable way to get hostname + +=item Sys::Syslog + +interface to the Unix syslog(3) calls + +=item Term::Cap + +termcap interface + +=item Term::Complete + +word completion module + +=item Term::ReadLine + +interface to various C packages + +=item Test::Harness + +run Perl standard test scripts with statistics + +=item Text::Abbrev + +create an abbreviation table from a list + +=item Text::ParseWords + +parse text into an array of tokens + +=item Text::Soundex + +implementation of the Soundex Algorithm as described by Knuth + +=item Text::Tabs + +expand and unexpand tabs per the Unix expand(1) and unexpand(1) + +=item Text::Wrap + +line wrapping to form simple paragraphs + +=item Tie::Hash + +base class definitions for tied hashes + +=item Tie::RefHash + +base class definitions for tied hashes with references as keys + +=item Tie::Scalar + +base class definitions for tied scalars + +=item Tie::SubstrHash + +fixed-table-size, fixed-key-length hashing + +=item Time::Local + +efficiently compute time from local and GMT time + +=item Time::gmtime + +by-name interface to Perl's builtin gmtime() function + +=item Time::localtime + +by-name interface to Perl's builtin localtime() function + +=item Time::tm + +internal object used by Time::gmtime and Time::localtime + +=item UNIVERSAL + +base class for ALL classes (blessed references) + +=item User::grent + +by-name interface to Perl's builtin getgr*() functions + +=item User::pwent + +by-name interface to Perl's builtin getpw*() functions + +=back + +To find out I the modules installed on your system, including +those without documentation or outside the standard release, do this: + + % find `perl -e 'print "@INC"'` -name '*.pm' -print + +They should all have their own documentation installed and accessible via +your system man(1) command. If that fails, try the I program. + +=head2 Extension Modules + +Extension modules are written in C (or a mix of Perl and C) and may be +statically linked or in general are +dynamically loaded into Perl if and when you need them. Supported +extension modules include the Socket, Fcntl, and POSIX modules. + +Many popular C extension modules do not come bundled (at least, not +completely) due to their sizes, volatility, or simply lack of time for +adequate testing and configuration across the multitude of platforms on +which Perl was beta-tested. You are encouraged to look for them in +archie(1L), the Perl FAQ or Meta-FAQ, the WWW page, and even with their +authors before randomly posting asking for their present condition and +disposition. + +=head1 CPAN + +CPAN stands for the Comprehensive Perl Archive Network. This is a globally +replicated collection of all known Perl materials, including hundreds +of unbundled modules. Here are the major categories of modules: + +=over + +=item * +Language Extensions and Documentation Tools + +=item * +Development Support + +=item * +Operating System Interfaces + +=item * +Networking, Device Control (modems) and InterProcess Communication + +=item * +Data Types and Data Type Utilities + +=item * +Database Interfaces + +=item * +User Interfaces + +=item * +Interfaces to / Emulations of Other Programming Languages + +=item * +File Names, File Systems and File Locking (see also File Handles) + +=item * +String Processing, Language Text Processing, Parsing, and Searching + +=item * +Option, Argument, Parameter, and Configuration File Processing + +=item * +Internationalization and Locale + +=item * +Authentication, Security, and Encryption + +=item * +World Wide Web, HTML, HTTP, CGI, MIME + +=item * +Server and Daemon Utilities + +=item * +Archiving and Compression + +=item * +Images, Pixmap and Bitmap Manipulation, Drawing, and Graphing + +=item * +Mail and Usenet News + +=item * +Control Flow Utilities (callbacks and exceptions etc) + +=item * +File Handle and Input/Output Stream Utilities + +=item * +Miscellaneous Modules + +=back + +The registered CPAN sites as of this writing include the following. +You should try to choose one close to you: + +=over + +=item * +Africa + + South Africa ftp://ftp.is.co.za/programming/perl/CPAN/ + +=item * +Asia + + Hong Kong ftp://ftp.hkstar.com/pub/CPAN/ + Japan ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/ + ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/ + South Korea ftp://ftp.nuri.net/pub/CPAN/ + Taiwan ftp://dongpo.math.ncu.edu.tw/perl/CPAN/ + ftp://ftp.wownet.net/pub2/PERL/ + +=item * +Australasia + + Australia ftp://ftp.netinfo.com.au/pub/perl/CPAN/ + New Zealand ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/ + +=item * +Europe + + Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/ + Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/ + Czech Republic ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/ + Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/ + Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/ + France ftp://ftp.ibp.fr/pub/perl/CPAN/ + ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/ + Germany ftp://ftp.gmd.de/packages/CPAN/ + ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/ + ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/ + ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ + ftp://ftp.uni-erlangen.de/pub/source/Perl/CPAN/ + ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/ + Greece ftp://ftp.ntua.gr/pub/lang/perl/ + Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/ + Italy ftp://cis.utovrm.it/CPAN/ + the Netherlands ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/ + ftp://ftp.EU.net/packages/cpan/ + Norway ftp://ftp.uit.no/pub/languages/perl/cpan/ + Poland ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/ + ftp://sunsite.icm.edu.pl/pub/CPAN/ + Portugal ftp://ftp.ci.uminho.pt/pub/lang/perl/ + ftp://ftp.telepac.pt/pub/CPAN/ + Russia ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/ + Slovenia ftp://ftp.arnes.si/software/perl/CPAN/ + Spain ftp://ftp.etse.urv.es/pub/mirror/perl/ + ftp://ftp.rediris.es/mirror/CPAN/ + Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/ + UK ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ + ftp://sunsite.doc.ic.ac.uk/packages/CPAN/ + ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/ + +=item * +North America + + Ontario ftp://ftp.utilis.com/public/CPAN/ + ftp://enterprise.ic.gc.ca/pub/perl/CPAN/ + Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/ + California ftp://ftp.digital.com/pub/plan/perl/CPAN/ + ftp://ftp.cdrom.com/pub/perl/CPAN/ + Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ + Florida ftp://ftp.cis.ufl.edu/pub/perl/CPAN/ + Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/ + Massachusetts ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/ + New York ftp://ftp.rge.com/pub/languages/perl/ + North Carolina ftp://ftp.duke.edu/pub/perl/ + Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/ + Oregon http://www.perl.org/CPAN/ + ftp://ftp.orst.edu/pub/packages/CPAN/ + Pennsylvania ftp://ftp.epix.net/pub/languages/perl/ + Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/ + ftp://ftp.metronet.com/pub/perl/ + +=item * +South America + + Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/ + +=back + +For an up-to-date listing of CPAN sites, +see F or F. + +=head1 Modules: Creation, Use, and Abuse + +(The following section is borrowed directly from Tim Bunce's modules +file, available at your nearest CPAN site.) + +Perl implements a class using a package, but the presence of a +package doesn't imply the presence of a class. A package is just a +namespace. A class is a package that provides subroutines that can be +used as methods. A method is just a subroutine that expects, as its +first argument, either the name of a package (for "static" methods), +or a reference to something (for "virtual" methods). + +A module is a file that (by convention) provides a class of the same +name (sans the .pm), plus an import method in that class that can be +called to fetch exported symbols. This module may implement some of +its methods by loading dynamic C or C++ objects, but that should be +totally transparent to the user of the module. Likewise, the module +might set up an AUTOLOAD function to slurp in subroutine definitions on +demand, but this is also transparent. Only the F<.pm> file is required to +exist. See L, L, and L for details about +the AUTOLOAD mechanism. + +=head2 Guidelines for Module Creation + +=over 4 + +=item Do similar modules already exist in some form? + +If so, please try to reuse the existing modules either in whole or +by inheriting useful features into a new class. If this is not +practical try to get together with the module authors to work on +extending or enhancing the functionality of the existing modules. +A perfect example is the plethora of packages in perl4 for dealing +with command line options. + +If you are writing a module to expand an already existing set of +modules, please coordinate with the author of the package. It +helps if you follow the same naming scheme and module interaction +scheme as the original author. + +=item Try to design the new module to be easy to extend and reuse. + +Use blessed references. Use the two argument form of bless to bless +into the class name given as the first parameter of the constructor, +e.g.,: + + sub new { + my $class = shift; + return bless {}, $class; + } + +or even this if you'd like it to be used as either a static +or a virtual method. + + sub new { + my $self = shift; + my $class = ref($self) || $self; + return bless {}, $class; + } + +Pass arrays as references so more parameters can be added later +(it's also faster). Convert functions into methods where +appropriate. Split large methods into smaller more flexible ones. +Inherit methods from other modules if appropriate. + +Avoid class name tests like: C. +Generally you can delete the "C" part with no harm at all. +Let the objects look after themselves! Generally, avoid hard-wired +class names as far as possible. + +Avoid C<$r-EClass::func()> where using C<@ISA=qw(... Class ...)> and +C<$r-Efunc()> would work (see L for more details). + +Use autosplit so little used or newly added functions won't be a +burden to programs that don't use them. Add test functions to +the module after __END__ either using AutoSplit or by saying: + + eval join('',) || die $@ unless caller(); + +Does your module pass the 'empty subclass' test? If you say +"C<@SUBCLASS::ISA = qw(YOURCLASS);>" your applications should be able +to use SUBCLASS in exactly the same way as YOURCLASS. For example, +does your application still work if you change: C<$obj = new YOURCLASS;> +into: C<$obj = new SUBCLASS;> ? + +Avoid keeping any state information in your packages. It makes it +difficult for multiple other packages to use yours. Keep state +information in objects. + +Always use B<-w>. Try to C (or C). +Remember that you can add C to individual blocks +of code that need less strictness. Always use B<-w>. Always use B<-w>! +Follow the guidelines in the perlstyle(1) manual. + +=item Some simple style guidelines + +The perlstyle manual supplied with Perl has many helpful points. + +Coding style is a matter of personal taste. Many people evolve their +style over several years as they learn what helps them write and +maintain good code. Here's one set of assorted suggestions that +seem to be widely used by experienced developers: + +Use underscores to separate words. It is generally easier to read +$var_names_like_this than $VarNamesLikeThis, especially for +non-native speakers of English. It's also a simple rule that works +consistently with VAR_NAMES_LIKE_THIS. + +Package/Module names are an exception to this rule. Perl informally +reserves lowercase module names for 'pragma' modules like integer +and strict. Other modules normally begin with a capital letter and +use mixed case with no underscores (need to be short and portable). + +You may find it helpful to use letter case to indicate the scope +or nature of a variable. For example: + + $ALL_CAPS_HERE constants only (beware clashes with Perl vars) + $Some_Caps_Here package-wide global/static + $no_caps_here function scope my() or local() variables + +Function and method names seem to work best as all lowercase. +e.g., C<$obj-Eas_string()>. + +You can use a leading underscore to indicate that a variable or +function should not be used outside the package that defined it. + +=item Select what to export. + +Do NOT export method names! + +Do NOT export anything else by default without a good reason! + +Exports pollute the namespace of the module user. If you must +export try to use @EXPORT_OK in preference to @EXPORT and avoid +short or common names to reduce the risk of name clashes. + +Generally anything not exported is still accessible from outside the +module using the ModuleName::item_name (or C<$blessed_ref-Emethod>) +syntax. By convention you can use a leading underscore on names to +indicate informally that they are 'internal' and not for public use. + +(It is actually possible to get private functions by saying: +C. But there's no way to call that +directly as a method, because a method must have a name in the symbol +table.) + +As a general rule, if the module is trying to be object oriented +then export nothing. If it's just a collection of functions then +@EXPORT_OK anything but use @EXPORT with caution. + +=item Select a name for the module. + +This name should be as descriptive, accurate, and complete as +possible. Avoid any risk of ambiguity. Always try to use two or +more whole words. Generally the name should reflect what is special +about what the module does rather than how it does it. Please use +nested module names to group informally or categorize a module. +There should be a very good reason for a module not to have a nested name. +Module names should begin with a capital letter. + +Having 57 modules all called Sort will not make life easy for anyone +(though having 23 called Sort::Quick is only marginally better :-). +Imagine someone trying to install your module alongside many others. +If in any doubt ask for suggestions in comp.lang.perl.misc. + +If you are developing a suite of related modules/classes it's good +practice to use nested classes with a common prefix as this will +avoid namespace clashes. For example: Xyz::Control, Xyz::View, +Xyz::Model etc. Use the modules in this list as a naming guide. + +If adding a new module to a set, follow the original author's +standards for naming modules and the interface to methods in +those modules. + +To be portable each component of a module name should be limited to +11 characters. If it might be used on MS-DOS then try to ensure each is +unique in the first 8 characters. Nested modules make this easier. + +=item Have you got it right? + +How do you know that you've made the right decisions? Have you +picked an interface design that will cause problems later? Have +you picked the most appropriate name? Do you have any questions? + +The best way to know for sure, and pick up many helpful suggestions, +is to ask someone who knows. Comp.lang.perl.misc is read by just about +all the people who develop modules and it's the best place to ask. + +All you need to do is post a short summary of the module, its +purpose and interfaces. A few lines on each of the main methods is +probably enough. (If you post the whole module it might be ignored +by busy people - generally the very people you want to read it!) + +Don't worry about posting if you can't say when the module will be +ready - just say so in the message. It might be worth inviting +others to help you, they may be able to complete it for you! + +=item README and other Additional Files. + +It's well known that software developers usually fully document the +software they write. If, however, the world is in urgent need of +your software and there is not enough time to write the full +documentation please at least provide a README file containing: + +=over 10 + +=item * +A description of the module/package/extension etc. + +=item * +A copyright notice - see below. + +=item * +Prerequisites - what else you may need to have. + +=item * +How to build it - possible changes to Makefile.PL etc. + +=item * +How to install it. + +=item * +Recent changes in this release, especially incompatibilities + +=item * +Changes / enhancements you plan to make in the future. + +=back + +If the README file seems to be getting too large you may wish to +split out some of the sections into separate files: INSTALL, +Copying, ToDo etc. + +=over 4 + +=item Adding a Copyright Notice. + +How you choose to license your work is a personal decision. +The general mechanism is to assert your Copyright and then make +a declaration of how others may copy/use/modify your work. + +Perl, for example, is supplied with two types of licence: The GNU +GPL and The Artistic Licence (see the files README, Copying, and +Artistic). Larry has good reasons for NOT just using the GNU GPL. + +My personal recommendation, out of respect for Larry, Perl, and the +Perl community at large is to state something simply like: + + Copyright (c) 1995 Your Name. All rights reserved. + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + +This statement should at least appear in the README file. You may +also wish to include it in a Copying file and your source files. +Remember to include the other words in addition to the Copyright. + +=item Give the module a version/issue/release number. + +To be fully compatible with the Exporter and MakeMaker modules you +should store your module's version number in a non-my package +variable called $VERSION. This should be a floating point +number with at least two digits after the decimal (i.e., hundredths, +e.g, C<$VERSION = "0.01">). Don't use a "1.3.2" style version. +See Exporter.pm in Perl5.001m or later for details. + +It may be handy to add a function or method to retrieve the number. +Use the number in announcements and archive file names when +releasing the module (ModuleName-1.02.tar.Z). +See perldoc ExtUtils::MakeMaker.pm for details. + +=item How to release and distribute a module. + +It's good idea to post an announcement of the availability of your +module (or the module itself if small) to the comp.lang.perl.announce +Usenet newsgroup. This will at least ensure very wide once-off +distribution. + +If possible you should place the module into a major ftp archive and +include details of its location in your announcement. + +Some notes about ftp archives: Please use a long descriptive file +name that includes the version number. Most incoming directories +will not be readable/listable, i.e., you won't be able to see your +file after uploading it. Remember to send your email notification +message as soon as possible after uploading else your file may get +deleted automatically. Allow time for the file to be processed +and/or check the file has been processed before announcing its +location. + +FTP Archives for Perl Modules: + +Follow the instructions and links on + + http://franz.ww.tu-berlin.de/modulelist + +or upload to one of these sites: + + ftp://franz.ww.tu-berlin.de/incoming + ftp://ftp.cis.ufl.edu/incoming + +and notify >. + +By using the WWW interface you can ask the Upload Server to mirror +your modules from your ftp or WWW site into your own directory on +CPAN! + +Please remember to send me an updated entry for the Module list! + +=item Take care when changing a released module. + +Always strive to remain compatible with previous released versions. +Otherwise try to add a mechanism to revert to the +old behaviour if people rely on it. Document incompatible changes. + +=back + +=back + +=head2 Guidelines for Converting Perl 4 Library Scripts into Modules + +=over 4 + +=item There is no requirement to convert anything. + +If it ain't broke, don't fix it! Perl 4 library scripts should +continue to work with no problems. You may need to make some minor +changes (like escaping non-array @'s in double quoted strings) but +there is no need to convert a .pl file into a Module for just that. + +=item Consider the implications. + +All Perl applications that make use of the script will need to +be changed (slightly) if the script is converted into a module. Is +it worth it unless you plan to make other changes at the same time? + +=item Make the most of the opportunity. + +If you are going to convert the script to a module you can use the +opportunity to redesign the interface. The 'Guidelines for Module +Creation' above include many of the issues you should consider. + +=item The pl2pm utility will get you started. + +This utility will read *.pl files (given as parameters) and write +corresponding *.pm files. The pl2pm utilities does the following: + +=over 10 + +=item * +Adds the standard Module prologue lines + +=item * +Converts package specifiers from ' to :: + +=item * +Converts die(...) to croak(...) + +=item * +Several other minor changes + +=back + +Being a mechanical process pl2pm is not bullet proof. The converted +code will need careful checking, especially any package statements. +Don't delete the original .pl file till the new .pm one works! + +=back + +=head2 Guidelines for Reusing Application Code + +=over 4 + +=item Complete applications rarely belong in the Perl Module Library. + +=item Many applications contain some Perl code that could be reused. + +Help save the world! Share your code in a form that makes it easy +to reuse. + +=item Break-out the reusable code into one or more separate module files. + +=item Take the opportunity to reconsider and redesign the interfaces. + +=item In some cases the 'application' can then be reduced to a small + +fragment of code built on top of the reusable modules. In these cases +the application could invoked as: + + % perl -e 'use Module::Name; method(@ARGV)' ... +or + % perl -mModule::Name ... (in perl5.002 or higher) + +=back + +=head1 NOTE + +Perl does not enforce private and public parts of its modules as you may +have been used to in other languages like C++, Ada, or Modula-17. Perl +doesn't have an infatuation with enforced privacy. It would prefer +that you stayed out of its living room because you weren't invited, not +because it has a shotgun. + +The module and its user have a contract, part of which is common law, +and part of which is "written". Part of the common law contract is +that a module doesn't pollute any namespace it wasn't asked to. The +written contract for the module (A.K.A. documentation) may make other +provisions. But then you know when you C that +you're redefining the world and willing to take the consequences. diff --git a/contrib/perl5/pod/perlobj.pod b/contrib/perl5/pod/perlobj.pod new file mode 100644 index 00000000000..f10fbdfe2e6 --- /dev/null +++ b/contrib/perl5/pod/perlobj.pod @@ -0,0 +1,541 @@ +=head1 NAME + +perlobj - Perl objects + +=head1 DESCRIPTION + +First of all, you need to understand what references are in Perl. +See L for that. Second, if you still find the following +reference work too complicated, a tutorial on object-oriented programming +in Perl can be found in L. + +If you're still with us, then +here are three very simple definitions that you should find reassuring. + +=over 4 + +=item 1. + +An object is simply a reference that happens to know which class it +belongs to. + +=item 2. + +A class is simply a package that happens to provide methods to deal +with object references. + +=item 3. + +A method is simply a subroutine that expects an object reference (or +a package name, for class methods) as the first argument. + +=back + +We'll cover these points now in more depth. + +=head2 An Object is Simply a Reference + +Unlike say C++, Perl doesn't provide any special syntax for +constructors. A constructor is merely a subroutine that returns a +reference to something "blessed" into a class, generally the +class that the subroutine is defined in. Here is a typical +constructor: + + package Critter; + sub new { bless {} } + +That word C isn't special. You could have written +a construct this way, too: + + package Critter; + sub spawn { bless {} } + +In fact, this might even be preferable, because the C++ programmers won't +be tricked into thinking that C works in Perl as it does in C++. +It doesn't. We recommend that you name your constructors whatever +makes sense in the context of the problem you're solving. For example, +constructors in the Tk extension to Perl are named after the widgets +they create. + +One thing that's different about Perl constructors compared with those in +C++ is that in Perl, they have to allocate their own memory. (The other +things is that they don't automatically call overridden base-class +constructors.) The C<{}> allocates an anonymous hash containing no +key/value pairs, and returns it The bless() takes that reference and +tells the object it references that it's now a Critter, and returns +the reference. This is for convenience, because the referenced object +itself knows that it has been blessed, and the reference to it could +have been returned directly, like this: + + sub new { + my $self = {}; + bless $self; + return $self; + } + +In fact, you often see such a thing in more complicated constructors +that wish to call methods in the class as part of the construction: + + sub new { + my $self = {}; + bless $self; + $self->initialize(); + return $self; + } + +If you care about inheritance (and you should; see +L), +then you want to use the two-arg form of bless +so that your constructors may be inherited: + + sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + $self->initialize(); + return $self; + } + +Or if you expect people to call not just Cnew()> but also +C<$obj-Enew()>, then use something like this. The initialize() +method used will be of whatever $class we blessed the +object into: + + sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(); + return $self; + } + +Within the class package, the methods will typically deal with the +reference as an ordinary reference. Outside the class package, +the reference is generally treated as an opaque value that may +be accessed only through the class's methods. + +A constructor may re-bless a referenced object currently belonging to +another class, but then the new class is responsible for all cleanup +later. The previous blessing is forgotten, as an object may belong +to only one class at a time. (Although of course it's free to +inherit methods from many classes.) If you find yourself having to +do this, the parent class is probably misbehaving, though. + +A clarification: Perl objects are blessed. References are not. Objects +know which package they belong to. References do not. The bless() +function uses the reference to find the object. Consider +the following example: + + $a = {}; + $b = $a; + bless $a, BLAH; + print "\$b is a ", ref($b), "\n"; + +This reports $b as being a BLAH, so obviously bless() +operated on the object and not on the reference. + +=head2 A Class is Simply a Package + +Unlike say C++, Perl doesn't provide any special syntax for class +definitions. You use a package as a class by putting method +definitions into the class. + +There is a special array within each package called @ISA, which says +where else to look for a method if you can't find it in the current +package. This is how Perl implements inheritance. Each element of the +@ISA array is just the name of another package that happens to be a +class package. The classes are searched (depth first) for missing +methods in the order that they occur in @ISA. The classes accessible +through @ISA are known as base classes of the current class. + +All classes implicitly inherit from class C as their +last base class. Several commonly used methods are automatically +supplied in the UNIVERSAL class; see L<"Default UNIVERSAL methods"> for +more details. + +If a missing method is found in one of the base classes, it is cached +in the current class for efficiency. Changing @ISA or defining new +subroutines invalidates the cache and causes Perl to do the lookup again. + +If neither the current class, its named base classes, nor the UNIVERSAL +class contains the requested method, these three places are searched +all over again, this time looking for a method named AUTOLOAD(). If an +AUTOLOAD is found, this method is called on behalf of the missing method, +setting the package global $AUTOLOAD to be the fully qualified name of +the method that was intended to be called. + +If none of that works, Perl finally gives up and complains. + +Perl classes do method inheritance only. Data inheritance is left up +to the class itself. By and large, this is not a problem in Perl, +because most classes model the attributes of their object using an +anonymous hash, which serves as its own little namespace to be carved up +by the various classes that might want to do something with the object. +The only problem with this is that you can't sure that you aren't using +a piece of the hash that isn't already used. A reasonable workaround +is to prepend your fieldname in the hash with the package name. + + sub bump { + my $self = shift; + $self->{ __PACKAGE__ . ".count"}++; + } + +=head2 A Method is Simply a Subroutine + +Unlike say C++, Perl doesn't provide any special syntax for method +definition. (It does provide a little syntax for method invocation +though. More on that later.) A method expects its first argument +to be the object (reference) or package (string) it is being invoked on. There are just two +types of methods, which we'll call class and instance. +(Sometimes you'll hear these called static and virtual, in honor of +the two C++ method types they most closely resemble.) + +A class method expects a class name as the first argument. It +provides functionality for the class as a whole, not for any individual +object belonging to the class. Constructors are typically class +methods. Many class methods simply ignore their first argument, because +they already know what package they're in, and don't care what package +they were invoked via. (These aren't necessarily the same, because +class methods follow the inheritance tree just like ordinary instance +methods.) Another typical use for class methods is to look up an +object by name: + + sub find { + my ($class, $name) = @_; + $objtable{$name}; + } + +An instance method expects an object reference as its first argument. +Typically it shifts the first argument into a "self" or "this" variable, +and then uses that as an ordinary reference. + + sub display { + my $self = shift; + my @keys = @_ ? @_ : sort keys %$self; + foreach $key (@keys) { + print "\t$key => $self->{$key}\n"; + } + } + +=head2 Method Invocation + +There are two ways to invoke a method, one of which you're already +familiar with, and the other of which will look familiar. Perl 4 +already had an "indirect object" syntax that you use when you say + + print STDERR "help!!!\n"; + +This same syntax can be used to call either class or instance methods. +We'll use the two methods defined above, the class method to lookup +an object reference and the instance method to print out its attributes. + + $fred = find Critter "Fred"; + display $fred 'Height', 'Weight'; + +These could be combined into one statement by using a BLOCK in the +indirect object slot: + + display {find Critter "Fred"} 'Height', 'Weight'; + +For C++ fans, there's also a syntax using -E notation that does exactly +the same thing. The parentheses are required if there are any arguments. + + $fred = Critter->find("Fred"); + $fred->display('Height', 'Weight'); + +or in one statement, + + Critter->find("Fred")->display('Height', 'Weight'); + +There are times when one syntax is more readable, and times when the +other syntax is more readable. The indirect object syntax is less +cluttered, but it has the same ambiguity as ordinary list operators. +Indirect object method calls are parsed using the same rule as list +operators: "If it looks like a function, it is a function". (Presuming +for the moment that you think two words in a row can look like a +function name. C++ programmers seem to think so with some regularity, +especially when the first word is "new".) Thus, the parentheses of + + new Critter ('Barney', 1.5, 70) + +are assumed to surround ALL the arguments of the method call, regardless +of what comes after. Saying + + new Critter ('Bam' x 2), 1.4, 45 + +would be equivalent to + + Critter->new('Bam' x 2), 1.4, 45 + +which is unlikely to do what you want. + +There are times when you wish to specify which class's method to use. +In this case, you can call your method as an ordinary subroutine +call, being sure to pass the requisite first argument explicitly: + + $fred = MyCritter::find("Critter", "Fred"); + MyCritter::display($fred, 'Height', 'Weight'); + +Note however, that this does not do any inheritance. If you wish +merely to specify that Perl should I looking for a method in a +particular package, use an ordinary method call, but qualify the method +name with the package like this: + + $fred = Critter->MyCritter::find("Fred"); + $fred->MyCritter::display('Height', 'Weight'); + +If you're trying to control where the method search begins I you're +executing in the class itself, then you may use the SUPER pseudo class, +which says to start looking in your base class's @ISA list without having +to name it explicitly: + + $self->SUPER::display('Height', 'Weight'); + +Please note that the C construct is meaningful I within the +class. + +Sometimes you want to call a method when you don't know the method name +ahead of time. You can use the arrow form, replacing the method name +with a simple scalar variable containing the method name: + + $method = $fast ? "findfirst" : "findbest"; + $fred->$method(@args); + +=head2 Default UNIVERSAL methods + +The C package automatically contains the following methods that +are inherited by all other classes: + +=over 4 + +=item isa(CLASS) + +C returns I if its object is blessed into a subclass of C + +C is also exportable and can be called as a sub with two arguments. This +allows the ability to check what a reference points to. Example + + use UNIVERSAL qw(isa); + + if(isa($ref, 'ARRAY')) { + #... + } + +=item can(METHOD) + +C checks to see if its object has a method called C, +if it does then a reference to the sub is returned, if it does not then +I is returned. + +=item VERSION( [NEED] ) + +C returns the version number of the class (package). If the +NEED argument is given then it will check that the current version (as +defined by the $VERSION variable in the given package) not less than +NEED; it will die if this is not the case. This method is normally +called as a class method. This method is called automatically by the +C form of C. + + use A 1.2 qw(some imported subs); + # implies: + A->VERSION(1.2); + +=back + +B C directly uses Perl's internal code for method lookup, and +C uses a very similar method and cache-ing strategy. This may cause +strange effects if the Perl code dynamically changes @ISA in any package. + +You may add other methods to the UNIVERSAL class via Perl or XS code. +You do not need to C in order to make these methods +available to your program. This is necessary only if you wish to +have C available as a plain subroutine in the current package. + +=head2 Destructors + +When the last reference to an object goes away, the object is +automatically destroyed. (This may even be after you exit, if you've +stored references in global variables.) If you want to capture control +just before the object is freed, you may define a DESTROY method in +your class. It will automatically be called at the appropriate moment, +and you can do any extra cleanup you need to do. Perl passes a reference +to the object under destruction as the first (and only) argument. Beware +that the reference is a read-only value, and cannot be modified by +manipulating C<$_[0]> within the destructor. The object itself (i.e. +the thingy the reference points to, namely C<${$_[0]}>, C<@{$_[0]}>, +C<%{$_[0]}> etc.) is not similarly constrained. + +If you arrange to re-bless the reference before the destructor returns, +perl will again call the DESTROY method for the re-blessed object after +the current one returns. This can be used for clean delegation of +object destruction, or for ensuring that destructors in the base classes +of your choosing get called. Explicitly calling DESTROY is also possible, +but is usually never needed. + +Do not confuse the foregoing with how objects I in the current +one are destroyed. Such objects will be freed and destroyed automatically +when the current object is freed, provided no other references to them exist +elsewhere. + +=head2 WARNING + +While indirect object syntax may well be appealing to English speakers and +to C++ programmers, be not seduced! It suffers from two grave problems. + +The first problem is that an indirect object is limited to a name, +a scalar variable, or a block, because it would have to do too much +lookahead otherwise, just like any other postfix dereference in the +language. (These are the same quirky rules as are used for the filehandle +slot in functions like C and C.) This can lead to horribly +confusing precedence problems, as in these next two lines: + + move $obj->{FIELD}; # probably wrong! + move $ary[$i]; # probably wrong! + +Those actually parse as the very surprising: + + $obj->move->{FIELD}; # Well, lookee here + $ary->move->[$i]; # Didn't expect this one, eh? + +Rather than what you might have expected: + + $obj->{FIELD}->move(); # You should be so lucky. + $ary[$i]->move; # Yeah, sure. + +The left side of ``-E'' is not so limited, because it's an infix operator, +not a postfix operator. + +As if that weren't bad enough, think about this: Perl must guess I whether C and C above are functions or methods. +Usually Perl gets it right, but when it doesn't it, you get a function +call compiled as a method, or vice versa. This can introduce subtle +bugs that are hard to unravel. For example, calling a method C +in indirect notation--as C++ programmers are so wont to do--can +be miscompiled into a subroutine call if there's already a C +function in scope. You'd end up calling the current package's C +as a subroutine, rather than the desired class's method. The compiler +tries to cheat by remembering bareword Cs, but the grief if it +messes up just isn't worth the years of debugging it would likely take +you to to track such subtle bugs down. + +The infix arrow notation using ``C<-E>'' doesn't suffer from either +of these disturbing ambiguities, so we recommend you use it exclusively. + +=head2 Summary + +That's about all there is to it. Now you need just to go off and buy a +book about object-oriented design methodology, and bang your forehead +with it for the next six months or so. + +=head2 Two-Phased Garbage Collection + +For most purposes, Perl uses a fast and simple reference-based +garbage collection system. For this reason, there's an extra +dereference going on at some level, so if you haven't built +your Perl executable using your C compiler's C<-O> flag, performance +will suffer. If you I built Perl with C, then this +probably won't matter. + +A more serious concern is that unreachable memory with a non-zero +reference count will not normally get freed. Therefore, this is a bad +idea: + + { + my $a; + $a = \$a; + } + +Even thought $a I go away, it can't. When building recursive data +structures, you'll have to break the self-reference yourself explicitly +if you don't care to leak. For example, here's a self-referential +node such as one might use in a sophisticated tree structure: + + sub new_node { + my $self = shift; + my $class = ref($self) || $self; + my $node = {}; + $node->{LEFT} = $node->{RIGHT} = $node; + $node->{DATA} = [ @_ ]; + return bless $node => $class; + } + +If you create nodes like that, they (currently) won't go away unless you +break their self reference yourself. (In other words, this is not to be +construed as a feature, and you shouldn't depend on it.) + +Almost. + +When an interpreter thread finally shuts down (usually when your program +exits), then a rather costly but complete mark-and-sweep style of garbage +collection is performed, and everything allocated by that thread gets +destroyed. This is essential to support Perl as an embedded or a +multithreadable language. For example, this program demonstrates Perl's +two-phased garbage collection: + + #!/usr/bin/perl + package Subtle; + + sub new { + my $test; + $test = \$test; + warn "CREATING " . \$test; + return bless \$test; + } + + sub DESTROY { + my $self = shift; + warn "DESTROYING $self"; + } + + package main; + + warn "starting program"; + { + my $a = Subtle->new; + my $b = Subtle->new; + $$a = 0; # break selfref + warn "leaving block"; + } + + warn "just exited block"; + warn "time to die..."; + exit; + +When run as F, the following output is produced: + + starting program at /tmp/test line 18. + CREATING SCALAR(0x8e5b8) at /tmp/test line 7. + CREATING SCALAR(0x8e57c) at /tmp/test line 7. + leaving block at /tmp/test line 23. + DESTROYING Subtle=SCALAR(0x8e5b8) at /tmp/test line 13. + just exited block at /tmp/test line 26. + time to die... at /tmp/test line 27. + DESTROYING Subtle=SCALAR(0x8e57c) during global destruction. + +Notice that "global destruction" bit there? That's the thread +garbage collector reaching the unreachable. + +Objects are always destructed, even when regular refs aren't and in fact +are destructed in a separate pass before ordinary refs just to try to +prevent object destructors from using refs that have been themselves +destructed. Plain refs are only garbage-collected if the destruct level +is greater than 0. You can test the higher levels of global destruction +by setting the PERL_DESTRUCT_LEVEL environment variable, presuming +C<-DDEBUGGING> was enabled during perl build time. + +A more complete garbage collection strategy will be implemented +at a future date. + +In the meantime, the best solution is to create a non-recursive container +class that holds a pointer to the self-referential data structure. +Define a DESTROY method for the containing object's class that manually +breaks the circularities in the self-referential structure. + +=head1 SEE ALSO + +A kinder, gentler tutorial on object-oriented programming in Perl can +be found in L. +You should also check out L for other object tricks, traps, and tips, +as well as L for some style guides on constructing both modules +and classes. diff --git a/contrib/perl5/pod/perlop.pod b/contrib/perl5/pod/perlop.pod new file mode 100644 index 00000000000..c7209fac28e --- /dev/null +++ b/contrib/perl5/pod/perlop.pod @@ -0,0 +1,1724 @@ +=head1 NAME + +perlop - Perl operators and precedence + +=head1 SYNOPSIS + +Perl operators have the following associativity and precedence, +listed from highest precedence to lowest. Note that all operators +borrowed from C keep the same precedence relationship with each other, +even where C's precedence is slightly screwy. (This makes learning +Perl easier for C folks.) With very few exceptions, these all +operate on scalar values only, not array values. + + left terms and list operators (leftward) + left -> + nonassoc ++ -- + right ** + right ! ~ \ and unary + and - + left =~ !~ + left * / % x + left + - . + left << >> + nonassoc named unary operators + nonassoc < > <= >= lt gt le ge + nonassoc == != <=> eq ne cmp + left & + left | ^ + left && + left || + nonassoc .. ... + right ?: + right = += -= *= etc. + left , => + nonassoc list operators (rightward) + right not + left and + left or xor + +In the following sections, these operators are covered in precedence order. + +Many operators can be overloaded for objects. See L. + +=head1 DESCRIPTION + +=head2 Terms and List Operators (Leftward) + +A TERM has the highest precedence in Perl. They includes variables, +quote and quote-like operators, any expression in parentheses, +and any function whose arguments are parenthesized. Actually, there +aren't really functions in this sense, just list operators and unary +operators behaving as functions because you put parentheses around +the arguments. These are all documented in L. + +If any list operator (print(), etc.) or any unary operator (chdir(), etc.) +is followed by a left parenthesis as the next token, the operator and +arguments within parentheses are taken to be of highest precedence, +just like a normal function call. + +In the absence of parentheses, the precedence of list operators such as +C, C, or C is either very high or very low depending on +whether you are looking at the left side or the right side of the operator. +For example, in + + @ary = (1, 3, sort 4, 2); + print @ary; # prints 1324 + +the commas on the right of the sort are evaluated before the sort, but +the commas on the left are evaluated after. In other words, list +operators tend to gobble up all the arguments that follow them, and +then act like a simple TERM with regard to the preceding expression. +Note that you have to be careful with parentheses: + + # These evaluate exit before doing the print: + print($foo, exit); # Obviously not what you want. + print $foo, exit; # Nor is this. + + # These do the print before evaluating exit: + (print $foo), exit; # This is what you want. + print($foo), exit; # Or this. + print ($foo), exit; # Or even this. + +Also note that + + print ($foo & 255) + 1, "\n"; + +probably doesn't do what you expect at first glance. See +L for more discussion of this. + +Also parsed as terms are the C and C constructs, as +well as subroutine and method calls, and the anonymous +constructors C<[]> and C<{}>. + +See also L toward the end of this section, +as well as L<"I/O Operators">. + +=head2 The Arrow Operator + +Just as in C and C++, "C<-E>" is an infix dereference operator. If the +right side is either a C<[...]> or C<{...}> subscript, then the left side +must be either a hard or symbolic reference to an array or hash (or +a location capable of holding a hard reference, if it's an lvalue (assignable)). +See L. + +Otherwise, the right side is a method name or a simple scalar variable +containing the method name, and the left side must either be an object +(a blessed reference) or a class name (that is, a package name). +See L. + +=head2 Auto-increment and Auto-decrement + +"++" and "--" work as in C. That is, if placed before a variable, they +increment or decrement the variable before returning the value, and if +placed after, increment or decrement the variable after returning the value. + +The auto-increment operator has a little extra builtin magic to it. If +you increment a variable that is numeric, or that has ever been used in +a numeric context, you get a normal increment. If, however, the +variable has been used in only string contexts since it was set, and +has a value that is not the empty string and matches the pattern +C, the increment is done as a string, preserving each +character within its range, with carry: + + print ++($foo = '99'); # prints '100' + print ++($foo = 'a0'); # prints 'a1' + print ++($foo = 'Az'); # prints 'Ba' + print ++($foo = 'zz'); # prints 'aaa' + +The auto-decrement operator is not magical. + +=head2 Exponentiation + +Binary "**" is the exponentiation operator. Note that it binds even more +tightly than unary minus, so -2**4 is -(2**4), not (-2)**4. (This is +implemented using C's pow(3) function, which actually works on doubles +internally.) + +=head2 Symbolic Unary Operators + +Unary "!" performs logical negation, i.e., "not". See also C for a lower +precedence version of this. + +Unary "-" performs arithmetic negation if the operand is numeric. If +the operand is an identifier, a string consisting of a minus sign +concatenated with the identifier is returned. Otherwise, if the string +starts with a plus or minus, a string starting with the opposite sign +is returned. One effect of these rules is that C<-bareword> is equivalent +to C<"-bareword">. + +Unary "~" performs bitwise negation, i.e., 1's complement. For example, +C<0666 &~ 027> is 0640. (See also L and L.) + +Unary "+" has no effect whatsoever, even on strings. It is useful +syntactically for separating a function name from a parenthesized expression +that would otherwise be interpreted as the complete list of function +arguments. (See examples above under L.) + +Unary "\" creates a reference to whatever follows it. See L. +Do not confuse this behavior with the behavior of backslash within a +string, although both forms do convey the notion of protecting the next +thing from interpretation. + +=head2 Binding Operators + +Binary "=~" binds a scalar expression to a pattern match. Certain operations +search or modify the string $_ by default. This operator makes that kind +of operation work on some other string. The right argument is a search +pattern, substitution, or transliteration. The left argument is what is +supposed to be searched, substituted, or transliterated instead of the default +$_. The return value indicates the success of the operation. (If the +right argument is an expression rather than a search pattern, +substitution, or transliteration, it is interpreted as a search pattern at run +time. This can be is less efficient than an explicit search, because the +pattern must be compiled every time the expression is evaluated. + +Binary "!~" is just like "=~" except the return value is negated in +the logical sense. + +=head2 Multiplicative Operators + +Binary "*" multiplies two numbers. + +Binary "/" divides two numbers. + +Binary "%" computes the modulus of two numbers. Given integer +operands C<$a> and C<$b>: If C<$b> is positive, then C<$a % $b> is +C<$a> minus the largest multiple of C<$b> that is not greater than +C<$a>. If C<$b> is negative, then C<$a % $b> is C<$a> minus the +smallest multiple of C<$b> that is not less than C<$a> (i.e. the +result will be less than or equal to zero). +Note than when C is in scope, "%" give you direct access +to the modulus operator as implemented by your C compiler. This +operator is not as well defined for negative operands, but it will +execute faster. + +Binary "x" is the repetition operator. In scalar context, it +returns a string consisting of the left operand repeated the number of +times specified by the right operand. In list context, if the left +operand is a list in parentheses, it repeats the list. + + print '-' x 80; # print row of dashes + + print "\t" x ($tab/8), ' ' x ($tab%8); # tab over + + @ones = (1) x 80; # a list of 80 1's + @ones = (5) x @ones; # set all elements to 5 + + +=head2 Additive Operators + +Binary "+" returns the sum of two numbers. + +Binary "-" returns the difference of two numbers. + +Binary "." concatenates two strings. + +=head2 Shift Operators + +Binary "<<" returns the value of its left argument shifted left by the +number of bits specified by the right argument. Arguments should be +integers. (See also L.) + +Binary ">>" returns the value of its left argument shifted right by +the number of bits specified by the right argument. Arguments should +be integers. (See also L.) + +=head2 Named Unary Operators + +The various named unary operators are treated as functions with one +argument, with optional parentheses. These include the filetest +operators, like C<-f>, C<-M>, etc. See L. + +If any list operator (print(), etc.) or any unary operator (chdir(), etc.) +is followed by a left parenthesis as the next token, the operator and +arguments within parentheses are taken to be of highest precedence, +just like a normal function call. Examples: + + chdir $foo || die; # (chdir $foo) || die + chdir($foo) || die; # (chdir $foo) || die + chdir ($foo) || die; # (chdir $foo) || die + chdir +($foo) || die; # (chdir $foo) || die + +but, because * is higher precedence than ||: + + chdir $foo * 20; # chdir ($foo * 20) + chdir($foo) * 20; # (chdir $foo) * 20 + chdir ($foo) * 20; # (chdir $foo) * 20 + chdir +($foo) * 20; # chdir ($foo * 20) + + rand 10 * 20; # rand (10 * 20) + rand(10) * 20; # (rand 10) * 20 + rand (10) * 20; # (rand 10) * 20 + rand +(10) * 20; # rand (10 * 20) + +See also L<"Terms and List Operators (Leftward)">. + +=head2 Relational Operators + +Binary "E" returns true if the left argument is numerically less than +the right argument. + +Binary "E" returns true if the left argument is numerically greater +than the right argument. + +Binary "E=" returns true if the left argument is numerically less than +or equal to the right argument. + +Binary "E=" returns true if the left argument is numerically greater +than or equal to the right argument. + +Binary "lt" returns true if the left argument is stringwise less than +the right argument. + +Binary "gt" returns true if the left argument is stringwise greater +than the right argument. + +Binary "le" returns true if the left argument is stringwise less than +or equal to the right argument. + +Binary "ge" returns true if the left argument is stringwise greater +than or equal to the right argument. + +=head2 Equality Operators + +Binary "==" returns true if the left argument is numerically equal to +the right argument. + +Binary "!=" returns true if the left argument is numerically not equal +to the right argument. + +Binary "E=E" returns -1, 0, or 1 depending on whether the left +argument is numerically less than, equal to, or greater than the right +argument. + +Binary "eq" returns true if the left argument is stringwise equal to +the right argument. + +Binary "ne" returns true if the left argument is stringwise not equal +to the right argument. + +Binary "cmp" returns -1, 0, or 1 depending on whether the left argument is stringwise +less than, equal to, or greater than the right argument. + +"lt", "le", "ge", "gt" and "cmp" use the collation (sort) order specified +by the current locale if C is in effect. See L. + +=head2 Bitwise And + +Binary "&" returns its operators ANDed together bit by bit. +(See also L and L.) + +=head2 Bitwise Or and Exclusive Or + +Binary "|" returns its operators ORed together bit by bit. +(See also L and L.) + +Binary "^" returns its operators XORed together bit by bit. +(See also L and L.) + +=head2 C-style Logical And + +Binary "&&" performs a short-circuit logical AND operation. That is, +if the left operand is false, the right operand is not even evaluated. +Scalar or list context propagates down to the right operand if it +is evaluated. + +=head2 C-style Logical Or + +Binary "||" performs a short-circuit logical OR operation. That is, +if the left operand is true, the right operand is not even evaluated. +Scalar or list context propagates down to the right operand if it +is evaluated. + +The C<||> and C<&&> operators differ from C's in that, rather than returning +0 or 1, they return the last value evaluated. Thus, a reasonably portable +way to find out the home directory (assuming it's not "0") might be: + + $home = $ENV{'HOME'} || $ENV{'LOGDIR'} || + (getpwuid($<))[7] || die "You're homeless!\n"; + +In particular, this means that you shouldn't use this +for selecting between two aggregates for assignment: + + @a = @b || @c; # this is wrong + @a = scalar(@b) || @c; # really meant this + @a = @b ? @b : @c; # this works fine, though + +As more readable alternatives to C<&&> and C<||> when used for +control flow, Perl provides C and C operators (see below). +The short-circuit behavior is identical. The precedence of "and" and +"or" is much lower, however, so that you can safely use them after a +list operator without the need for parentheses: + + unlink "alpha", "beta", "gamma" + or gripe(), next LINE; + +With the C-style operators that would have been written like this: + + unlink("alpha", "beta", "gamma") + || (gripe(), next LINE); + +Use "or" for assignment is unlikely to do what you want; see below. + +=head2 Range Operators + +Binary ".." is the range operator, which is really two different +operators depending on the context. In list context, it returns an +array of values counting (by ones) from the left value to the right +value. This is useful for writing C loops and for +doing slice operations on arrays. In the current implementation, no +temporary array is created when the range operator is used as the +expression in C loops, but older versions of Perl might burn +a lot of memory when you write something like this: + + for (1 .. 1_000_000) { + # code + } + +In scalar context, ".." returns a boolean value. The operator is +bistable, like a flip-flop, and emulates the line-range (comma) operator +of B, B, and various editors. Each ".." operator maintains its +own boolean state. It is false as long as its left operand is false. +Once the left operand is true, the range operator stays true until the +right operand is true, I which the range operator becomes false +again. (It doesn't become false till the next time the range operator is +evaluated. It can test the right operand and become false on the same +evaluation it became true (as in B), but it still returns true once. +If you don't want it to test the right operand till the next evaluation +(as in B), use three dots ("...") instead of two.) The right +operand is not evaluated while the operator is in the "false" state, and +the left operand is not evaluated while the operator is in the "true" +state. The precedence is a little lower than || and &&. The value +returned is either the empty string for false, or a sequence number +(beginning with 1) for true. The sequence number is reset for each range +encountered. The final sequence number in a range has the string "E0" +appended to it, which doesn't affect its numeric value, but gives you +something to search for if you want to exclude the endpoint. You can +exclude the beginning point by waiting for the sequence number to be +greater than 1. If either operand of scalar ".." is a constant expression, +that operand is implicitly compared to the C<$.> variable, the current +line number. Examples: + +As a scalar operator: + + if (101 .. 200) { print; } # print 2nd hundred lines + next line if (1 .. /^$/); # skip header lines + s/^/> / if (/^$/ .. eof()); # quote body + + # parse mail messages + while (<>) { + $in_header = 1 .. /^$/; + $in_body = /^$/ .. eof(); + # do something based on those + } continue { + close ARGV if eof; # reset $. each file + } + +As a list operator: + + for (101 .. 200) { print; } # print $_ 100 times + @foo = @foo[0 .. $#foo]; # an expensive no-op + @foo = @foo[$#foo-4 .. $#foo]; # slice last 5 items + +The range operator (in list context) makes use of the magical +auto-increment algorithm if the operands are strings. You +can say + + @alphabet = ('A' .. 'Z'); + +to get all the letters of the alphabet, or + + $hexdigit = (0 .. 9, 'a' .. 'f')[$num & 15]; + +to get a hexadecimal digit, or + + @z2 = ('01' .. '31'); print $z2[$mday]; + +to get dates with leading zeros. If the final value specified is not +in the sequence that the magical increment would produce, the sequence +goes until the next value would be longer than the final value +specified. + +=head2 Conditional Operator + +Ternary "?:" is the conditional operator, just as in C. It works much +like an if-then-else. If the argument before the ? is true, the +argument before the : is returned, otherwise the argument after the : +is returned. For example: + + printf "I have %d dog%s.\n", $n, + ($n == 1) ? '' : "s"; + +Scalar or list context propagates downward into the 2nd +or 3rd argument, whichever is selected. + + $a = $ok ? $b : $c; # get a scalar + @a = $ok ? @b : @c; # get an array + $a = $ok ? @b : @c; # oops, that's just a count! + +The operator may be assigned to if both the 2nd and 3rd arguments are +legal lvalues (meaning that you can assign to them): + + ($a_or_b ? $a : $b) = $c; + +This is not necessarily guaranteed to contribute to the readability of your program. + +Because this operator produces an assignable result, using assignments +without parentheses will get you in trouble. For example, this: + + $a % 2 ? $a += 10 : $a += 2 + +Really means this: + + (($a % 2) ? ($a += 10) : $a) += 2 + +Rather than this: + + ($a % 2) ? ($a += 10) : ($a += 2) + +=head2 Assignment Operators + +"=" is the ordinary assignment operator. + +Assignment operators work as in C. That is, + + $a += 2; + +is equivalent to + + $a = $a + 2; + +although without duplicating any side effects that dereferencing the lvalue +might trigger, such as from tie(). Other assignment operators work similarly. +The following are recognized: + + **= += *= &= <<= &&= + -= /= |= >>= ||= + .= %= ^= + x= + +Note that while these are grouped by family, they all have the precedence +of assignment. + +Unlike in C, the assignment operator produces a valid lvalue. Modifying +an assignment is equivalent to doing the assignment and then modifying +the variable that was assigned to. This is useful for modifying +a copy of something, like this: + + ($tmp = $global) =~ tr [A-Z] [a-z]; + +Likewise, + + ($a += 2) *= 3; + +is equivalent to + + $a += 2; + $a *= 3; + +=head2 Comma Operator + +Binary "," is the comma operator. In scalar context it evaluates +its left argument, throws that value away, then evaluates its right +argument and returns that value. This is just like C's comma operator. + +In list context, it's just the list argument separator, and inserts +both its arguments into the list. + +The =E digraph is mostly just a synonym for the comma operator. It's useful for +documenting arguments that come in pairs. As of release 5.001, it also forces +any word to the left of it to be interpreted as a string. + +=head2 List Operators (Rightward) + +On the right side of a list operator, it has very low precedence, +such that it controls all comma-separated expressions found there. +The only operators with lower precedence are the logical operators +"and", "or", and "not", which may be used to evaluate calls to list +operators without the need for extra parentheses: + + open HANDLE, "filename" + or die "Can't open: $!\n"; + +See also discussion of list operators in L. + +=head2 Logical Not + +Unary "not" returns the logical negation of the expression to its right. +It's the equivalent of "!" except for the very low precedence. + +=head2 Logical And + +Binary "and" returns the logical conjunction of the two surrounding +expressions. It's equivalent to && except for the very low +precedence. This means that it short-circuits: i.e., the right +expression is evaluated only if the left expression is true. + +=head2 Logical or and Exclusive Or + +Binary "or" returns the logical disjunction of the two surrounding +expressions. It's equivalent to || except for the very low precedence. +This makes it useful for control flow + + print FH $data or die "Can't write to FH: $!"; + +This means that it short-circuits: i.e., the right expression is evaluated +only if the left expression is false. Due to its precedence, you should +probably avoid using this for assignment, only for control flow. + + $a = $b or $c; # bug: this is wrong + ($a = $b) or $c; # really means this + $a = $b || $c; # better written this way + +However, when it's a list context assignment and you're trying to use +"||" for control flow, you probably need "or" so that the assignment +takes higher precedence. + + @info = stat($file) || die; # oops, scalar sense of stat! + @info = stat($file) or die; # better, now @info gets its due + +Then again, you could always use parentheses. + +Binary "xor" returns the exclusive-OR of the two surrounding expressions. +It cannot short circuit, of course. + +=head2 C Operators Missing From Perl + +Here is what C has that Perl doesn't: + +=over 8 + +=item unary & + +Address-of operator. (But see the "\" operator for taking a reference.) + +=item unary * + +Dereference-address operator. (Perl's prefix dereferencing +operators are typed: $, @, %, and &.) + +=item (TYPE) + +Type casting operator. + +=back + +=head2 Quote and Quote-like Operators + +While we usually think of quotes as literal values, in Perl they +function as operators, providing various kinds of interpolating and +pattern matching capabilities. Perl provides customary quote characters +for these behaviors, but also provides a way for you to choose your +quote character for any of them. In the following table, a C<{}> represents +any pair of delimiters you choose. Non-bracketing delimiters use +the same character fore and aft, but the 4 sorts of brackets +(round, angle, square, curly) will all nest. + + Customary Generic Meaning Interpolates + '' q{} Literal no + "" qq{} Literal yes + `` qx{} Command yes (unless '' is delimiter) + qw{} Word list no + // m{} Pattern match yes + qr{} Pattern yes + s{}{} Substitution yes + tr{}{} Transliteration no (but see below) + +Note that there can be whitespace between the operator and the quoting +characters, except when C<#> is being used as the quoting character. +C is parsed as being the string C, while C is the +operator C followed by a comment. Its argument will be taken from the +next line. This allows you to write: + + s {foo} # Replace foo + {bar} # with bar. + +For constructs that do interpolation, variables beginning with "C<$>" +or "C<@>" are interpolated, as are the following sequences. Within +a transliteration, the first ten of these sequences may be used. + + \t tab (HT, TAB) + \n newline (NL) + \r return (CR) + \f form feed (FF) + \b backspace (BS) + \a alarm (bell) (BEL) + \e escape (ESC) + \033 octal char + \x1b hex char + \c[ control char + + \l lowercase next char + \u uppercase next char + \L lowercase till \E + \U uppercase till \E + \E end case modification + \Q quote non-word characters till \E + +If C is in effect, the case map used by C<\l>, C<\L>, C<\u> +and C<\U> is taken from the current locale. See L. + +All systems use the virtual C<"\n"> to represent a line terminator, +called a "newline". There is no such thing as an unvarying, physical +newline character. It is an illusion that the operating system, +device drivers, C libraries, and Perl all conspire to preserve. Not all +systems read C<"\r"> as ASCII CR and C<"\n"> as ASCII LF. For example, +on a Mac, these are reversed, and on systems without line terminator, +printing C<"\n"> may emit no actual data. In general, use C<"\n"> when +you mean a "newline" for your system, but use the literal ASCII when you +need an exact character. For example, most networking protocols expect +and prefer a CR+LF (C<"\012\015"> or C<"\cJ\cM">) for line terminators, +and although they often accept just C<"\012">, they seldom tolerate just +C<"\015">. If you get in the habit of using C<"\n"> for networking, +you may be burned some day. + +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be inserted. +You'll need to write something like C. + +Patterns are subject to an additional level of interpretation as a +regular expression. This is done as a second pass, after variables are +interpolated, so that regular expressions may be incorporated into the +pattern from the variables. If this is not what you want, use C<\Q> to +interpolate a variable literally. + +Apart from the above, there are no multiple levels of interpolation. In +particular, contrary to the expectations of shell programmers, back-quotes +do I interpolate within double quotes, nor do single quotes impede +evaluation of variables when used within double quotes. + +=head2 Regexp Quote-Like Operators + +Here are the quote-like operators that apply to pattern +matching and related activities. + +Most of this section is related to use of regular expressions from Perl. +Such a use may be considered from two points of view: Perl handles a +a string and a "pattern" to RE (regular expression) engine to match, +RE engine finds (or does not find) the match, and Perl uses the findings +of RE engine for its operation, possibly asking the engine for other matches. + +RE engine has no idea what Perl is going to do with what it finds, +similarly, the rest of Perl has no idea what a particular regular expression +means to RE engine. This creates a clean separation, and in this section +we discuss matching from Perl point of view only. The other point of +view may be found in L. + +=over 8 + +=item ?PATTERN? + +This is just like the C search, except that it matches only +once between calls to the reset() operator. This is a useful +optimization when you want to see only the first occurrence of +something in each file of a set of files, for instance. Only C +patterns local to the current package are reset. + + while (<>) { + if (?^$?) { + # blank line between header and body + } + } continue { + reset if eof; # clear ?? status for next file + } + +This usage is vaguely deprecated, and may be removed in some future +version of Perl. + +=item m/PATTERN/cgimosx + +=item /PATTERN/cgimosx + +Searches a string for a pattern match, and in scalar context returns +true (1) or false (''). If no string is specified via the C<=~> or +C operator, the $_ string is searched. (The string specified with +C<=~> need not be an lvalue--it may be the result of an expression +evaluation, but remember the C<=~> binds rather tightly.) See also +L. +See L for discussion of additional considerations that apply +when C is in effect. + +Options are: + + c Do not reset search position on a failed match when /g is in effect. + g Match globally, i.e., find all occurrences. + i Do case-insensitive pattern matching. + m Treat string as multiple lines. + o Compile pattern only once. + s Treat string as single line. + x Use extended regular expressions. + +If "/" is the delimiter then the initial C is optional. With the C +you can use any pair of non-alphanumeric, non-whitespace characters +as delimiters (if single quotes are used, no interpretation is done +on the replacement string. Unlike Perl 4, Perl 5 treats backticks as normal +delimiters; the replacement text is not evaluated as a command). +This is particularly useful for matching Unix path names +that contain "/", to avoid LTS (leaning toothpick syndrome). If "?" is +the delimiter, then the match-only-once rule of C applies. + +PATTERN may contain variables, which will be interpolated (and the +pattern recompiled) every time the pattern search is evaluated. (Note +that C<$)> and C<$|> might not be interpolated because they look like +end-of-string tests.) If you want such a pattern to be compiled only +once, add a C after the trailing delimiter. This avoids expensive +run-time recompilations, and is useful when the value you are +interpolating won't change over the life of the script. However, mentioning +C constitutes a promise that you won't change the variables in the pattern. +If you change them, Perl won't even notice. + +If the PATTERN evaluates to the empty string, the last +I matched regular expression is used instead. + +If the C option is not used, C in a list context returns a +list consisting of the subexpressions matched by the parentheses in the +pattern, i.e., (C<$1>, C<$2>, C<$3>...). (Note that here C<$1> etc. are +also set, and that this differs from Perl 4's behavior.) When there are +no parentheses in the pattern, the return value is the list C<(1)> for +success. With or without parentheses, an empty list is returned upon +failure. + +Examples: + + open(TTY, '/dev/tty'); + =~ /^y/i && foo(); # do foo if desired + + if (/Version: *([0-9.]*)/) { $version = $1; } + + next if m#^/usr/spool/uucp#; + + # poor man's grep + $arg = shift; + while (<>) { + print if /$arg/o; # compile only once + } + + if (($F1, $F2, $Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)) + +This last example splits $foo into the first two words and the +remainder of the line, and assigns those three fields to $F1, $F2, and +$Etc. The conditional is true if any variables were assigned, i.e., if +the pattern matched. + +The C modifier specifies global pattern matching--that is, matching +as many times as possible within the string. How it behaves depends on +the context. In list context, it returns a list of all the +substrings matched by all the parentheses in the regular expression. +If there are no parentheses, it returns a list of all the matched +strings, as if there were parentheses around the whole pattern. + +In scalar context, each execution of C finds the next match, +returning TRUE if it matches, and FALSE if there is no further match. +The position after the last match can be read or set using the pos() +function; see L. A failed match normally resets the +search position to the beginning of the string, but you can avoid that +by adding the C modifier (e.g. C). Modifying the target +string also resets the search position. + +You can intermix C matches with C, where C<\G> is a +zero-width assertion that matches the exact position where the previous +C, if any, left off. The C<\G> assertion is not supported without +the C modifier; currently, without C, C<\G> behaves just like +C<\A>, but that's accidental and may change in the future. + +Examples: + + # list context + ($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g); + + # scalar context + $/ = ""; $* = 1; # $* deprecated in modern perls + while (defined($paragraph = <>)) { + while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) { + $sentences++; + } + } + print "$sentences\n"; + + # using m//gc with \G + $_ = "ppooqppqq"; + while ($i++ < 2) { + print "1: '"; + print $1 while /(o)/gc; print "', pos=", pos, "\n"; + print "2: '"; + print $1 if /\G(q)/gc; print "', pos=", pos, "\n"; + print "3: '"; + print $1 while /(p)/gc; print "', pos=", pos, "\n"; + } + +The last example should print: + + 1: 'oo', pos=4 + 2: 'q', pos=5 + 3: 'pp', pos=7 + 1: '', pos=7 + 2: 'q', pos=8 + 3: '', pos=8 + +A useful idiom for C-like scanners is C. You can +combine several regexps like this to process a string part-by-part, +doing different actions depending on which regexp matched. Each +regexp tries to match where the previous one leaves off. + + $_ = <<'EOL'; + $url = new URI::URL "http://www/"; die if $url eq "xXx"; + EOL + LOOP: + { + print(" digits"), redo LOOP if /\G\d+\b[,.;]?\s*/gc; + print(" lowercase"), redo LOOP if /\G[a-z]+\b[,.;]?\s*/gc; + print(" UPPERCASE"), redo LOOP if /\G[A-Z]+\b[,.;]?\s*/gc; + print(" Capitalized"), redo LOOP if /\G[A-Z][a-z]+\b[,.;]?\s*/gc; + print(" MiXeD"), redo LOOP if /\G[A-Za-z]+\b[,.;]?\s*/gc; + print(" alphanumeric"), redo LOOP if /\G[A-Za-z0-9]+\b[,.;]?\s*/gc; + print(" line-noise"), redo LOOP if /\G[^A-Za-z0-9]+/gc; + print ". That's all!\n"; + } + +Here is the output (split into several lines): + + line-noise lowercase line-noise lowercase UPPERCASE line-noise + UPPERCASE line-noise lowercase line-noise lowercase line-noise + lowercase lowercase line-noise lowercase lowercase line-noise + MiXeD line-noise. That's all! + +=item q/STRING/ + +=item C<'STRING'> + +A single-quoted, literal string. A backslash represents a backslash +unless followed by the delimiter or another backslash, in which case +the delimiter or backslash is interpolated. + + $foo = q!I said, "You said, 'She said it.'"!; + $bar = q('This is it.'); + $baz = '\n'; # a two-character string + +=item qq/STRING/ + +=item "STRING" + +A double-quoted, interpolated string. + + $_ .= qq + (*** The previous line contains the naughty word "$1".\n) + if /(tcl|rexx|python)/; # :-) + $baz = "\n"; # a one-character string + +=item qr/STRING/imosx + +A string which is (possibly) interpolated and then compiled as a +regular expression. The result may be used as a pattern in a match + + $re = qr/$pattern/; + $string =~ /foo${re}bar/; # can be interpolated in other patterns + $string =~ $re; # or used standalone + +Options are: + + i Do case-insensitive pattern matching. + m Treat string as multiple lines. + o Compile pattern only once. + s Treat string as single line. + x Use extended regular expressions. + +The benefit from this is that the pattern is precompiled into an internal +representation, and does not need to be recompiled every time a match +is attempted. This makes it very efficient to do something like: + + foreach $pattern (@pattern_list) { + my $re = qr/$pattern/; + foreach $line (@lines) { + if($line =~ /$re/) { + do_something($line); + } + } + } + +See L for additional information on valid syntax for STRING, and +for a detailed look at the semantics of regular expressions. + +=item qx/STRING/ + +=item `STRING` + +A string which is (possibly) interpolated and then executed as a system +command with C or its equivalent. Shell wildcards, pipes, +and redirections will be honored. The collected standard output of the +command is returned; standard error is unaffected. In scalar context, +it comes back as a single (potentially multi-line) string. In list +context, returns a list of lines (however you've defined lines with $/ +or $INPUT_RECORD_SEPARATOR). + +Because backticks do not affect standard error, use shell file descriptor +syntax (assuming the shell supports this) if you care to address this. +To capture a command's STDERR and STDOUT together: + + $output = `cmd 2>&1`; + +To capture a command's STDOUT but discard its STDERR: + + $output = `cmd 2>/dev/null`; + +To capture a command's STDERR but discard its STDOUT (ordering is +important here): + + $output = `cmd 2>&1 1>/dev/null`; + +To exchange a command's STDOUT and STDERR in order to capture the STDERR +but leave its STDOUT to come out the old STDERR: + + $output = `cmd 3>&1 1>&2 2>&3 3>&-`; + +To read both a command's STDOUT and its STDERR separately, it's easiest +and safest to redirect them separately to files, and then read from those +files when the program is done: + + system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr"); + +Using single-quote as a delimiter protects the command from Perl's +double-quote interpolation, passing it on to the shell instead: + + $perl_info = qx(ps $$); # that's Perl's $$ + $shell_info = qx'ps $$'; # that's the new shell's $$ + +Note that how the string gets evaluated is entirely subject to the command +interpreter on your system. On most platforms, you will have to protect +shell metacharacters if you want them treated literally. This is in +practice difficult to do, as it's unclear how to escape which characters. +See L for a clean and safe example of a manual fork() and exec() +to emulate backticks safely. + +On some platforms (notably DOS-like ones), the shell may not be +capable of dealing with multiline commands, so putting newlines in +the string may not get you what you want. You may be able to evaluate +multiple commands in a single line by separating them with the command +separator character, if your shell supports that (e.g. C<;> on many Unix +shells; C<&> on the Windows NT C shell). + +Beware that some command shells may place restrictions on the length +of the command line. You must ensure your strings don't exceed this +limit after any necessary interpolations. See the platform-specific +release notes for more details about your particular environment. + +Using this operator can lead to programs that are difficult to port, +because the shell commands called vary between systems, and may in +fact not be present at all. As one example, the C command under +the POSIX shell is very different from the C command under DOS. +That doesn't mean you should go out of your way to avoid backticks +when they're the right way to get something done. Perl was made to be +a glue language, and one of the things it glues together is commands. +Just understand what you're getting yourself into. + +See L<"I/O Operators"> for more discussion. + +=item qw/STRING/ + +Returns a list of the words extracted out of STRING, using embedded +whitespace as the word delimiters. It is exactly equivalent to + + split(' ', q/STRING/); + +This equivalency means that if used in scalar context, you'll get split's +(unfortunate) scalar context behavior, complete with mysterious warnings. + +Some frequently seen examples: + + use POSIX qw( setlocale localeconv ) + @EXPORT = qw( foo bar baz ); + +A common mistake is to try to separate the words with comma or to put +comments into a multi-line C-string. For this reason the C<-w> +switch produce warnings if the STRING contains the "," or the "#" +character. + +=item s/PATTERN/REPLACEMENT/egimosx + +Searches a string for a pattern, and if found, replaces that pattern +with the replacement text and returns the number of substitutions +made. Otherwise it returns false (specifically, the empty string). + +If no string is specified via the C<=~> or C operator, the C<$_> +variable is searched and modified. (The string specified with C<=~> must +be scalar variable, an array element, a hash element, or an assignment +to one of those, i.e., an lvalue.) + +If the delimiter chosen is single quote, no variable interpolation is +done on either the PATTERN or the REPLACEMENT. Otherwise, if the +PATTERN contains a $ that looks like a variable rather than an +end-of-string test, the variable will be interpolated into the pattern +at run-time. If you want the pattern compiled only once the first time +the variable is interpolated, use the C option. If the pattern +evaluates to the empty string, the last successfully executed regular +expression is used instead. See L for further explanation on these. +See L for discussion of additional considerations that apply +when C is in effect. + +Options are: + + e Evaluate the right side as an expression. + g Replace globally, i.e., all occurrences. + i Do case-insensitive pattern matching. + m Treat string as multiple lines. + o Compile pattern only once. + s Treat string as single line. + x Use extended regular expressions. + +Any non-alphanumeric, non-whitespace delimiter may replace the +slashes. If single quotes are used, no interpretation is done on the +replacement string (the C modifier overrides this, however). Unlike +Perl 4, Perl 5 treats backticks as normal delimiters; the replacement +text is not evaluated as a command. If the +PATTERN is delimited by bracketing quotes, the REPLACEMENT has its own +pair of quotes, which may or may not be bracketing quotes, e.g., +C or CfooE/bar/>. A C will cause the +replacement portion to be interpreted as a full-fledged Perl expression +and eval()ed right then and there. It is, however, syntax checked at +compile-time. + +Examples: + + s/\bgreen\b/mauve/g; # don't change wintergreen + + $path =~ s|/usr/bin|/usr/local/bin|; + + s/Login: $foo/Login: $bar/; # run-time pattern + + ($foo = $bar) =~ s/this/that/; # copy first, then change + + $count = ($paragraph =~ s/Mister\b/Mr./g); # get change-count + + $_ = 'abc123xyz'; + s/\d+/$&*2/e; # yields 'abc246xyz' + s/\d+/sprintf("%5d",$&)/e; # yields 'abc 246xyz' + s/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz' + + s/%(.)/$percent{$1}/g; # change percent escapes; no /e + s/%(.)/$percent{$1} || $&/ge; # expr now, so /e + s/^=(\w+)/&pod($1)/ge; # use function call + + # expand variables in $_, but dynamics only, using + # symbolic dereferencing + s/\$(\w+)/${$1}/g; + + # /e's can even nest; this will expand + # any embedded scalar variable (including lexicals) in $_ + s/(\$\w+)/$1/eeg; + + # Delete (most) C comments. + $program =~ s { + /\* # Match the opening delimiter. + .*? # Match a minimal number of characters. + \*/ # Match the closing delimiter. + } []gsx; + + s/^\s*(.*?)\s*$/$1/; # trim white space in $_, expensively + + for ($variable) { # trim white space in $variable, cheap + s/^\s+//; + s/\s+$//; + } + + s/([^ ]*) *([^ ]*)/$2 $1/; # reverse 1st two fields + +Note the use of $ instead of \ in the last example. Unlike +B, we use the \EIE form in only the left hand side. +Anywhere else it's $EIE. + +Occasionally, you can't use just a C to get all the changes +to occur. Here are two common cases: + + # put commas in the right places in an integer + 1 while s/(.*\d)(\d\d\d)/$1,$2/g; # perl4 + 1 while s/(\d)(\d\d\d)(?!\d)/$1,$2/g; # perl5 + + # expand tabs to 8-column spacing + 1 while s/\t+/' ' x (length($&)*8 - length($`)%8)/e; + + +=item tr/SEARCHLIST/REPLACEMENTLIST/cds + +=item y/SEARCHLIST/REPLACEMENTLIST/cds + +Transliterates all occurrences of the characters found in the search list +with the corresponding character in the replacement list. It returns +the number of characters replaced or deleted. If no string is +specified via the =~ or !~ operator, the $_ string is transliterated. (The +string specified with =~ must be a scalar variable, an array element, a +hash element, or an assignment to one of those, i.e., an lvalue.) +A character range may be specified with a hyphen, so C
     +does the same replacement as C. +For B devotees, C is provided as a synonym for C. If the +SEARCHLIST is delimited by bracketing quotes, the REPLACEMENTLIST has +its own pair of quotes, which may or may not be bracketing quotes, +e.g., C or C. + +Options: + + c Complement the SEARCHLIST. + d Delete found but unreplaced characters. + s Squash duplicate replaced characters. + +If the C modifier is specified, the SEARCHLIST character set is +complemented. If the C modifier is specified, any characters specified +by SEARCHLIST not found in REPLACEMENTLIST are deleted. (Note +that this is slightly more flexible than the behavior of some B +programs, which delete anything they find in the SEARCHLIST, period.) +If the C modifier is specified, sequences of characters that were +transliterated to the same character are squashed down to a single instance of the +character. + +If the C modifier is used, the REPLACEMENTLIST is always interpreted +exactly as specified. Otherwise, if the REPLACEMENTLIST is shorter +than the SEARCHLIST, the final character is replicated till it is long +enough. If the REPLACEMENTLIST is empty, the SEARCHLIST is replicated. +This latter is useful for counting characters in a class or for +squashing character sequences in a class. + +Examples: + + $ARGV[1] =~ tr/A-Z/a-z/; # canonicalize to lower case + + $cnt = tr/*/*/; # count the stars in $_ + + $cnt = $sky =~ tr/*/*/; # count the stars in $sky + + $cnt = tr/0-9//; # count the digits in $_ + + tr/a-zA-Z//s; # bookkeeper -> bokeper + + ($HOST = $host) =~ tr/a-z/A-Z/; + + tr/a-zA-Z/ /cs; # change non-alphas to single space + + tr [\200-\377] + [\000-\177]; # delete 8th bit + +If multiple transliterations are given for a character, only the first one is used: + + tr/AAA/XYZ/ + +will transliterate any A to X. + +Note that because the transliteration table is built at compile time, neither +the SEARCHLIST nor the REPLACEMENTLIST are subjected to double quote +interpolation. That means that if you want to use variables, you must use +an eval(): + + eval "tr/$oldlist/$newlist/"; + die $@ if $@; + + eval "tr/$oldlist/$newlist/, 1" or die $@; + +=back + +=head2 Gory details of parsing quoted constructs + +When presented with something which may have several different +interpretations, Perl uses the principle B (expanded to Do What I Mean +- not what I wrote) to pick up the most probable interpretation of the +source. This strategy is so successful that Perl users usually do not +suspect ambivalence of what they write. However, time to time Perl's ideas +differ from what the author meant. + +The target of this section is to clarify the Perl's way of interpreting +quoted constructs. The most frequent reason one may have to want to know the +details discussed in this section is hairy regular expressions. However, the +first steps of parsing are the same for all Perl quoting operators, so here +they are discussed together. + +Some of the passes discussed below are performed concurrently, but as +far as results are the same, we consider them one-by-one. For different +quoting constructs Perl performs different number of passes, from +one to five, but they are always performed in the same order. + +=over + +=item Finding the end + +First pass is finding the end of the quoted construct, be it multichar ender +C<"\nEOF\n"> of C<< construct, C which terminates C construct, +C<]> which terminates C construct, or C> which terminates a +fileglob started with C<<>. + +When searching for multichar construct no skipping is performed. When +searching for one-char non-matching delimiter, such as C, combinations +C<\\> and C<\/> are skipped. When searching for one-char matching delimiter, +such as C<]>, combinations C<\\>, C<\]> and C<\[> are skipped, and +nested C<[>, C<]> are skipped as well. + +For 3-parts constructs, C etc. the search is repeated once more. + +During this search no attention is paid to the semantic of the construct, thus + + "$hash{"$foo/$bar"}" + +or + + m/ + bar # This is not a comment, this slash / terminated m//! + /x + +do not form legal quoted expressions. Note that since the slash which +terminated C was followed by a C, this is not C, +thus C<#> was interpreted as a literal C<#>. + +=item Removal of backslashes before delimiters + +During the second pass the text between the starting delimiter and +the ending delimiter is copied to a safe location, and the C<\> is +removed from combinations consisting of C<\> and delimiter(s) (both starting +and ending delimiter if they differ). + +The removal does not happen for multi-char delimiters. + +Note that the combination C<\\> is left as it was! + +Starting from this step no information about the delimiter(s) is used in the +parsing. + +=item Interpolation + +Next step is interpolation in the obtained delimiter-independent text. +There are four different cases. + +=over + +=item C<<<'EOF'>, C, C, C, C + +No interpolation is performed. + +=item C<''>, C + +The only interpolation is removal of C<\> from pairs C<\\>. + +=item C<"">, C<``>, C, C, C<> + +C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> (possibly paired with C<\E>) are converted +to corresponding Perl constructs, thus C<"$foo\Qbaz$bar"> is converted to + + $foo . (quotemeta("baz" . $bar)); + +Other combinations of C<\> with following chars are substituted with +appropriate expansions. + +Interpolated scalars and arrays are converted to C and C<.> Perl +constructs, thus C<"'@arr'"> becomes + + "'" . (join $", @arr) . "'"; + +Since all three above steps are performed simultaneously left-to-right, +the is no way to insert a literal C<$> or C<@> inside C<\Q\E> pair: it +cannot be protected by C<\>, since any C<\> (except in C<\E>) is +interpreted as a literal inside C<\Q\E>, and any C<$> is +interpreted as starting an interpolated scalar. + +Note also that the interpolating code needs to make decision where the +interpolated scalar ends, say, whether C<"a $b -E {c}"> means + + "a " . $b . " -> {c}"; + +or + + "a " . $b -> {c}; + +Most the time the decision is to take the longest possible text which does +not include spaces between components and contains matching braces/brackets. + +=item C, C, C, C, + +Processing of C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> and interpolation happens +(almost) as with C constructs, but I followed by +other chars is not performed>! Moreover, inside C<(?{BLOCK})> no processing +is performed at all. + +Interpolation has several quirks: C<$|>, C<$(> and C<$)> are not interpolated, and +constructs C<$var[SOMETHING]> are I (by several different estimators) +to be an array element or C<$var> followed by a RE alternative. This is +the place where the notation C<${arr[$bar]}> comes handy: C +is interpreted as an array element C<-9>, not as a regular expression from +variable C<$arr> followed by a digit, which is the interpretation of +C. + +Note that absence of processing of C<\\> creates specific restrictions on the +post-processed text: if the delimiter is C, one cannot get the combination +C<\/> into the result of this step: C will finish the regular expression, +C<\/> will be stripped to C on the previous step, and C<\\/> will be left +as is. Since C is equivalent to C<\/> inside a regular expression, this +does not matter unless the delimiter is special character for the RE engine, as +in C, C, or C. + +=back + +This step is the last one for all the constructs except regular expressions, +which are processed further. + +=item Interpolation of regular expressions + +All the previous steps were performed during the compilation of Perl code, +this one happens in run time (though it may be optimized to be calculated +at compile time if appropriate). After all the preprocessing performed +above (and possibly after evaluation if catenation, joining, up/down-casing +and Cing are involved) the resulting I is passed to RE +engine for compilation. + +Whatever happens in the RE engine is better be discussed in L, +but for the sake of continuity let us do it here. + +This is the first step where presence of the C switch is relevant. +The RE engine scans the string left-to-right, and converts it to a finite +automaton. + +Backslashed chars are either substituted by corresponding literal +strings, or generate special nodes of the finite automaton. Characters +which are special to the RE engine generate corresponding nodes. C<(?#...)> +comments are ignored. All the rest is either converted to literal strings +to match, or is ignored (as is whitespace and C<#>-style comments if +C is present). + +Note that the parsing of the construct C<[...]> is performed using +absolutely different rules than the rest of the regular expression. +Similarly, the C<(?{...})> is only checked for matching braces. + +=item Optimization of regular expressions + +This step is listed for completeness only. Since it does not change +semantics, details of this step are not documented and are subject +to change. + +=back + +=head2 I/O Operators + +There are several I/O operators you should know about. +A string enclosed by backticks (grave accents) first undergoes +variable substitution just like a double quoted string. It is then +interpreted as a command, and the output of that command is the value +of the pseudo-literal, like in a shell. In scalar context, a single +string consisting of all the output is returned. In list context, +a list of values is returned, one for each line of output. (You can +set C<$/> to use a different line terminator.) The command is executed +each time the pseudo-literal is evaluated. The status value of the +command is returned in C<$?> (see L for the interpretation +of C<$?>). Unlike in B, no translation is done on the return +data--newlines remain newlines. Unlike in any of the shells, single +quotes do not hide variable names in the command from interpretation. +To pass a $ through to the shell you need to hide it with a backslash. +The generalized form of backticks is C. (Because backticks +always undergo shell expansion as well, see L for +security concerns.) + +Evaluating a filehandle in angle brackets yields the next line from +that file (newline, if any, included), or C at end of file. +Ordinarily you must assign that value to a variable, but there is one +situation where an automatic assignment happens. I the +input symbol is the only thing inside the conditional of a C or +C loop, the value is automatically assigned to the variable +C<$_>. In these loop constructs, the assigned value (whether assignment +is automatic or explicit) is then tested to see if it is defined. +The defined test avoids problems where line has a string value +that would be treated as false by perl e.g. "" or "0" with no trailing +newline. (This may seem like an odd thing to you, but you'll use the +construct in almost every Perl script you write.) Anyway, the following +lines are equivalent to each other: + + while (defined($_ = )) { print; } + while ($_ = ) { print; } + while () { print; } + for (;;) { print; } + print while defined($_ = ); + print while ($_ = ); + print while ; + +and this also behaves similarly, but avoids the use of $_ : + + while (my $line = ) { print $line } + +If you really mean such values to terminate the loop they should be +tested for explicitly: + + while (($_ = ) ne '0') { ... } + while () { last unless $_; ... } + +In other boolean contexts, CIE> without explicit C +test or comparison will solicit a warning if C<-w> is in effect. + +The filehandles STDIN, STDOUT, and STDERR are predefined. (The +filehandles C, C, and C will also work except in +packages, where they would be interpreted as local identifiers rather +than global.) Additional filehandles may be created with the open() +function. See L for details on this. + +If a EFILEHANDLEE is used in a context that is looking for a list, a +list consisting of all the input lines is returned, one line per list +element. It's easy to make a I data space this way, so use with +care. + +The null filehandle EE is special and can be used to emulate the +behavior of B and B. Input from EE comes either from +standard input, or from each file listed on the command line. Here's +how it works: the first time EE is evaluated, the @ARGV array is +checked, and if it is empty, C<$ARGV[0]> is set to "-", which when opened +gives you standard input. The @ARGV array is then processed as a list +of filenames. The loop + + while (<>) { + ... # code for each line + } + +is equivalent to the following Perl-like pseudo code: + + unshift(@ARGV, '-') unless @ARGV; + while ($ARGV = shift) { + open(ARGV, $ARGV); + while () { + ... # code for each line + } + } + +except that it isn't so cumbersome to say, and will actually work. It +really does shift array @ARGV and put the current filename into variable +$ARGV. It also uses filehandle I internally--EE is just a +synonym for EARGVE, which is magical. (The pseudo code above +doesn't work because it treats EARGVE as non-magical.) + +You can modify @ARGV before the first EE as long as the array ends up +containing the list of filenames you really want. Line numbers (C<$.>) +continue as if the input were one big happy file. (But see example +under C for how to reset line numbers on each file.) + +If you want to set @ARGV to your own list of files, go right ahead. +This sets @ARGV to all plain text files if no @ARGV was given: + + @ARGV = grep { -f && -T } glob('*') unless @ARGV; + +You can even set them to pipe commands. For example, this automatically +filters compressed arguments through B: + + @ARGV = map { /\.(gz|Z)$/ ? "gzip -dc < $_ |" : $_ } @ARGV; + +If you want to pass switches into your script, you can use one of the +Getopts modules or put a loop on the front like this: + + while ($_ = $ARGV[0], /^-/) { + shift; + last if /^--$/; + if (/^-D(.*)/) { $debug = $1 } + if (/^-v/) { $verbose++ } + # ... # other switches + } + + while (<>) { + # ... # code for each line + } + +The EE symbol will return C for end-of-file only once. +If you call it again after this it will assume you are processing another +@ARGV list, and if you haven't set @ARGV, will input from STDIN. + +If the string inside the angle brackets is a reference to a scalar +variable (e.g., E$fooE), then that variable contains the name of the +filehandle to input from, or its typeglob, or a reference to the same. For example: + + $fh = \*STDIN; + $line = <$fh>; + +If what's within the angle brackets is neither a filehandle nor a simple +scalar variable containing a filehandle name, typeglob, or typeglob +reference, it is interpreted as a filename pattern to be globbed, and +either a list of filenames or the next filename in the list is returned, +depending on context. This distinction is determined on syntactic +grounds alone. That means C$xE> is always a readline from +an indirect handle, but C$hash{key}E> is always a glob. +That's because $x is a simple scalar variable, but C<$hash{key}> is +not--it's a hash element. + +One level of double-quote interpretation is done first, but you can't +say C$fooE> because that's an indirect filehandle as explained +in the previous paragraph. (In older versions of Perl, programmers +would insert curly brackets to force interpretation as a filename glob: +C${foo}E>. These days, it's considered cleaner to call the +internal function directly as C, which is probably the right +way to have done it in the first place.) Example: + + while (<*.c>) { + chmod 0644, $_; + } + +is equivalent to + + open(FOO, "echo *.c | tr -s ' \t\r\f' '\\012\\012\\012\\012'|"); + while () { + chop; + chmod 0644, $_; + } + +In fact, it's currently implemented that way. (Which means it will not +work on filenames with spaces in them unless you have csh(1) on your +machine.) Of course, the shortest way to do the above is: + + chmod 0644, <*.c>; + +Because globbing invokes a shell, it's often faster to call readdir() yourself +and do your own grep() on the filenames. Furthermore, due to its current +implementation of using a shell, the glob() routine may get "Arg list too +long" errors (unless you've installed tcsh(1L) as F). + +A glob evaluates its (embedded) argument only when it is starting a new +list. All values must be read before it will start over. In a list +context this isn't important, because you automatically get them all +anyway. In scalar context, however, the operator returns the next value +each time it is called, or a C value if you've just run out. As +for filehandles an automatic C is generated when the glob +occurs in the test part of a C or C - because legal glob returns +(e.g. a file called F<0>) would otherwise terminate the loop. +Again, C is returned only once. So if you're expecting a single value +from a glob, it is much better to say + + ($file) = ; + +than + + $file = ; + +because the latter will alternate between returning a filename and +returning FALSE. + +It you're trying to do variable interpolation, it's definitely better +to use the glob() function, because the older notation can cause people +to become confused with the indirect filehandle notation. + + @files = glob("$dir/*.[ch]"); + @files = glob($files[$i]); + +=head2 Constant Folding + +Like C, Perl does a certain amount of expression evaluation at +compile time, whenever it determines that all arguments to an +operator are static and have no side effects. In particular, string +concatenation happens at compile time between literals that don't do +variable substitution. Backslash interpretation also happens at +compile time. You can say + + 'Now is the time for all' . "\n" . + 'good men to come to.' + +and this all reduces to one string internally. Likewise, if +you say + + foreach $file (@filenames) { + if (-s $file > 5 + 100 * 2**16) { } + } + +the compiler will precompute the number that +expression represents so that the interpreter +won't have to. + +=head2 Bitwise String Operators + +Bitstrings of any size may be manipulated by the bitwise operators +(C<~ | & ^>). + +If the operands to a binary bitwise op are strings of different sizes, +B and B ops will act as if the shorter operand had additional +zero bits on the right, while the B op will act as if the longer +operand were truncated to the length of the shorter. + + # ASCII-based examples + print "j p \n" ^ " a h"; # prints "JAPH\n" + print "JA" | " ph\n"; # prints "japh\n" + print "japh\nJunk" & '_____'; # prints "JAPH\n"; + print 'p N$' ^ " E bitwise operation. You may explicitly show which type of +operation you intend by using C<""> or C<0+>, as in the examples below. + + $foo = 150 | 105 ; # yields 255 (0x96 | 0x69 is 0xFF) + $foo = '150' | 105 ; # yields 255 + $foo = 150 | '105'; # yields 255 + $foo = '150' | '105'; # yields string '155' (under ASCII) + + $baz = 0+$foo & 0+$bar; # both ops explicitly numeric + $biz = "$foo" ^ "$bar"; # both ops explicitly stringy + +=head2 Integer Arithmetic + +By default Perl assumes that it must do most of its arithmetic in +floating point. But by saying + + use integer; + +you may tell the compiler that it's okay to use integer operations +from here to the end of the enclosing BLOCK. An inner BLOCK may +countermand this by saying + + no integer; + +which lasts until the end of that BLOCK. + +The bitwise operators ("&", "|", "^", "~", "<<", and ">>") always +produce integral results. (But see also L.) +However, C still has meaning +for them. By default, their results are interpreted as unsigned +integers. However, if C is in effect, their results are +interpreted as signed integers. For example, C<~0> usually evaluates +to a large integral value. However, C is -1 on twos-complement machines. + +=head2 Floating-point Arithmetic + +While C provides integer-only arithmetic, there is no +similar ways to provide rounding or truncation at a certain number of +decimal places. For rounding to a certain number of digits, sprintf() +or printf() is usually the easiest route. + +Floating-point numbers are only approximations to what a mathematician +would call real numbers. There are infinitely more reals than floats, +so some corners must be cut. For example: + + printf "%.20g\n", 123456789123456789; + # produces 123456789123456784 + +Testing for exact equality of floating-point equality or inequality is +not a good idea. Here's a (relatively expensive) work-around to compare +whether two floating-point numbers are equal to a particular number of +decimal places. See Knuth, volume II, for a more robust treatment of +this topic. + + sub fp_equal { + my ($X, $Y, $POINTS) = @_; + my ($tX, $tY); + $tX = sprintf("%.${POINTS}g", $X); + $tY = sprintf("%.${POINTS}g", $Y); + return $tX eq $tY; + } + +The POSIX module (part of the standard perl distribution) implements +ceil(), floor(), and a number of other mathematical and trigonometric +functions. The Math::Complex module (part of the standard perl +distribution) defines a number of mathematical functions that can also +work on real numbers. Math::Complex not as efficient as POSIX, but +POSIX can't work with complex numbers. + +Rounding in financial applications can have serious implications, and +the rounding method used should be specified precisely. In these +cases, it probably pays not to trust whichever system rounding is +being used by Perl, but to instead implement the rounding function you +need yourself. + +=head2 Bigger Numbers + +The standard Math::BigInt and Math::BigFloat modules provide +variable precision arithmetic and overloaded operators. +At the cost of some space and considerable speed, they +avoid the normal pitfalls associated with limited-precision +representations. + + use Math::BigInt; + $x = Math::BigInt->new('123456789123456789'); + print $x * $x; + + # prints +15241578780673678515622620750190521 diff --git a/contrib/perl5/pod/perlpod.pod b/contrib/perl5/pod/perlpod.pod new file mode 100644 index 00000000000..d20d62d06ae --- /dev/null +++ b/contrib/perl5/pod/perlpod.pod @@ -0,0 +1,286 @@ +=head1 NAME + +perlpod - plain old documentation + +=head1 DESCRIPTION + +A pod-to-whatever translator reads a pod file paragraph by paragraph, +and translates it to the appropriate output format. There are +three kinds of paragraphs: +L, +L, and +L. + + +=head2 Verbatim Paragraph + +A verbatim paragraph, distinguished by being indented (that is, +it starts with space or tab). It should be reproduced exactly, +with tabs assumed to be on 8-column boundaries. There are no +special formatting escapes, so you can't italicize or anything +like that. A \ means \, and nothing else. + + +=head2 Command Paragraph + +All command paragraphs start with "=", followed by an +identifier, followed by arbitrary text that the command can +use however it pleases. Currently recognized commands are + + =head1 heading + =head2 heading + =item text + =over N + =back + =cut + =pod + =for X + =begin X + =end X + +=over 4 + +=item =pod + +=item =cut + +The "=pod" directive does nothing beyond telling the compiler to lay +off parsing code through the next "=cut". It's useful for adding +another paragraph to the doc if you're mixing up code and pod a lot. + +=item =head1 + +=item =head2 + +Head1 and head2 produce first and second level headings, with the text in +the same paragraph as the "=headn" directive forming the heading description. + +=item =over + +=item =back + +=item =item + +Item, over, and back require a little more explanation: "=over" starts a +section specifically for the generation of a list using "=item" commands. At +the end of your list, use "=back" to end it. You will probably want to give +"4" as the number to "=over", as some formatters will use this for indentation. +This should probably be a default. Note also that there are some basic rules +to using =item: don't use them outside of an =over/=back block, use at least +one inside an =over/=back block, you don't _have_ to include the =back if +the list just runs off the document, and perhaps most importantly, keep the +items consistent: either use "=item *" for all of them, to produce bullets, +or use "=item 1.", "=item 2.", etc., to produce numbered lists, or use +"=item foo", "=item bar", etc., i.e., things that looks nothing like bullets +or numbers. If you start with bullets or numbers, stick with them, as many +formatters use the first "=item" type to decide how to format the list. + + +=item =for + +=item =begin + +=item =end + +For, begin, and end let you include sections that are not interpreted +as pod text, but passed directly to particular formatters. A formatter +that can utilize that format will use the section, otherwise it will be +completely ignored. The directive "=for" specifies that the entire next +paragraph is in the format indicated by the first word after +"=for", like this: + + =for html
    +

    This is a raw HTML paragraph

    + +The paired commands "=begin" and "=end" work very similarly to "=for", but +instead of only accepting a single paragraph, all text from "=begin" to a +paragraph with a matching "=end" are treated as a particular format. + +Here are some examples of how to use these: + + =begin html + +
    Figure 1.
    + + =end html + + =begin text + + --------------- + | foo | + | bar | + --------------- + + ^^^^ Figure 1. ^^^^ + + =end text + +Some format names that formatters currently are known to accept include +"roff", "man", "latex", "tex", "text", and "html". (Some formatters will +treat some of these as synonyms.) + +And don't forget, when using any command, that the command lasts up until +the end of the B, not the line. Hence in the examples below, you +can see the empty lines after each command to end its paragraph. + +Some examples of lists include: + + =over 4 + + =item * + + First item + + =item * + + Second item + + =back + + =over 4 + + =item Foo() + + Description of Foo function + + =item Bar() + + Description of Bar function + + =back + + +=back + + +=head2 Ordinary Block of Text + +It will be filled, and maybe even +justified. Certain interior sequences are recognized both +here and in commands: + + I italicize text, used for emphasis or variables + B embolden text, used for switches and programs + S text contains non-breaking spaces + C literal code + L A link (cross reference) to name + L manual page + L item in manual page + L section in other manual page + L<"sec"> section in this manual page + (the quotes are optional) + L ditto + same as above but only 'text' is used for output. + (Text can not contain the characters '|' or '>') + L + L + L + L + L + + F Used for filenames + X An index entry + Z<> A zero-width character + E A named character (very similar to HTML escapes) + E A literal < + E A literal > + (these are optional except in other interior + sequences and when preceded by a capital letter) + E Character number n (probably in ASCII) + E Some non-numeric HTML entity, such + as E + + +=head2 The Intent + +That's it. The intent is simplicity, not power. I wanted paragraphs +to look like paragraphs (block format), so that they stand out +visually, and so that I could run them through fmt easily to reformat +them (that's F7 in my version of B). I wanted the translator (and not +me) to worry about whether " or ' is a left quote or a right quote +within filled text, and I wanted it to leave the quotes alone, dammit, in +verbatim mode, so I could slurp in a working program, shift it over 4 +spaces, and have it print out, er, verbatim. And presumably in a +constant width font. + +In particular, you can leave things like this verbatim in your text: + + Perl + FILEHANDLE + $variable + function() + manpage(3r) + +Doubtless a few other commands or sequences will need to be added along +the way, but I've gotten along surprisingly well with just these. + +Note that I'm not at all claiming this to be sufficient for producing a +book. I'm just trying to make an idiot-proof common source for nroff, +TeX, and other markup languages, as used for online documentation. +Translators exist for B (that's for nroff(1) and troff(1)), +B, B, B, and B. + + +=head2 Embedding Pods in Perl Modules + +You can embed pod documentation in your Perl scripts. Start your +documentation with a "=head1" command at the beginning, and end it +with a "=cut" command. Perl will ignore the pod text. See any of the +supplied library modules for examples. If you're going to put your +pods at the end of the file, and you're using an __END__ or __DATA__ +cut mark, make sure to put an empty line there before the first pod +directive. + + __END__ + + + =head1 NAME + + modern - I am a modern module + +If you had not had that empty line there, then the translators wouldn't +have seen it. + + +=head2 Common Pod Pitfalls + +=over 4 + +=item * + +Pod translators usually will require paragraphs to be separated by +completely empty lines. If you have an apparently empty line with +some spaces on it, this can cause odd formatting. + +=item * + +Translators will mostly add wording around a LEE link, so that +Cfoo(1)E> becomes "the I(1) manpage", for example (see +B for details). Thus, you shouldn't write things like CfooE manpage>, if you want the translated document to read +sensibly. + +If you don need or want total control of the text used for a +link in the output use the form LEshow this text|fooE +instead. + +=item * + +The script F in the Perl source distribution +provides skeletal checking for lines that look empty but aren't +B, but is there as a placeholder until someone writes +Pod::Checker. The best way to check your pod is to pass it through +one or more translators and proofread the result, or print out the +result and proofread that. Some of the problems found may be bugs in +the translators, which you may or may not wish to work around. + +=back + +=head1 SEE ALSO + +L and L + +=head1 AUTHOR + +Larry Wall + diff --git a/contrib/perl5/pod/perlport.pod b/contrib/perl5/pod/perlport.pod new file mode 100644 index 00000000000..79ca76769f6 --- /dev/null +++ b/contrib/perl5/pod/perlport.pod @@ -0,0 +1,1461 @@ +=head1 NAME + +perlport - Writing portable Perl + + +=head1 DESCRIPTION + +Perl runs on a variety of operating systems. While most of them share +a lot in common, they also have their own very particular and unique +features. + +This document is meant to help you to find out what constitutes portable +Perl code, so that once you have made your decision to write portably, +you know where the lines are drawn, and you can stay within them. + +There is a tradeoff between taking full advantage of B     particular type +of computer, and taking advantage of a full B of them. Naturally, +as you make your range bigger (and thus more diverse), the common +denominators drop, and you are left with fewer areas of common ground in +which you can operate to accomplish a particular task. Thus, when you +begin attacking a problem, it is important to consider which part of the +tradeoff curve you want to operate under. Specifically, whether it is +important to you that the task that you are coding needs the full +generality of being portable, or if it is sufficient to just get the job +done. This is the hardest choice to be made. The rest is easy, because +Perl provides lots of choices, whichever way you want to approach your +problem. + +Looking at it another way, writing portable code is usually about +willfully limiting your available choices. Naturally, it takes discipline +to do that. + +Be aware of two important points: + +=over 4 + +=item Not all Perl programs have to be portable + +There is no reason why you should not use Perl as a language to glue Unix +tools together, or to prototype a Macintosh application, or to manage the +Windows registry. If it makes no sense to aim for portability for one +reason or another in a given program, then don't bother. + +=item The vast majority of Perl B portable + +Don't be fooled into thinking that it is hard to create portable Perl +code. It isn't. Perl tries its level-best to bridge the gaps between +what's available on different platforms, and all the means available to +use those features. Thus almost all Perl code runs on any machine +without modification. But there I some significant issues in +writing portable code, and this document is entirely about those issues. + +=back + +Here's the general rule: When you approach a task that is commonly done +using a whole range of platforms, think in terms of writing portable +code. That way, you don't sacrifice much by way of the implementation +choices you can avail yourself of, and at the same time you can give +your users lots of platform choices. On the other hand, when you have to +take advantage of some unique feature of a particular platform, as is +often the case with systems programming (whether for Unix, Windows, +S, VMS, etc.), consider writing platform-specific code. + +When the code will run on only two or three operating systems, then you +may only need to consider the differences of those particular systems. +The important thing is to decide where the code will run, and to be +deliberate in your decision. + +The material below is separated into three main sections: main issues of +portability (L<"ISSUES">, platform-specific issues (L<"PLATFORMS">, and +builtin perl functions that behave differently on various ports +(L<"FUNCTION IMPLEMENTATIONS">. + +This information should not be considered complete; it includes possibly +transient information about idiosyncrasies of some of the ports, almost +all of which are in a state of constant evolution. Thus this material +should be considered a perpetual work in progress +(EIMG SRC="yellow_sign.gif" ALT="Under Construction"E). + + + + +=head1 ISSUES + +=head2 Newlines + +In most operating systems, lines in files are separated with newlines. +Just what is used as a newline may vary from OS to OS. Unix +traditionally uses C<\012>, one kind of Windows I/O uses C<\015\012>, +and S uses C<\015>. + +Perl uses C<\n> to represent the "logical" newline, where what +is logical may depend on the platform in use. In MacPerl, C<\n> +always means C<\015>. In DOSish perls, C<\n> usually means C<\012>, but +when accessing a file in "text" mode, STDIO translates it to (or from) +C<\015\012>. + +Due to the "text" mode translation, DOSish perls have limitations +of using C and C when a file is being accessed in "text" +mode. Specifically, if you stick to C-ing to locations you got +from C (and no others), you are usually free to use C and +C even in "text" mode. In general, using C or C or +other file operations that count bytes instead of characters, without +considering the length of C<\n>, may be non-portable. If you use +C on a file, however, you can usually use C and C +with arbitrary values quite safely. + +A common misconception in socket programming is that C<\n> eq C<\012> +everywhere. When using protocols such as common Internet protocols, +C<\012> and C<\015> are called for specifically, and the values of +the logical C<\n> and C<\r> (carriage return) are not reliable. + + print SOCKET "Hi there, client!\r\n"; # WRONG + print SOCKET "Hi there, client!\015\012"; # RIGHT + +[NOTE: this does not necessarily apply to communications that are +filtered by another program or module before sending to the socket; the +the most popular EBCDIC webserver, for instance, accepts C<\r\n>, +which translates those characters, along with all other +characters in text streams, from EBCDIC to ASCII.] + +However, using C<\015\012> (or C<\cM\cJ>, or C<\x0D\x0A>) can be tedious +and unsightly, as well as confusing to those maintaining the code. As +such, the C module supplies the Right Thing for those who want it. + + use Socket qw(:DEFAULT :crlf); + print SOCKET "Hi there, client!$CRLF" # RIGHT + +When reading I a socket, remember that the default input record +separator (C<$/>) is C<\n>, but code like this should recognize C<$/> as +C<\012> or C<\015\012>: + + while () { + # ... + } + +Better: + + use Socket qw(:DEFAULT :crlf); + local($/) = LF; # not needed if $/ is already \012 + + while () { + s/$CR?$LF/\n/; # not sure if socket uses LF or CRLF, OK + # s/\015?\012/\n/; # same thing + } + +And this example is actually better than the previous one even for Unix +platforms, because now any C<\015>'s (C<\cM>'s) are stripped out +(and there was much rejoicing). + + +=head2 Numbers endianness and Width + +Different CPUs store integers and floating point numbers in different +orders (called I) and widths (32-bit and 64-bit being the +most common). This affects your programs if they attempt to transfer +numbers in binary format from a CPU architecture to another over some +channel: either 'live' via network connections or storing the numbers +to secondary storage such as a disk file. + +Conflicting storage orders make utter mess out of the numbers: if a +little-endian host (Intel, Alpha) stores 0x12345678 (305419896 in +decimal), a big-endian host (Motorola, MIPS, Sparc, PA) reads it as +0x78563412 (2018915346 in decimal). To avoid this problem in network +(socket) connections use the C and C formats C<"n"> +and C<"N">, the "network" orders, they are guaranteed to be portable. + +Different widths can cause truncation even between platforms of equal +endianness: the platform of shorter width loses the upper parts of the +number. There is no good solution for this problem except to avoid +transferring or storing raw binary numbers. + +One can circumnavigate both these problems in two ways: either +transfer and store numbers always in text format, instead of raw +binary, or consider using modules like C (included in +the standard distribution as of Perl 5.005) and C. + +=head2 Files + +Most platforms these days structure files in a hierarchical fashion. +So, it is reasonably safe to assume that any platform supports the +notion of a "path" to uniquely identify a file on the system. Just +how that path is actually written, differs. + +While they are similar, file path specifications differ between Unix, +Windows, S, OS/2, VMS, S and probably others. Unix, +for example, is one of the few OSes that has the idea of a single root +directory. + +VMS, Windows, and OS/2 can work similarly to Unix with C as path +separator, or in their own idiosyncratic ways (such as having several +root directories and various "unrooted" device files such NIL: and +LPT:). + +S uses C<:> as a path separator instead of C. + +C perl can emulate Unix filenames with C as path +separator, or go native and use C<.> for path separator and C<:> to +signal filing systems and disc names. + +As with the newline problem above, there are modules that can help. The +C modules provide methods to do the Right Thing on whatever +platform happens to be running the program. + + use File::Spec; + chdir(File::Spec->updir()); # go up one directory + $file = File::Spec->catfile( + File::Spec->curdir(), 'temp', 'file.txt' + ); + # on Unix and Win32, './temp/file.txt' + # on Mac OS, ':temp:file.txt' + +File::Spec is available in the standard distribution, as of version +5.004_05. + +In general, production code should not have file paths hardcoded; making +them user supplied or from a configuration file is better, keeping in mind +that file path syntax varies on different machines. + +This is especially noticeable in scripts like Makefiles and test suites, +which often assume C as a path separator for subdirectories. + +Also of use is C, from the standard distribution, which +splits a pathname into pieces (base filename, full path to directory, +and file suffix). + +Even when on a single platform (if you can call UNIX a single +platform), remember not to count on the existence or the contents of +system-specific files, like F, F, or +F. For example the F may exist but it +may not contain the encrypted passwords because the system is using +some form of enhanced security-- or it may not contain all the +accounts because the system is using NIS. If code does need to rely +on such a file, include a description of the file and its format in +the code's documentation, and make it easy for the user to override +the default location of the file. + +Do not have two files of the same name with different case, like +F and , as many platforms have case-insensitive +filenames. Also, try not to have non-word characters (except for C<.>) +in the names, and keep them to the 8.3 convention, for maximum +portability. + +Likewise, if using C, try to keep the split functions to +8.3 naming and case-insensitive conventions; or, at the very least, +make it so the resulting files have a unique (case-insensitively) +first 8 characters. + +Don't assume C> won't be the first character of a filename. Always +use C> explicitly to open a file for reading: + + open(FILE, "<$existing_file") or die $!; + + +=head2 System Interaction + +Not all platforms provide for the notion of a command line, necessarily. +These are usually platforms that rely on a Graphical User Interface (GUI) +for user interaction. So a program requiring command lines might not work +everywhere. But this is probably for the user of the program to deal +with. + +Some platforms can't delete or rename files that are being held open by +the system. Remember to C files when you are done with them. +Don't C or C an open file. Don't C to or C a +file that is already tied to or opened; C or C first. + +Don't open the same file more than once at a time for writing, as some +operating systems put mandatory locks on such files. + +Don't count on a specific environment variable existing in C<%ENV>. +Don't count on C<%ENV> entries being case-sensitive, or even +case-preserving. + +Don't count on signals. + +Don't count on filename globbing. Use C, C, and +C instead. + +Don't count on per-program environment variables, or per-program current +directories. + + +=head2 Interprocess Communication (IPC) + +In general, don't directly access the system in code that is meant to be +portable. That means, no C, C, C, C, C<``>, +C, C with a C<|>, nor any of the other things that makes being +a Unix perl hacker worth being. + +Commands that launch external processes are generally supported on +most platforms (though many of them do not support any type of forking), +but the problem with using them arises from what you invoke with them. +External tools are often named differently on different platforms, often +not available in the same location, often accept different arguments, +often behave differently, and often represent their results in a +platform-dependent way. Thus you should seldom depend on them to produce +consistent results. + +One especially common bit of Perl code is opening a pipe to sendmail: + + open(MAIL, '|/usr/lib/sendmail -t') or die $!; + +This is fine for systems programming when sendmail is known to be +available. But it is not fine for many non-Unix systems, and even +some Unix systems that may not have sendmail installed. If a portable +solution is needed, see the C and C modules +in the C distribution. C provides several +mailing methods, including mail, sendmail, and direct SMTP +(via C) if a mail transfer agent is not available. + +The rule of thumb for portable code is: Do it all in portable Perl, or +use a module (that may internally implement it with platform-specific +code, but expose a common interface). + +The UNIX System V IPC (C) is not available +even in all UNIX platforms. + +=head2 External Subroutines (XS) + +XS code, in general, can be made to work with any platform; but dependent +libraries, header files, etc., might not be readily available or +portable, or the XS code itself might be platform-specific, just as Perl +code might be. If the libraries and headers are portable, then it is +normally reasonable to make sure the XS code is portable, too. + +There is a different kind of portability issue with writing XS +code: availability of a C compiler on the end-user's system. C brings +with it its own portability issues, and writing XS code will expose you to +some of those. Writing purely in perl is a comparatively easier way to +achieve portability. + + +=head2 Standard Modules + +In general, the standard modules work across platforms. Notable +exceptions are C (which currently makes connections to external +programs that may not be available), platform-specific modules (like +C), and DBM modules. + +There is no one DBM module that is available on all platforms. +C and the others are generally available on all Unix and DOSish +ports, but not in MacPerl, where only C and C are +available. + +The good news is that at least some DBM module should be available, and +C will use whichever module it can find. Of course, then +the code needs to be fairly strict, dropping to the lowest common +denominator (e.g., not exceeding 1K for each record). + + +=head2 Time and Date + +The system's notion of time of day and calendar date is controlled in +widely different ways. Don't assume the timezone is stored in C<$ENV{TZ}>, +and even if it is, don't assume that you can control the timezone through +that variable. + +Don't assume that the epoch starts at 00:00:00, January 1, 1970, +because that is OS-specific. Better to store a date in an unambiguous +representation. The ISO 8601 standard defines YYYY-MM-DD as the date +format. A text representation (like C<1 Jan 1970>) can be easily +converted into an OS-specific value using a module like +C. An array of values, such as those returned by +C, can be converted to an OS-specific representation using +C. + + +=head2 Character sets and character encoding + +Assume very little about character sets. Do not assume anything about +the numerical values (C, C) of characters. Do not +assume that the alphabetic characters are encoded contiguously (in +numerical sense). Do no assume anything about the ordering of the +characters. The lowercase letters may come before or after the +uppercase letters, the lowercase and uppercase may be interlaced so +that both 'a' and 'A' come before the 'b', the accented and other +international characters may be interlaced so that E comes +before the 'b'. + + +=head2 Internationalisation + +If you may assume POSIX (a rather large assumption, that: in practise +that means UNIX) you may read more about the POSIX locale system from +L. The locale system at least attempts to make things a +little bit more portable or at least more convenient and +native-friendly for non-English users. The system affects character +sets and encoding, and date and time formatting, among other things. + + +=head2 System Resources + +If your code is destined for systems with severely constrained (or +missing!) virtual memory systems then you want to be I mindful +of avoiding wasteful constructs such as: + + # NOTE: this is no longer "bad" in perl5.005 + for (0..10000000) {} # bad + for (my $x = 0; $x <= 10000000; ++$x) {} # good + + @lines = ; # bad + + while () {$file .= $_} # sometimes bad + $file = join('', ); # better + +The last two may appear unintuitive to most people. The first of those +two constructs repeatedly grows a string, while the second allocates a +large chunk of memory in one go. On some systems, the latter is more +efficient that the former. + + +=head2 Security + +Most multi-user platforms provide basic levels of security that is usually +felt at the file-system level. Other platforms usually don't +(unfortunately). Thus the notion of user id, or "home" directory, or even +the state of being logged-in, may be unrecognizable on many platforms. If +you write programs that are security conscious, it is usually best to know +what type of system you will be operating under, and write code explicitly +for that platform (or class of platforms). + + +=head2 Style + +For those times when it is necessary to have platform-specific code, +consider keeping the platform-specific code in one place, making porting +to other platforms easier. Use the C module and the special +variable C<$^O> to differentiate platforms, as described in +L<"PLATFORMS">. + + +=head1 CPAN Testers + +Modules uploaded to CPAN are tested by a variety of volunteers on +different platforms. These CPAN testers are notified by mail of each +new upload, and reply to the list with PASS, FAIL, NA (not applicable to +this platform), or UNKNOWN (unknown), along with any relevant notations. + +The purpose of the testing is twofold: one, to help developers fix any +problems in their code that crop up because of lack of testing on other +platforms; two, to provide users with information about whether or not +a given module works on a given platform. + +=over 4 + +=item Mailing list: cpan-testers@perl.org + +=item Testing results: C + +=back + + +=head1 PLATFORMS + +As of version 5.002, Perl is built with a C<$^O> variable that +indicates the operating system it was built on. This was implemented +to help speed up code that would otherwise have to C and +use the value of C<$Config{'osname'}>. Of course, to get +detailed information about the system, looking into C<%Config> is +certainly recommended. + +=head2 Unix + +Perl works on a bewildering variety of Unix and Unix-like platforms (see +e.g. most of the files in the F directory in the source code kit). +On most of these systems, the value of C<$^O> (hence C<$Config{'osname'}>, +too) is determined by lowercasing and stripping punctuation from the first +field of the string returned by typing C (or a similar command) +at the shell prompt. Here, for example, are a few of the more popular +Unix flavors: + + uname $^O $Config{'archname'} + ------------------------------------------- + AIX aix aix + FreeBSD freebsd freebsd-i386 + Linux linux i386-linux + HP-UX hpux PA-RISC1.1 + IRIX irix irix + OSF1 dec_osf alpha-dec_osf + SunOS solaris sun4-solaris + SunOS solaris i86pc-solaris + SunOS4 sunos sun4-sunos + +Note that because the C<$Config{'archname'}> may depend on the hardware +architecture it may vary quite a lot, much more than the C<$^O>. + +=head2 DOS and Derivatives + +Perl has long been ported to PC style microcomputers running under +systems like PC-DOS, MS-DOS, OS/2, and most Windows platforms you can +bring yourself to mention (except for Windows CE, if you count that). +Users familiar with I and/or I style shells should +be aware that each of these file specifications may have subtle +differences: + + $filespec0 = "c:/foo/bar/file.txt"; + $filespec1 = "c:\\foo\\bar\\file.txt"; + $filespec2 = 'c:\foo\bar\file.txt'; + $filespec3 = 'c:\\foo\\bar\\file.txt'; + +System calls accept either C or C<\> as the path separator. However, +many command-line utilities of DOS vintage treat C as the option +prefix, so they may get confused by filenames containing C. Aside +from calling any external programs, C will work just fine, and +probably better, as it is more consistent with popular usage, and avoids +the problem of remembering what to backwhack and what not to. + +The DOS FAT filesystem can only accommodate "8.3" style filenames. Under +the "case insensitive, but case preserving" HPFS (OS/2) and NTFS (NT) +filesystems you may have to be careful about case returned with functions +like C or used with functions like C or C. + +DOS also treats several filenames as special, such as AUX, PRN, NUL, CON, +COM1, LPT1, LPT2 etc. Unfortunately these filenames won't even work +if you include an explicit directory prefix, in some cases. It is best +to avoid such filenames, if you want your code to be portable to DOS +and its derivatives. + +Users of these operating systems may also wish to make use of +scripts such as I or I as appropriate to +put wrappers around your scripts. + +Newline (C<\n>) is translated as C<\015\012> by STDIO when reading from +and writing to files. C will keep C<\n> translated +as C<\012> for that filehandle. Since it is a noop on other systems, +C should be used for cross-platform code that deals with binary +data. + +The C<$^O> variable and the C<$Config{'archname'}> values for various +DOSish perls are as follows: + + OS $^O $Config{'archname'} + -------------------------------------------- + MS-DOS dos + PC-DOS dos + OS/2 os2 + Windows 95 MSWin32 MSWin32-x86 + Windows NT MSWin32 MSWin32-x86 + Windows NT MSWin32 MSWin32-alpha + Windows NT MSWin32 MSWin32-ppc + +Also see: + +=over 4 + +=item The djgpp environment for DOS, C + +=item The EMX environment for DOS, OS/2, etc. C, +C + +=item Build instructions for Win32, L. + +=item The ActiveState Pages, C + +=back + + +=head2 S + +Any module requiring XS compilation is right out for most people, because +MacPerl is built using non-free (and non-cheap!) compilers. Some XS +modules that can work with MacPerl are built and distributed in binary +form on CPAN. See I and L<"CPAN Testers"> +for more details. + +Directories are specified as: + + volume:folder:file for absolute pathnames + volume:folder: for absolute pathnames + :folder:file for relative pathnames + :folder: for relative pathnames + :file for relative pathnames + file for relative pathnames + +Files in a directory are stored in alphabetical order. Filenames are +limited to 31 characters, and may include any character except C<:>, +which is reserved as a path separator. + +Instead of C, see C and C in the +C module. + +In the MacPerl application, you can't run a program from the command line; +programs that expect C<@ARGV> to be populated can be edited with something +like the following, which brings up a dialog box asking for the command +line arguments. + + if (!@ARGV) { + @ARGV = split /\s+/, MacPerl::Ask('Arguments?'); + } + +A MacPerl script saved as a droplet will populate C<@ARGV> with the full +pathnames of the files dropped onto the script. + +Mac users can use programs on a kind of command line under MPW (Macintosh +Programmer's Workshop, a free development environment from Apple). +MacPerl was first introduced as an MPW tool, and MPW can be used like a +shell: + + perl myscript.plx some arguments + +ToolServer is another app from Apple that provides access to MPW tools +from MPW and the MacPerl app, which allows MacPerl programs to use +C, backticks, and piped C. + +"S" is the proper name for the operating system, but the value +in C<$^O> is "MacOS". To determine architecture, version, or whether +the application or MPW tool version is running, check: + + $is_app = $MacPerl::Version =~ /App/; + $is_tool = $MacPerl::Version =~ /MPW/; + ($version) = $MacPerl::Version =~ /^(\S+)/; + $is_ppc = $MacPerl::Architecture eq 'MacPPC'; + $is_68k = $MacPerl::Architecture eq 'Mac68K'; + +S, to be based on NeXT's OpenStep OS, will be able to run +MacPerl natively (in the Blue Box, and even in the Yellow Box, once some +changes to the toolbox calls are made), but Unix perl will also run +natively. + +Also see: + +=over 4 + +=item The MacPerl Pages, C. + +=item The MacPerl mailing list, C. + +=back + + +=head2 VMS + +Perl on VMS is discussed in F in the perl distribution. +Note that perl on VMS can accept either VMS- or Unix-style file +specifications as in either of the following: + + $ perl -ne "print if /perl_setup/i" SYS$LOGIN:LOGIN.COM + $ perl -ne "print if /perl_setup/i" /sys$login/login.com + +but not a mixture of both as in: + + $ perl -ne "print if /perl_setup/i" sys$login:/login.com + Can't open sys$login:/login.com: file specification syntax error + +Interacting with Perl from the Digital Command Language (DCL) shell +often requires a different set of quotation marks than Unix shells do. +For example: + + $ perl -e "print ""Hello, world.\n""" + Hello, world. + +There are a number of ways to wrap your perl scripts in DCL .COM files if +you are so inclined. For example: + + $ write sys$output "Hello from DCL!" + $ if p1 .eqs. "" + $ then perl -x 'f$environment("PROCEDURE") + $ else perl -x - 'p1 'p2 'p3 'p4 'p5 'p6 'p7 'p8 + $ deck/dollars="__END__" + #!/usr/bin/perl + + print "Hello from Perl!\n"; + + __END__ + $ endif + +Do take care with C<$ ASSIGN/nolog/user SYS$COMMAND: SYS$INPUT> if your +perl-in-DCL script expects to do things like C<$read = ESTDINE;>. + +Filenames are in the format "name.extension;version". The maximum +length for filenames is 39 characters, and the maximum length for +extensions is also 39 characters. Version is a number from 1 to +32767. Valid characters are C. + +VMS' RMS filesystem is case insensitive and does not preserve case. +C returns lowercased filenames, but specifying a file for +opening remains case insensitive. Files without extensions have a +trailing period on them, so doing a C with a file named F +will return F (though that file could be opened with +C). + +RMS had an eight level limit on directory depths from any rooted logical +(allowing 16 levels overall) prior to VMS 7.2. Hence +C is a valid directory specification but +C is not. F authors might +have to take this into account, but at least they can refer to the former +as C. + +The C module, which gets installed as part of the build +process on VMS, is a pure Perl module that can easily be installed on +non-VMS platforms and can be helpful for conversions to and from RMS +native formats. + +What C<\n> represents depends on the type of file that is open. It could +be C<\015>, C<\012>, C<\015\012>, or nothing. Reading from a file +translates newlines to C<\012>, unless C was executed on that +handle, just like DOSish perls. + +TCP/IP stacks are optional on VMS, so socket routines might not be +implemented. UDP sockets may not be supported. + +The value of C<$^O> on OpenVMS is "VMS". To determine the architecture +that you are running on without resorting to loading all of C<%Config> +you can examine the content of the C<@INC> array like so: + + if (grep(/VMS_AXP/, @INC)) { + print "I'm on Alpha!\n"; + } elsif (grep(/VMS_VAX/, @INC)) { + print "I'm on VAX!\n"; + } else { + print "I'm not so sure about where $^O is...\n"; + } + +Also see: + +=over 4 + +=item L + +=item vmsperl list, C + +Put words C in message body. + +=item vmsperl on the web, C + +=back + + +=head2 EBCDIC Platforms + +Recent versions of Perl have been ported to platforms such as OS/400 on +AS/400 minicomputers as well as OS/390 for IBM Mainframes. Such computers +use EBCDIC character sets internally (usually Character Code Set ID 00819 +for OS/400 and IBM-1047 for OS/390). Note that on the mainframe perl +currently works under the "Unix system services for OS/390" (formerly +known as OpenEdition). + +As of R2.5 of USS for OS/390 that Unix sub-system did not support the +C<#!> shebang trick for script invocation. Hence, on OS/390 perl scripts +can executed with a header similar to the following simple script: + + : # use perl + eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}' + if 0; + #!/usr/local/bin/perl # just a comment really + + print "Hello from perl!\n"; + +On these platforms, bear in mind that the EBCDIC character set may have +an effect on what happens with some perl functions (such as C, +C, C, C, C, C, C, C), as +well as bit-fiddling with ASCII constants using operators like C<^>, C<&> +and C<|>, not to mention dealing with socket interfaces to ASCII computers +(see L<"NEWLINES">). + +Fortunately, most web servers for the mainframe will correctly translate +the C<\n> in the following statement to its ASCII equivalent (note that +C<\r> is the same under both Unix and OS/390): + + print "Content-type: text/html\r\n\r\n"; + +The value of C<$^O> on OS/390 is "os390". + +Some simple tricks for determining if you are running on an EBCDIC +platform could include any of the following (perhaps all): + + if ("\t" eq "\05") { print "EBCDIC may be spoken here!\n"; } + + if (ord('A') == 193) { print "EBCDIC may be spoken here!\n"; } + + if (chr(169) eq 'z') { print "EBCDIC may be spoken here!\n"; } + +Note that one thing you may not want to rely on is the EBCDIC encoding +of punctuation characters since these may differ from code page to code +page (and once your module or script is rumoured to work with EBCDIC, +folks will want it to work with all EBCDIC character sets). + +Also see: + +=over 4 + +=item perl-mvs list + +The perl-mvs@perl.org list is for discussion of porting issues as well as +general usage issues for all EBCDIC Perls. Send a message body of +"subscribe perl-mvs" to majordomo@perl.org. + +=item AS/400 Perl information at C + +=back + + +=head2 Acorn RISC OS + +As Acorns use ASCII with newlines (C<\n>) in text files as C<\012> like +Unix and Unix filename emulation is turned on by default, it is quite +likely that most simple scripts will work "out of the box". The native +filing system is modular, and individual filing systems are free to be +case-sensitive or insensitive, and are usually case-preserving. Some +native filing systems have name length limits which file and directory +names are silently truncated to fit - scripts should be aware that the +standard disc filing system currently has a name length limit of B<10> +characters, with up to 77 items in a directory, but other filing systems +may not impose such limitations. + +Native filenames are of the form + + Filesystem#Special_Field::DiscName.$.Directory.Directory.File + +where + + Special_Field is not usually present, but may contain . and $ . + Filesystem =~ m|[A-Za-z0-9_]| + DsicName =~ m|[A-Za-z0-9_/]| + $ represents the root directory + . is the path separator + @ is the current directory (per filesystem but machine global) + ^ is the parent directory + Directory and File =~ m|[^\0- "\.\$\%\&:\@\\^\|\177]+| + +The default filename translation is roughly C + +Note that C<"ADFS::HardDisc.$.File" ne 'ADFS::HardDisc.$.File'> and that +the second stage of C<$> interpolation in regular expressions will fall +foul of the C<$.> if scripts are not careful. + +Logical paths specified by system variables containing comma-separated +search lists are also allowed, hence C is a valid +filename, and the filesystem will prefix C with each section of +C until a name is made that points to an object on disc. +Writing to a new file C would only be allowed if +C contains a single item list. The filesystem will also +expand system variables in filenames if enclosed in angle brackets, so +CSystem$DirE.Modules> would look for the file +S>. The obvious implication of this is +that BE> and should +be protected when C is used for input. + +Because C<.> was in use as a directory separator and filenames could not +be assumed to be unique after 10 characters, Acorn implemented the C +compiler to strip the trailing C<.c> C<.h> C<.s> and C<.o> suffix from +filenames specified in source code and store the respective files in +subdirectories named after the suffix. Hence files are translated: + + foo.h h.foo + C:foo.h C:h.foo (logical path variable) + sys/os.h sys.h.os (C compiler groks Unix-speak) + 10charname.c c.10charname + 10charname.o o.10charname + 11charname_.c c.11charname (assuming filesystem truncates at 10) + +The Unix emulation library's translation of filenames to native assumes +that this sort of translation is required, and allows a user defined list +of known suffixes which it will transpose in this fashion. This may +appear transparent, but consider that with these rules C +and C both map to C, and that C and +C cannot and do not attempt to emulate the reverse mapping. Other +C<.>s in filenames are translated to C. + +As implied above the environment accessed through C<%ENV> is global, and +the convention is that program specific environment variables are of the +form C. Each filing system maintains a current directory, +and the current filing system's current directory is the B current +directory. Consequently, sociable scripts don't change the current +directory but rely on full pathnames, and scripts (and Makefiles) cannot +assume that they can spawn a child process which can change the current +directory without affecting its parent (and everyone else for that +matter). + +As native operating system filehandles are global and currently are +allocated down from 255, with 0 being a reserved value the Unix emulation +library emulates Unix filehandles. Consequently, you can't rely on +passing C, C, or C to your children. + +The desire of users to express filenames of the form +CFoo$DirE.Bar> on the command line unquoted causes problems, +too: C<``> command output capture has to perform a guessing game. It +assumes that a string C[^EE]+\$[^EE]E> is a +reference to an environment variable, whereas anything else involving +C> or C> is redirection, and generally manages to be 99% +right. Of course, the problem remains that scripts cannot rely on any +Unix tools being available, or that any tools found have Unix-like command +line arguments. + +Extensions and XS are, in theory, buildable by anyone using free tools. +In practice, many don't, as users of the Acorn platform are used to binary +distribution. MakeMaker does run, but no available make currently copes +with MakeMaker's makefiles; even if/when this is fixed, the lack of a +Unix-like shell can cause problems with makefile rules, especially lines +of the form C, and anything using quoting. + +"S" is the proper name for the operating system, but the value +in C<$^O> is "riscos" (because we don't like shouting). + +Also see: + +=over 4 + +=item perl list + +=back + + +=head2 Other perls + +Perl has been ported to a variety of platforms that do not fit into any of +the above categories. Some, such as AmigaOS, BeOS, QNX, and Plan 9, have +been well-integrated into the standard Perl source code kit. You may need +to see the F directory on CPAN for information, and possibly +binaries, for the likes of: aos, atari, lynxos, riscos, Tandem Guardian, +vos, I (yes we know that some of these OSes may fall under the Unix +category, but we are not a standards body.) + +See also: + +=over 4 + +=item Atari, Guido Flohr's page C + +=item HP 300 MPE/iX C + +=item Novell Netware + +A free perl5-based PERL.NLM for Novell Netware is available from +C + +=back + + +=head1 FUNCTION IMPLEMENTATIONS + +Listed below are functions unimplemented or implemented differently on +various platforms. Following each description will be, in parentheses, a +list of platforms that the description applies to. + +The list may very well be incomplete, or wrong in some places. When in +doubt, consult the platform-specific README files in the Perl source +distribution, and other documentation resources for a given port. + +Be aware, moreover, that even among Unix-ish systems there are variations. + +For many functions, you can also query C<%Config>, exported by default +from C. For example, to check if the platform has the C +call, check C<$Config{'d_lstat'}>. See L for a full +description of available variables. + + +=head2 Alphabetical Listing of Perl Functions + +=over 8 + +=item -X FILEHANDLE + +=item -X EXPR + +=item -X + +C<-r>, C<-w>, and C<-x> have only a very limited meaning; directories +and applications are executable, and there are no uid/gid +considerations. C<-o> is not supported. (S) + +C<-r>, C<-w>, C<-x>, and C<-o> tell whether or not file is accessible, +which may not reflect UIC-based file protections. (VMS) + +C<-s> returns the size of the data fork, not the total size of data fork +plus resource fork. (S). + +C<-s> by name on an open file will return the space reserved on disk, +rather than the current extent. C<-s> on an open filehandle returns the +current size. (S) + +C<-R>, C<-W>, C<-X>, C<-O> are indistinguishable from C<-r>, C<-w>, +C<-x>, C<-o>. (S, Win32, VMS, S) + +C<-b>, C<-c>, C<-k>, C<-g>, C<-p>, C<-u>, C<-A> are not implemented. +(S) + +C<-g>, C<-k>, C<-l>, C<-p>, C<-u>, C<-A> are not particularly meaningful. +(Win32, VMS, S) + +C<-d> is true if passed a device spec without an explicit directory. +(VMS) + +C<-T> and C<-B> are implemented, but might misclassify Mac text files +with foreign characters; this is the case will all platforms, but may +affect S often. (S) + +C<-x> (or C<-X>) determine if a file ends in one of the executable +suffixes. C<-S> is meaningless. (Win32) + +C<-x> (or C<-X>) determine if a file has an executable file type. +(S) + +=item binmode FILEHANDLE + +Meaningless. (S, S) + +Reopens file and restores pointer; if function fails, underlying +filehandle may be closed, or pointer may be in a different position. +(VMS) + +The value returned by C may be affected after the call, and +the filehandle may be flushed. (Win32) + +=item chmod LIST + +Only limited meaning. Disabling/enabling write permission is mapped to +locking/unlocking the file. (S) + +Only good for changing "owner" read-write access, "group", and "other" +bits are meaningless. (Win32) + +Only good for changing "owner" and "other" read-write access. (S) + +=item chown LIST + +Not implemented. (S, Win32, Plan9, S) + +Does nothing, but won't fail. (Win32) + +=item chroot FILENAME + +=item chroot + +Not implemented. (S, Win32, VMS, Plan9, S) + +=item crypt PLAINTEXT,SALT + +May not be available if library or source was not provided when building +perl. (Win32) + +=item dbmclose HASH + +Not implemented. (VMS, Plan9) + +=item dbmopen HASH,DBNAME,MODE + +Not implemented. (VMS, Plan9) + +=item dump LABEL + +Not useful. (S, S) + +Not implemented. (Win32) + +Invokes VMS debugger. (VMS) + +=item exec LIST + +Not implemented. (S) + +=item fcntl FILEHANDLE,FUNCTION,SCALAR + +Not implemented. (Win32, VMS) + +=item flock FILEHANDLE,OPERATION + +Not implemented (S, VMS, S). + +Available only on Windows NT (not on Windows 95). (Win32) + +=item fork + +Not implemented. (S, Win32, AmigaOS, S) + +=item getlogin + +Not implemented. (S, S) + +=item getpgrp PID + +Not implemented. (S, Win32, VMS, S) + +=item getppid + +Not implemented. (S, Win32, VMS, S) + +=item getpriority WHICH,WHO + +Not implemented. (S, Win32, VMS, S) + +=item getpwnam NAME + +Not implemented. (S, Win32) + +Not useful. (S) + +=item getgrnam NAME + +Not implemented. (S, Win32, VMS, S) + +=item getnetbyname NAME + +Not implemented. (S, Win32, Plan9) + +=item getpwuid UID + +Not implemented. (S, Win32) + +Not useful. (S) + +=item getgrgid GID + +Not implemented. (S, Win32, VMS, S) + +=item getnetbyaddr ADDR,ADDRTYPE + +Not implemented. (S, Win32, Plan9) + +=item getprotobynumber NUMBER + +Not implemented. (S) + +=item getservbyport PORT,PROTO + +Not implemented. (S) + +=item getpwent + +Not implemented. (S, Win32) + +=item getgrent + +Not implemented. (S, Win32, VMS) + +=item gethostent + +Not implemented. (S, Win32) + +=item getnetent + +Not implemented. (S, Win32, Plan9) + +=item getprotoent + +Not implemented. (S, Win32, Plan9) + +=item getservent + +Not implemented. (Win32, Plan9) + +=item setpwent + +Not implemented. (S, Win32, S) + +=item setgrent + +Not implemented. (S, Win32, VMS, S) + +=item sethostent STAYOPEN + +Not implemented. (S, Win32, Plan9, S) + +=item setnetent STAYOPEN + +Not implemented. (S, Win32, Plan9, S) + +=item setprotoent STAYOPEN + +Not implemented. (S, Win32, Plan9, S) + +=item setservent STAYOPEN + +Not implemented. (Plan9, Win32, S) + +=item endpwent + +Not implemented. (S, Win32) + +=item endgrent + +Not implemented. (S, Win32, VMS, S) + +=item endhostent + +Not implemented. (S, Win32) + +=item endnetent + +Not implemented. (S, Win32, Plan9) + +=item endprotoent + +Not implemented. (S, Win32, Plan9) + +=item endservent + +Not implemented. (Plan9, Win32) + +=item getsockopt SOCKET,LEVEL,OPTNAME + +Not implemented. (S, Plan9) + +=item glob EXPR + +=item glob + +Globbing built-in, but only C<*> and C metacharacters are supported. +(S) + +Features depend on external perlglob.exe or perlglob.bat. May be +overridden with something like File::DosGlob, which is recommended. +(Win32) + +Globbing built-in, but only C<*> and C metacharacters are supported. +Globbing relies on operating system calls, which may return filenames +in any order. As most filesystems are case-insensitive, even "sorted" +filenames will not be in case-sensitive order. (S) + +=item ioctl FILEHANDLE,FUNCTION,SCALAR + +Not implemented. (VMS) + +Available only for socket handles, and it does what the ioctlsocket() call +in the Winsock API does. (Win32) + +Available only for socket handles. (S) + +=item kill LIST + +Not implemented, hence not useful for taint checking. (S, +S) + +Available only for process handles returned by the C +method of spawning a process. (Win32) + +=item link OLDFILE,NEWFILE + +Not implemented. (S, Win32, VMS, S) + +=item lstat FILEHANDLE + +=item lstat EXPR + +=item lstat + +Not implemented. (VMS, S) + +Return values may be bogus. (Win32) + +=item msgctl ID,CMD,ARG + +=item msgget KEY,FLAGS + +=item msgsnd ID,MSG,FLAGS + +=item msgrcv ID,VAR,SIZE,TYPE,FLAGS + +Not implemented. (S, Win32, VMS, Plan9, S) + +=item open FILEHANDLE,EXPR + +=item open FILEHANDLE + +The C<|> variants are only supported if ToolServer is installed. +(S) + +open to C<|-> and C<-|> are unsupported. (S, Win32, S) + +=item pipe READHANDLE,WRITEHANDLE + +Not implemented. (S) + +=item readlink EXPR + +=item readlink + +Not implemented. (Win32, VMS, S) + +=item select RBITS,WBITS,EBITS,TIMEOUT + +Only implemented on sockets. (Win32) + +Only reliable on sockets. (S) + +=item semctl ID,SEMNUM,CMD,ARG + +=item semget KEY,NSEMS,FLAGS + +=item semop KEY,OPSTRING + +Not implemented. (S, Win32, VMS, S) + +=item setpgrp PID,PGRP + +Not implemented. (S, Win32, VMS, S) + +=item setpriority WHICH,WHO,PRIORITY + +Not implemented. (S, Win32, VMS, S) + +=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL + +Not implemented. (S, Plan9) + +=item shmctl ID,CMD,ARG + +=item shmget KEY,SIZE,FLAGS + +=item shmread ID,VAR,POS,SIZE + +=item shmwrite ID,STRING,POS,SIZE + +Not implemented. (S, Win32, VMS, S) + +=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL + +Not implemented. (S, Win32, VMS, S) + +=item stat FILEHANDLE + +=item stat EXPR + +=item stat + +mtime and atime are the same thing, and ctime is creation time instead of +inode change time. (S) + +device and inode are not meaningful. (Win32) + +device and inode are not necessarily reliable. (VMS) + +mtime, atime and ctime all return the last modification time. Device and +inode are not necessarily reliable. (S) + +=item symlink OLDFILE,NEWFILE + +Not implemented. (Win32, VMS, S) + +=item syscall LIST + +Not implemented. (S, Win32, VMS, S) + +=item sysopen FILEHANDLE,FILENAME,MODE,PERMS + +The traditional "0", "1", and "2" MODEs are implemented with different +numeric values on some systems. The flags exported by C +(O_RDONLY, O_WRONLY, O_RDWR) should work everywhere though. (S, OS/390) + +=item system LIST + +Only implemented if ToolServer is installed. (S) + +As an optimization, may not call the command shell specified in +C<$ENV{PERL5SHELL}>. C spawns an external +process and immediately returns its process designator, without +waiting for it to terminate. Return value may be used subsequently +in C or C. (Win32) + +There is no shell to process metacharacters, and the native standard is +to pass a command line terminated by "\n" "\r" or "\0" to the spawned +program. Redirection such as C foo> is performed (if at all) by +the run time library of the spawned program. C I will call +the Unix emulation library's C emulation, which attempts to provide +emulation of the stdin, stdout, stderr in force in the parent, providing +the child program uses a compatible version of the emulation library. +I will call the native command line direct and no such emulation +of a child Unix program will exists. Mileage B vary. (S) + +=item times + +Only the first entry returned is nonzero. (S) + +"cumulative" times will be bogus. On anything other than Windows NT, +"system" time will be bogus, and "user" time is actually the time +returned by the clock() function in the C runtime library. (Win32) + +Not useful. (S) + +=item truncate FILEHANDLE,LENGTH + +=item truncate EXPR,LENGTH + +Not implemented. (VMS) + +=item umask EXPR + +=item umask + +Returns undef where unavailable, as of version 5.005. + +=item utime LIST + +Only the modification time is updated. (S, VMS, S) + +May not behave as expected. Behavior depends on the C runtime +library's implementation of utime(), and the filesystem being +used. The FAT filesystem typically does not support an "access +time" field, and it may limit timestamps to a granularity of +two seconds. (Win32) + +=item wait + +=item waitpid PID,FLAGS + +Not implemented. (S) + +Can only be applied to process handles returned for processes spawned +using C. (Win32) + +Not useful. (S) + +=back + +=head1 CHANGES + +=over 4 + +=item 1.33, 06 August 1998 + +Integrate more minor changes. + +=item 1.32, 05 August 1998 + +Integrate more minor changes. + +=item 1.30, 03 August 1998 + +Major update for RISC OS, other minor changes. + +=item 1.23, 10 July 1998 + +First public release with perl5.005. + +=back + +=head1 AUTHORS / CONTRIBUTORS + +Abigail Eabigail@fnx.comE, +Charles Bailey Ebailey@genetics.upenn.eduE, +Graham Barr Egbarr@pobox.comE, +Tom Christiansen Etchrist@perl.comE, +Nicholas Clark ENicholas.Clark@liverpool.ac.ukE, +Andy Dougherty Edoughera@lafcol.lafayette.eduE, +Dominic Dunlop Edomo@vo.luE, +M.J.T. Guy Emjtg@cus.cam.ac.ukE, +Luther Huffman Elutherh@stratcom.comE, +Nick Ing-Simmons Enick@ni-s.u-net.comE, +Andreas J. KEnig Ekoenig@kulturbox.deE, +Andrew M. Langmead Eaml@world.std.comE, +Paul Moore EPaul.Moore@uk.origin-it.comE, +Chris Nandor Epudge@pobox.comE, +Matthias Neeracher Eneeri@iis.ee.ethz.chE, +Gary Ng E71564.1743@CompuServe.COME, +Tom Phoenix Erootbeer@teleport.comE, +Peter Prymmer Epvhp@forte.comE, +Hugo van der Sanden Ehv@crypt0.demon.co.ukE, +Gurusamy Sarathy Egsar@umich.eduE, +Paul J. Schinder Eschinder@pobox.comE, +Dan Sugalski Esugalskd@ous.eduE, +Nathan Torkington Egnat@frii.comE. + +This document is maintained by Chris Nandor. + +=head1 VERSION + +Version 1.34, last modified 07 August 1998. + + diff --git a/contrib/perl5/pod/perlre.pod b/contrib/perl5/pod/perlre.pod new file mode 100644 index 00000000000..382ba652427 --- /dev/null +++ b/contrib/perl5/pod/perlre.pod @@ -0,0 +1,929 @@ +=head1 NAME + +perlre - Perl regular expressions + +=head1 DESCRIPTION + +This page describes the syntax of regular expressions in Perl. For a +description of how to I regular expressions in matching +operations, plus various examples of the same, see discussion +of C, C, C and C in L. + +The matching operations can have various modifiers. The modifiers +that relate to the interpretation of the regular expression inside +are listed below. For the modifiers that alter the way a regular expression +is used by Perl, see L and +L. + +=over 4 + +=item i + +Do case-insensitive pattern matching. + +If C is in effect, the case map is taken from the current +locale. See L. + +=item m + +Treat string as multiple lines. That is, change "^" and "$" from matching +at only the very start or end of the string to the start or end of any +line anywhere within the string, + +=item s + +Treat string as single line. That is, change "." to match any character +whatsoever, even a newline, which it normally would not match. + +The C and C modifiers both override the C<$*> setting. That is, no matter +what C<$*> contains, C without C will force "^" to match only at the +beginning of the string and "$" to match only at the end (or just before a +newline at the end) of the string. Together, as /ms, they let the "." match +any character whatsoever, while yet allowing "^" and "$" to match, +respectively, just after and just before newlines within the string. + +=item x + +Extend your pattern's legibility by permitting whitespace and comments. + +=back + +These are usually written as "the C modifier", even though the delimiter +in question might not actually be a slash. In fact, any of these +modifiers may also be embedded within the regular expression itself using +the new C<(?...)> construct. See below. + +The C modifier itself needs a little more explanation. It tells +the regular expression parser to ignore whitespace that is neither +backslashed nor within a character class. You can use this to break up +your regular expression into (slightly) more readable parts. The C<#> +character is also treated as a metacharacter introducing a comment, +just as in ordinary Perl code. This also means that if you want real +whitespace or C<#> characters in the pattern (outside of a character +class, where they are unaffected by C), that you'll either have to +escape them or encode them using octal or hex escapes. Taken together, +these features go a long way towards making Perl's regular expressions +more readable. Note that you have to be careful not to include the +pattern delimiter in the comment--perl has no way of knowing you did +not intend to close the pattern early. See the C-comment deletion code +in L. + +=head2 Regular Expressions + +The patterns used in pattern matching are regular expressions such as +those supplied in the Version 8 regex routines. (In fact, the +routines are derived (distantly) from Henry Spencer's freely +redistributable reimplementation of the V8 routines.) +See L for details. + +In particular the following metacharacters have their standard I-ish +meanings: + + \ Quote the next metacharacter + ^ Match the beginning of the line + . Match any character (except newline) + $ Match the end of the line (or before newline at the end) + | Alternation + () Grouping + [] Character class + +By default, the "^" character is guaranteed to match at only the +beginning of the string, the "$" character at only the end (or before the +newline at the end) and Perl does certain optimizations with the +assumption that the string contains only one line. Embedded newlines +will not be matched by "^" or "$". You may, however, wish to treat a +string as a multi-line buffer, such that the "^" will match after any +newline within the string, and "$" will match before any newline. At the +cost of a little more overhead, you can do this by using the /m modifier +on the pattern match operator. (Older programs did this by setting C<$*>, +but this practice is now deprecated.) + +To facilitate multi-line substitutions, the "." character never matches a +newline unless you use the C modifier, which in effect tells Perl to pretend +the string is a single line--even if it isn't. The C modifier also +overrides the setting of C<$*>, in case you have some (badly behaved) older +code that sets it in another module. + +The following standard quantifiers are recognized: + + * Match 0 or more times + + Match 1 or more times + ? Match 1 or 0 times + {n} Match exactly n times + {n,} Match at least n times + {n,m} Match at least n but not more than m times + +(If a curly bracket occurs in any other context, it is treated +as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+" +modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited +to integral values less than 65536. + +By default, a quantified subpattern is "greedy", that is, it will match as +many times as possible (given a particular starting location) while still +allowing the rest of the pattern to match. If you want it to match the +minimum number of times possible, follow the quantifier with a "?". Note +that the meanings don't change, just the "greediness": + + *? Match 0 or more times + +? Match 1 or more times + ?? Match 0 or 1 time + {n}? Match exactly n times + {n,}? Match at least n times + {n,m}? Match at least n but not more than m times + +Because patterns are processed as double quoted strings, the following +also work: + + \t tab (HT, TAB) + \n newline (LF, NL) + \r return (CR) + \f form feed (FF) + \a alarm (bell) (BEL) + \e escape (think troff) (ESC) + \033 octal char (think of a PDP-11) + \x1B hex char + \c[ control char + \l lowercase next char (think vi) + \u uppercase next char (think vi) + \L lowercase till \E (think vi) + \U uppercase till \E (think vi) + \E end case modification (think vi) + \Q quote (disable) pattern metacharacters till \E + +If C is in effect, the case map used by C<\l>, C<\L>, C<\u> +and C<\U> is taken from the current locale. See L. + +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be matched. +You'll need to write something like C. + +In addition, Perl defines the following: + + \w Match a "word" character (alphanumeric plus "_") + \W Match a non-word character + \s Match a whitespace character + \S Match a non-whitespace character + \d Match a digit character + \D Match a non-digit character + +A C<\w> matches a single alphanumeric character, not a whole +word. To match a word you'd need to say C<\w+>. If C is in +effect, the list of alphabetic characters generated by C<\w> is taken +from the current locale. See L. You may use C<\w>, C<\W>, +C<\s>, C<\S>, C<\d>, and C<\D> within character classes (though not as +either end of a range). + +Perl defines the following zero-width assertions: + + \b Match a word boundary + \B Match a non-(word boundary) + \A Match only at beginning of string + \Z Match only at end of string, or before newline at the end + \z Match only at end of string + \G Match only where previous m//g left off (works only with /g) + +A word boundary (C<\b>) is defined as a spot between two characters that +has a C<\w> on one side of it and a C<\W> on the other side of it (in +either order), counting the imaginary characters off the beginning and +end of the string as matching a C<\W>. (Within character classes C<\b> +represents backspace rather than a word boundary.) The C<\A> and C<\Z> are +just like "^" and "$", except that they won't match multiple times when the +C modifier is used, while "^" and "$" will match at every internal line +boundary. To match the actual end of the string, not ignoring newline, +you can use C<\z>. The C<\G> assertion can be used to chain global +matches (using C), as described in +L. + +It is also useful when writing C-like scanners, when you have several +patterns that you want to match against consequent substrings of your +string, see the previous reference. +The actual location where C<\G> will match can also be influenced +by using C as an lvalue. See L. + +When the bracketing construct C<( ... )> is used, \EdigitE matches the +digit'th substring. Outside of the pattern, always use "$" instead of "\" +in front of the digit. (While the \EdigitE notation can on rare occasion work +outside the current pattern, this should not be relied upon. See the +WARNING below.) The scope of $EdigitE (and C<$`>, C<$&>, and C<$'>) +extends to the end of the enclosing BLOCK or eval string, or to the next +successful pattern match, whichever comes first. If you want to use +parentheses to delimit a subpattern (e.g., a set of alternatives) without +saving it as a subpattern, follow the ( with a ?:. + +You may have as many parentheses as you wish. If you have more +than 9 substrings, the variables $10, $11, ... refer to the +corresponding substring. Within the pattern, \10, \11, etc. refer back +to substrings if there have been at least that many left parentheses before +the backreference. Otherwise (for backward compatibility) \10 is the +same as \010, a backspace, and \11 the same as \011, a tab. And so +on. (\1 through \9 are always backreferences.) + +C<$+> returns whatever the last bracket match matched. C<$&> returns the +entire matched string. (C<$0> used to return the same thing, but not any +more.) C<$`> returns everything before the matched string. C<$'> returns +everything after the matched string. Examples: + + s/^([^ ]*) *([^ ]*)/$2 $1/; # swap first two words + + if (/Time: (..):(..):(..)/) { + $hours = $1; + $minutes = $2; + $seconds = $3; + } + +Once perl sees that you need one of C<$&>, C<$`> or C<$'> anywhere in +the program, it has to provide them on each and every pattern match. +This can slow your program down. The same mechanism that handles +these provides for the use of $1, $2, etc., so you pay the same price +for each pattern that contains capturing parentheses. But if you never +use $&, etc., in your script, then patterns I capturing +parentheses won't be penalized. So avoid $&, $', and $` if you can, +but if you can't (and some algorithms really appreciate them), once +you've used them once, use them at will, because you've already paid +the price. As of 5.005, $& is not so costly as the other two. + +Backslashed metacharacters in Perl are +alphanumeric, such as C<\b>, C<\w>, C<\n>. Unlike some other regular +expression languages, there are no backslashed symbols that aren't +alphanumeric. So anything that looks like \\, \(, \), \E, \E, +\{, or \} is always interpreted as a literal character, not a +metacharacter. This was once used in a common idiom to disable or +quote the special meanings of regular expression metacharacters in a +string that you want to use for a pattern. Simply quote all +non-alphanumeric characters: + + $pattern =~ s/(\W)/\\$1/g; + +Now it is much more common to see either the quotemeta() function or +the C<\Q> escape sequence used to disable all metacharacters' special +meanings like this: + + /$unquoted\Q$quoted\E$unquoted/ + +Perl defines a consistent extension syntax for regular expressions. +The syntax is a pair of parentheses with a question mark as the first +thing within the parentheses (this was a syntax error in older +versions of Perl). The character after the question mark gives the +function of the extension. Several extensions are already supported: + +=over 10 + +=item C<(?#text)> + +A comment. The text is ignored. If the C switch is used to enable +whitespace formatting, a simple C<#> will suffice. Note that perl closes +the comment as soon as it sees a C<)>, so there is no way to put a literal +C<)> in the comment. + +=item C<(?:pattern)> + +=item C<(?imsx-imsx:pattern)> + +This is for clustering, not capturing; it groups subexpressions like +"()", but doesn't make backreferences as "()" does. So + + @fields = split(/\b(?:a|b|c)\b/) + +is like + + @fields = split(/\b(a|b|c)\b/) + +but doesn't spit out extra fields. + +The letters between C and C<:> act as flags modifiers, see +L>. In particular, + + /(?s-i:more.*than).*million/i + +is equivalent to more verbose + + /(?:(?s-i)more.*than).*million/i + +=item C<(?=pattern)> + +A zero-width positive lookahead assertion. For example, C +matches a word followed by a tab, without including the tab in C<$&>. + +=item C<(?!pattern)> + +A zero-width negative lookahead assertion. For example C +matches any occurrence of "foo" that isn't followed by "bar". Note +however that lookahead and lookbehind are NOT the same thing. You cannot +use this for lookbehind. + +If you are looking for a "bar" that isn't preceded by a "foo", C +will not do what you want. That's because the C<(?!foo)> is just saying that +the next thing cannot be "foo"--and it's not, it's a "bar", so "foobar" will +match. You would have to do something like C for that. We +say "like" because there's the case of your "bar" not having three characters +before it. You could cover that this way: C. +Sometimes it's still easier just to say: + + if (/bar/ && $` !~ /foo$/) + +For lookbehind see below. + +=item C<(?E=pattern)> + +A zero-width positive lookbehind assertion. For example, C=\t)\w+/> +matches a word following a tab, without including the tab in C<$&>. +Works only for fixed-width lookbehind. + +=item C<(? + +A zero-width negative lookbehind assertion. For example C +matches any occurrence of "foo" that isn't following "bar". +Works only for fixed-width lookbehind. + +=item C<(?{ code })> + +Experimental "evaluate any Perl code" zero-width assertion. Always +succeeds. C is not interpolated. Currently the rules to +determine where the C ends are somewhat convoluted. + +The C is properly scoped in the following sense: if the assertion +is backtracked (compare L<"Backtracking">), all the changes introduced after +Cisation are undone, so + + $_ = 'a' x 8; + m< + (?{ $cnt = 0 }) # Initialize $cnt. + ( + a + (?{ + local $cnt = $cnt + 1; # Update $cnt, backtracking-safe. + }) + )* + aaaa + (?{ $res = $cnt }) # On success copy to non-localized + # location. + >x; + +will set C<$res = 4>. Note that after the match $cnt returns to the globally +introduced value 0, since the scopes which restrict C statements +are unwound. + +This assertion may be used as L> +switch. If I used in this way, the result of evaluation of C +is put into variable $^R. This happens immediately, so $^R can be used from +other C<(?{ code })> assertions inside the same regular expression. + +The above assignment to $^R is properly localized, thus the old value of $^R +is restored if the assertion is backtracked (compare L<"Backtracking">). + +Due to security concerns, this construction is not allowed if the regular +expression involves run-time interpolation of variables, unless +C pragma is used (see L), or the variables contain +results of qr() operator (see L). + +This restriction is due to the wide-spread (questionable) practice of +using the construct + + $re = <>; + chomp $re; + $string =~ /$re/; + +without tainting. While this code is frowned upon from security point +of view, when C<(?{})> was introduced, it was considered bad to add +I security holes to existing scripts. + +B Use of the above insecure snippet without also enabling taint mode +is to be severely frowned upon. C does not disable tainting +checks, thus to allow $re in the above snippet to contain C<(?{})> +I, one needs both C and untaint +the $re. + +=item C<(?Epattern)> + +An "independent" subexpression. Matches the substring that a +I C would match if anchored at the given position, +B. + +Say, C<^(?Ea*)ab> will never match, since C<(?Ea*)> (anchored +at the beginning of string, as above) will match I characters +C at the beginning of string, leaving no C for C to match. +In contrast, C will match the same as C, since the match of +the subgroup C is influenced by the following group C (see +L<"Backtracking">). In particular, C inside C will match +fewer characters than a standalone C, since this makes the tail match. + +An effect similar to C<(?Epattern)> may be achieved by + + (?=(pattern))\1 + +since the lookahead is in I<"logical"> context, thus matches the same +substring as a standalone C. The following C<\1> eats the matched +string, thus making a zero-length assertion into an analogue of +C<(?E...)>. (The difference between these two constructs is that the +second one uses a catching group, thus shifting ordinals of +backreferences in the rest of a regular expression.) + +This construct is useful for optimizations of "eternal" +matches, because it will not backtrack (see L<"Backtracking">). + + m{ \( + ( + [^()]+ + | + \( [^()]* \) + )+ + \) + }x + +That will efficiently match a nonempty group with matching +two-or-less-level-deep parentheses. However, if there is no such group, +it will take virtually forever on a long string. That's because there are +so many different ways to split a long string into several substrings. +This is what C<(.+)+> is doing, and C<(.+)+> is similar to a subpattern +of the above pattern. Consider that the above pattern detects no-match +on C<((()aaaaaaaaaaaaaaaaaa> in several seconds, but that each extra +letter doubles this time. This exponential performance will make it +appear that your program has hung. + +However, a tiny modification of this pattern + + m{ \( + ( + (?> [^()]+ ) + | + \( [^()]* \) + )+ + \) + }x + +which uses C<(?E...)> matches exactly when the one above does (verifying +this yourself would be a productive exercise), but finishes in a fourth +the time when used on a similar string with 1000000 Cs. Be aware, +however, that this pattern currently triggers a warning message under +B<-w> saying it C<"matches the null string many times">): + +On simple groups, such as the pattern C<(?> [^()]+ )>, a comparable +effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>. +This was only 4 times slower on a string with 1000000 Cs. + +=item C<(?(condition)yes-pattern|no-pattern)> + +=item C<(?(condition)yes-pattern)> + +Conditional expression. C<(condition)> should be either an integer in +parentheses (which is valid if the corresponding pair of parentheses +matched), or lookahead/lookbehind/evaluate zero-width assertion. + +Say, + + m{ ( \( )? + [^()]+ + (?(1) \) ) + }x + +matches a chunk of non-parentheses, possibly included in parentheses +themselves. + +=item C<(?imsx-imsx)> + +One or more embedded pattern-match modifiers. This is particularly +useful for patterns that are specified in a table somewhere, some of +which want to be case sensitive, and some of which don't. The case +insensitive ones need to include merely C<(?i)> at the front of the +pattern. For example: + + $pattern = "foobar"; + if ( /$pattern/i ) { } + + # more flexible: + + $pattern = "(?i)foobar"; + if ( /$pattern/ ) { } + +Letters after C<-> switch modifiers off. + +These modifiers are localized inside an enclosing group (if any). Say, + + ( (?i) blah ) \s+ \1 + +(assuming C modifier, and no C modifier outside of this group) +will match a repeated (I!) word C in any +case. + +=back + +A question mark was chosen for this and for the new minimal-matching +construct because 1) question mark is pretty rare in older regular +expressions, and 2) whenever you see one, you should stop and "question" +exactly what is going on. That's psychology... + +=head2 Backtracking + +A fundamental feature of regular expression matching involves the +notion called I, which is currently used (when needed) +by all regular expression quantifiers, namely C<*>, C<*?>, C<+>, +C<+?>, C<{n,m}>, and C<{n,m}?>. + +For a regular expression to match, the I regular expression must +match, not just part of it. So if the beginning of a pattern containing a +quantifier succeeds in a way that causes later parts in the pattern to +fail, the matching engine backs up and recalculates the beginning +part--that's why it's called backtracking. + +Here is an example of backtracking: Let's say you want to find the +word following "foo" in the string "Food is on the foo table.": + + $_ = "Food is on the foo table."; + if ( /\b(foo)\s+(\w+)/i ) { + print "$2 follows $1.\n"; + } + +When the match runs, the first part of the regular expression (C<\b(foo)>) +finds a possible match right at the beginning of the string, and loads up +$1 with "Foo". However, as soon as the matching engine sees that there's +no whitespace following the "Foo" that it had saved in $1, it realizes its +mistake and starts over again one character after where it had the +tentative match. This time it goes all the way until the next occurrence +of "foo". The complete regular expression matches this time, and you get +the expected output of "table follows foo." + +Sometimes minimal matching can help a lot. Imagine you'd like to match +everything between "foo" and "bar". Initially, you write something +like this: + + $_ = "The food is under the bar in the barn."; + if ( /foo(.*)bar/ ) { + print "got <$1>\n"; + } + +Which perhaps unexpectedly yields: + + got + +That's because C<.*> was greedy, so you get everything between the +I "foo" and the I "bar". In this case, it's more effective +to use minimal matching to make sure you get the text between a "foo" +and the first "bar" thereafter. + + if ( /foo(.*?)bar/ ) { print "got <$1>\n" } + got + +Here's another example: let's say you'd like to match a number at the end +of a string, and you also want to keep the preceding part the match. +So you write this: + + $_ = "I have 2 numbers: 53147"; + if ( /(.*)(\d*)/ ) { # Wrong! + print "Beginning is <$1>, number is <$2>.\n"; + } + +That won't work at all, because C<.*> was greedy and gobbled up the +whole string. As C<\d*> can match on an empty string the complete +regular expression matched successfully. + + Beginning is , number is <>. + +Here are some variants, most of which don't work: + + $_ = "I have 2 numbers: 53147"; + @pats = qw{ + (.*)(\d*) + (.*)(\d+) + (.*?)(\d*) + (.*?)(\d+) + (.*)(\d+)$ + (.*?)(\d+)$ + (.*)\b(\d+)$ + (.*\D)(\d+)$ + }; + + for $pat (@pats) { + printf "%-12s ", $pat; + if ( /$pat/ ) { + print "<$1> <$2>\n"; + } else { + print "FAIL\n"; + } + } + +That will print out: + + (.*)(\d*) <> + (.*)(\d+) <7> + (.*?)(\d*) <> <> + (.*?)(\d+) <2> + (.*)(\d+)$ <7> + (.*?)(\d+)$ <53147> + (.*)\b(\d+)$ <53147> + (.*\D)(\d+)$ <53147> + +As you see, this can be a bit tricky. It's important to realize that a +regular expression is merely a set of assertions that gives a definition +of success. There may be 0, 1, or several different ways that the +definition might succeed against a particular string. And if there are +multiple ways it might succeed, you need to understand backtracking to +know which variety of success you will achieve. + +When using lookahead assertions and negations, this can all get even +tricker. Imagine you'd like to find a sequence of non-digits not +followed by "123". You might try to write that as + + $_ = "ABC123"; + if ( /^\D*(?!123)/ ) { # Wrong! + print "Yup, no 123 in $_\n"; + } + +But that isn't going to match; at least, not the way you're hoping. It +claims that there is no 123 in the string. Here's a clearer picture of +why it that pattern matches, contrary to popular expectations: + + $x = 'ABC123' ; + $y = 'ABC445' ; + + print "1: got $1\n" if $x =~ /^(ABC)(?!123)/ ; + print "2: got $1\n" if $y =~ /^(ABC)(?!123)/ ; + + print "3: got $1\n" if $x =~ /^(\D*)(?!123)/ ; + print "4: got $1\n" if $y =~ /^(\D*)(?!123)/ ; + +This prints + + 2: got ABC + 3: got AB + 4: got ABC + +You might have expected test 3 to fail because it seems to a more +general purpose version of test 1. The important difference between +them is that test 3 contains a quantifier (C<\D*>) and so can use +backtracking, whereas test 1 will not. What's happening is +that you've asked "Is it true that at the start of $x, following 0 or more +non-digits, you have something that's not 123?" If the pattern matcher had +let C<\D*> expand to "ABC", this would have caused the whole pattern to +fail. +The search engine will initially match C<\D*> with "ABC". Then it will +try to match C<(?!123> with "123", which of course fails. But because +a quantifier (C<\D*>) has been used in the regular expression, the +search engine can backtrack and retry the match differently +in the hope of matching the complete regular expression. + +The pattern really, I wants to succeed, so it uses the +standard pattern back-off-and-retry and lets C<\D*> expand to just "AB" this +time. Now there's indeed something following "AB" that is not +"123". It's in fact "C123", which suffices. + +We can deal with this by using both an assertion and a negation. We'll +say that the first part in $1 must be followed by a digit, and in fact, it +must also be followed by something that's not "123". Remember that the +lookaheads are zero-width expressions--they only look, but don't consume +any of the string in their match. So rewriting this way produces what +you'd expect; that is, case 5 will fail, but case 6 succeeds: + + print "5: got $1\n" if $x =~ /^(\D*)(?=\d)(?!123)/ ; + print "6: got $1\n" if $y =~ /^(\D*)(?=\d)(?!123)/ ; + + 6: got ABC + +In other words, the two zero-width assertions next to each other work as though +they're ANDed together, just as you'd use any builtin assertions: C +matches only if you're at the beginning of the line AND the end of the +line simultaneously. The deeper underlying truth is that juxtaposition in +regular expressions always means AND, except when you write an explicit OR +using the vertical bar. C means match "a" AND (then) match "b", +although the attempted matches are made at different positions because "a" +is not a zero-width assertion, but a one-width assertion. + +One warning: particularly complicated regular expressions can take +exponential time to solve due to the immense number of possible ways they +can use backtracking to try match. For example this will take a very long +time to run + + /((a{0,5}){0,5}){0,5}/ + +And if you used C<*>'s instead of limiting it to 0 through 5 matches, then +it would take literally forever--or until you ran out of stack space. + +A powerful tool for optimizing such beasts is "independent" groups, +which do not backtrace (see Lpattern)>>). Note also that +zero-length lookahead/lookbehind assertions will not backtrace to make +the tail match, since they are in "logical" context: only the fact +whether they match or not is considered relevant. For an example +where side-effects of a lookahead I have influenced the +following match, see Lpattern)>>. + +=head2 Version 8 Regular Expressions + +In case you're not familiar with the "regular" Version 8 regex +routines, here are the pattern-matching rules not described above. + +Any single character matches itself, unless it is a I +with a special meaning described here or above. You can cause +characters that normally function as metacharacters to be interpreted +literally by prefixing them with a "\" (e.g., "\." matches a ".", not any +character; "\\" matches a "\"). A series of characters matches that +series of characters in the target string, so the pattern C +would match "blurfl" in the target string. + +You can specify a character class, by enclosing a list of characters +in C<[]>, which will match any one character from the list. If the +first character after the "[" is "^", the class matches any character not +in the list. Within a list, the "-" character is used to specify a +range, so that C represents all characters between "a" and "z", +inclusive. If you want "-" itself to be a member of a class, put it +at the start or end of the list, or escape it with a backslash. (The +following all specify the same class of three characters: C<[-az]>, +C<[az-]>, and C<[a\-z]>. All are different from C<[a-z]>, which +specifies a class containing twenty-six characters.) + +Characters may be specified using a metacharacter syntax much like that +used in C: "\n" matches a newline, "\t" a tab, "\r" a carriage return, +"\f" a form feed, etc. More generally, \I, where I is a string +of octal digits, matches the character whose ASCII value is I. +Similarly, \xI, where I are hexadecimal digits, matches the +character whose ASCII value is I. The expression \cI matches the +ASCII character control-I. Finally, the "." metacharacter matches any +character except "\n" (unless you use C). + +You can specify a series of alternatives for a pattern using "|" to +separate them, so that C will match any of "fee", "fie", +or "foe" in the target string (as would C). The +first alternative includes everything from the last pattern delimiter +("(", "[", or the beginning of the pattern) up to the first "|", and +the last alternative contains everything from the last "|" to the next +pattern delimiter. For this reason, it's common practice to include +alternatives in parentheses, to minimize confusion about where they +start and end. + +Alternatives are tried from left to right, so the first +alternative found for which the entire expression matches, is the one that +is chosen. This means that alternatives are not necessarily greedy. For +example: when mathing C against "barefoot", only the "foo" +part will match, as that is the first alternative tried, and it successfully +matches the target string. (This might not seem important, but it is +important when you are capturing matched text using parentheses.) + +Also remember that "|" is interpreted as a literal within square brackets, +so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>. + +Within a pattern, you may designate subpatterns for later reference by +enclosing them in parentheses, and you may refer back to the Ith +subpattern later in the pattern using the metacharacter \I. +Subpatterns are numbered based on the left to right order of their +opening parenthesis. A backreference matches whatever +actually matched the subpattern in the string being examined, not the +rules for that subpattern. Therefore, C<(0|0x)\d*\s\1\d*> will +match "0x1234 0x4321", but not "0x1234 01234", because subpattern 1 +actually matched "0x", even though the rule C<0|0x> could +potentially match the leading 0 in the second number. + +=head2 WARNING on \1 vs $1 + +Some people get too used to writing things like: + + $pattern =~ s/(\W)/\\\1/g; + +This is grandfathered for the RHS of a substitute to avoid shocking the +B addicts, but it's a dirty habit to get into. That's because in +PerlThink, the righthand side of a C is a double-quoted string. C<\1> in +the usual double-quoted string means a control-A. The customary Unix +meaning of C<\1> is kludged in for C. However, if you get into the habit +of doing that, you get yourself into trouble if you then add an C +modifier. + + s/(\d+)/ \1 + 1 /eg; # causes warning under -w + +Or if you try to do + + s/(\d+)/\1000/; + +You can't disambiguate that by saying C<\{1}000>, whereas you can fix it with +C<${1}000>. Basically, the operation of interpolation should not be confused +with the operation of matching a backreference. Certainly they mean two +different things on the I side of the C. + +=head2 Repeated patterns matching zero-length substring + +WARNING: Difficult material (and prose) ahead. This section needs a rewrite. + +Regular expressions provide a terse and powerful programming language. As +with most other power tools, power comes together with the ability +to wreak havoc. + +A common abuse of this power stems from the ability to make infinite +loops using regular expressions, with something as innocous as: + + 'foo' =~ m{ ( o? )* }x; + +The C can match at the beginning of C<'foo'>, and since the position +in the string is not moved by the match, C would match again and again +due to the C<*> modifier. Another common way to create a similar cycle +is with the looping modifier C: + + @matches = ( 'foo' =~ m{ o? }xg ); + +or + + print "match: <$&>\n" while 'foo' =~ m{ o? }xg; + +or the loop implied by split(). + +However, long experience has shown that many programming tasks may +be significantly simplified by using repeated subexpressions which +may match zero-length substrings, with a simple example being: + + @chars = split //, $string; # // is not magic in split + ($whitewashed = $string) =~ s/()/ /g; # parens avoid magic s// / + +Thus Perl allows the C construct, which I. The rules for this are different for lower-level +loops given by the greedy modifiers C<*+{}>, and for higher-level +ones like the C modifier or split() operator. + +The lower-level loops are I when it is detected that a +repeated expression did match a zero-length substring, thus + + m{ (?: NON_ZERO_LENGTH | ZERO_LENGTH )* }x; + +is made equivalent to + + m{ (?: NON_ZERO_LENGTH )* + | + (?: ZERO_LENGTH )? + }x; + +The higher level-loops preserve an additional state between iterations: +whether the last match was zero-length. To break the loop, the following +match after a zero-length match is prohibited to have a length of zero. +This prohibition interacts with backtracking (see L<"Backtracking">), +and so the I match is chosen if the I match is of +zero length. + +Say, + + $_ = 'bar'; + s/\w??/<$&>/g; + +results in C<"<><><><>">. At each position of the string the best +match given by non-greedy C is the zero-length match, and the I match is what is matched by C<\w>. Thus zero-length matches +alternate with one-character-long matches. + +Similarly, for repeated C the second-best match is the match at the +position one notch further in the string. + +The additional state of being I is associated to +the matched string, and is reset by each assignment to pos(). + +=head2 Creating custom RE engines + +Overloaded constants (see L) provide a simple way to extend +the functionality of the RE engine. + +Suppose that we want to enable a new RE escape-sequence C<\Y|> which +matches at boundary between white-space characters and non-whitespace +characters. Note that C<(?=\S)(? matches exactly +at these positions, so we want to have each C<\Y|> in the place of the +more complicated version. We can create a module C to do +this: + + package customre; + use overload; + + sub import { + shift; + die "No argument to customre::import allowed" if @_; + overload::constant 'qr' => \&convert; + } + + sub invalid { die "/$_[0]/: invalid escape '\\$_[1]'"} + + my %rules = ( '\\' => '\\', + 'Y|' => qr/(?=\S)(? enables the new escape in constant regular +expressions, i.e., those without any runtime variable interpolations. +As documented in L, this conversion will work only over +literal parts of regular expressions. For C<\Y|$re\Y|> the variable +part of this regular expression needs to be converted explicitly +(but only if the special meaning of C<\Y|> should be enabled inside $re): + + use customre; + $re = <>; + chomp $re; + $re = customre::convert $re; + /\Y|$re\Y|/; + +=head2 SEE ALSO + +L. + +L. + +L. + +L. + +I (see L) by Jeffrey Friedl. diff --git a/contrib/perl5/pod/perlref.pod b/contrib/perl5/pod/perlref.pod new file mode 100644 index 00000000000..66b1a7d7c1f --- /dev/null +++ b/contrib/perl5/pod/perlref.pod @@ -0,0 +1,646 @@ +=head1 NAME + +perlref - Perl references and nested data structures + +=head1 DESCRIPTION + +Before release 5 of Perl it was difficult to represent complex data +structures, because all references had to be symbolic--and even then +it was difficult to refer to a variable instead of a symbol table entry. +Perl now not only makes it easier to use symbolic references to variables, +but also lets you have "hard" references to any piece of data or code. +Any scalar may hold a hard reference. Because arrays and hashes contain +scalars, you can now easily build arrays of arrays, arrays of hashes, +hashes of arrays, arrays of hashes of functions, and so on. + +Hard references are smart--they keep track of reference counts for you, +automatically freeing the thing referred to when its reference count goes +to zero. (Note: the reference counts for values in self-referential or +cyclic data structures may not go to zero without a little help; see +L for a detailed explanation.) +If that thing happens to be an object, the object is destructed. See +L for more about objects. (In a sense, everything in Perl is an +object, but we usually reserve the word for references to objects that +have been officially "blessed" into a class package.) + +Symbolic references are names of variables or other objects, just as a +symbolic link in a Unix filesystem contains merely the name of a file. +The C<*glob> notation is a kind of symbolic reference. (Symbolic +references are sometimes called "soft references", but please don't call +them that; references are confusing enough without useless synonyms.) + +In contrast, hard references are more like hard links in a Unix file +system: They are used to access an underlying object without concern for +what its (other) name is. When the word "reference" is used without an +adjective, as in the following paragraph, it is usually talking about a +hard reference. + +References are easy to use in Perl. There is just one overriding +principle: Perl does no implicit referencing or dereferencing. When a +scalar is holding a reference, it always behaves as a simple scalar. It +doesn't magically start being an array or hash or subroutine; you have to +tell it explicitly to do so, by dereferencing it. + +=head2 Making References + +References can be created in several ways. + +=over 4 + +=item 1. + +By using the backslash operator on a variable, subroutine, or value. +(This works much like the & (address-of) operator in C.) Note +that this typically creates I reference to a variable, because +there's already a reference to the variable in the symbol table. But +the symbol table reference might go away, and you'll still have the +reference that the backslash returned. Here are some examples: + + $scalarref = \$foo; + $arrayref = \@ARGV; + $hashref = \%ENV; + $coderef = \&handler; + $globref = \*foo; + +It isn't possible to create a true reference to an IO handle (filehandle +or dirhandle) using the backslash operator. The most you can get is a +reference to a typeglob, which is actually a complete symbol table entry. +But see the explanation of the C<*foo{THING}> syntax below. However, +you can still use type globs and globrefs as though they were IO handles. + +=item 2. + +A reference to an anonymous array can be created using square +brackets: + + $arrayref = [1, 2, ['a', 'b', 'c']]; + +Here we've created a reference to an anonymous array of three elements +whose final element is itself a reference to another anonymous array of three +elements. (The multidimensional syntax described later can be used to +access this. For example, after the above, C<$arrayref-E[2][1]> would have +the value "b".) + +Note that taking a reference to an enumerated list is not the same +as using square brackets--instead it's the same as creating +a list of references! + + @list = (\$a, \@b, \%c); + @list = \($a, @b, %c); # same thing! + +As a special case, C<\(@foo)> returns a list of references to the contents +of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>. + +=item 3. + +A reference to an anonymous hash can be created using curly +brackets: + + $hashref = { + 'Adam' => 'Eve', + 'Clyde' => 'Bonnie', + }; + +Anonymous hash and array composers like these can be intermixed freely to +produce as complicated a structure as you want. The multidimensional +syntax described below works for these too. The values above are +literals, but variables and expressions would work just as well, because +assignment operators in Perl (even within local() or my()) are executable +statements, not compile-time declarations. + +Because curly brackets (braces) are used for several other things +including BLOCKs, you may occasionally have to disambiguate braces at the +beginning of a statement by putting a C<+> or a C in front so +that Perl realizes the opening brace isn't starting a BLOCK. The economy and +mnemonic value of using curlies is deemed worth this occasional extra +hassle. + +For example, if you wanted a function to make a new hash and return a +reference to it, you have these options: + + sub hashem { { @_ } } # silently wrong + sub hashem { +{ @_ } } # ok + sub hashem { return { @_ } } # ok + +On the other hand, if you want the other meaning, you can do this: + + sub showem { { @_ } } # ambiguous (currently ok, but may change) + sub showem { {; @_ } } # ok + sub showem { { return @_ } } # ok + +Note how the leading C<+{> and C<{;> always serve to disambiguate +the expression to mean either the HASH reference, or the BLOCK. + +=item 4. + +A reference to an anonymous subroutine can be created by using +C without a subname: + + $coderef = sub { print "Boink!\n" }; + +Note the presence of the semicolon. Except for the fact that the code +inside isn't executed immediately, a C is not so much a +declaration as it is an operator, like C or C. (However, no +matter how many times you execute that particular line (unless you're in an +C), C<$coderef> will still have a reference to the I +anonymous subroutine.) + +Anonymous subroutines act as closures with respect to my() variables, +that is, variables visible lexically within the current scope. Closure +is a notion out of the Lisp world that says if you define an anonymous +function in a particular lexical context, it pretends to run in that +context even when it's called outside of the context. + +In human terms, it's a funny way of passing arguments to a subroutine when +you define it as well as when you call it. It's useful for setting up +little bits of code to run later, such as callbacks. You can even +do object-oriented stuff with it, though Perl already provides a different +mechanism to do that--see L. + +You can also think of closure as a way to write a subroutine template without +using eval. (In fact, in version 5.000, eval was the I way to get +closures. You may wish to use "require 5.001" if you use closures.) + +Here's a small example of how closures works: + + sub newprint { + my $x = shift; + return sub { my $y = shift; print "$x, $y!\n"; }; + } + $h = newprint("Howdy"); + $g = newprint("Greetings"); + + # Time passes... + + &$h("world"); + &$g("earthlings"); + +This prints + + Howdy, world! + Greetings, earthlings! + +Note particularly that $x continues to refer to the value passed into +newprint() I the fact that the "my $x" has seemingly gone out of +scope by the time the anonymous subroutine runs. That's what closure +is all about. + +This applies only to lexical variables, by the way. Dynamic variables +continue to work as they have always worked. Closure is not something +that most Perl programmers need trouble themselves about to begin with. + +=item 5. + +References are often returned by special subroutines called constructors. +Perl objects are just references to a special kind of object that happens to know +which package it's associated with. Constructors are just special +subroutines that know how to create that association. They do so by +starting with an ordinary reference, and it remains an ordinary reference +even while it's also being an object. Constructors are often +named new() and called indirectly: + + $objref = new Doggie (Tail => 'short', Ears => 'long'); + +But don't have to be: + + $objref = Doggie->new(Tail => 'short', Ears => 'long'); + + use Term::Cap; + $terminal = Term::Cap->Tgetent( { OSPEED => 9600 }); + + use Tk; + $main = MainWindow->new(); + $menubar = $main->Frame(-relief => "raised", + -borderwidth => 2) + +=item 6. + +References of the appropriate type can spring into existence if you +dereference them in a context that assumes they exist. Because we haven't +talked about dereferencing yet, we can't show you any examples yet. + +=item 7. + +A reference can be created by using a special syntax, lovingly known as +the *foo{THING} syntax. *foo{THING} returns a reference to the THING +slot in *foo (which is the symbol table entry which holds everything +known as foo). + + $scalarref = *foo{SCALAR}; + $arrayref = *ARGV{ARRAY}; + $hashref = *ENV{HASH}; + $coderef = *handler{CODE}; + $ioref = *STDIN{IO}; + $globref = *foo{GLOB}; + +All of these are self-explanatory except for *foo{IO}. It returns the +IO handle, used for file handles (L), sockets +(L and L), and directory handles +(L). For compatibility with previous versions of +Perl, *foo{FILEHANDLE} is a synonym for *foo{IO}. + +*foo{THING} returns undef if that particular THING hasn't been used yet, +except in the case of scalars. *foo{SCALAR} returns a reference to an +anonymous scalar if $foo hasn't been used yet. This might change in a +future release. + +*foo{IO} is an alternative to the \*HANDLE mechanism given in +L for passing filehandles +into or out of subroutines, or storing into larger data structures. +Its disadvantage is that it won't create a new filehandle for you. +Its advantage is that you have no risk of clobbering more than you want +to with a typeglob assignment, although if you assign to a scalar instead +of a typeglob, you're ok. + + splutter(*STDOUT); + splutter(*STDOUT{IO}); + + sub splutter { + my $fh = shift; + print $fh "her um well a hmmm\n"; + } + + $rec = get_rec(*STDIN); + $rec = get_rec(*STDIN{IO}); + + sub get_rec { + my $fh = shift; + return scalar <$fh>; + } + +=back + +=head2 Using References + +That's it for creating references. By now you're probably dying to +know how to use references to get back to your long-lost data. There +are several basic methods. + +=over 4 + +=item 1. + +Anywhere you'd put an identifier (or chain of identifiers) as part +of a variable or subroutine name, you can replace the identifier with +a simple scalar variable containing a reference of the correct type: + + $bar = $$scalarref; + push(@$arrayref, $filename); + $$arrayref[0] = "January"; + $$hashref{"KEY"} = "VALUE"; + &$coderef(1,2,3); + print $globref "output\n"; + +It's important to understand that we are specifically I dereferencing +C<$arrayref[0]> or C<$hashref{"KEY"}> there. The dereference of the +scalar variable happens I it does any key lookups. Anything more +complicated than a simple scalar variable must use methods 2 or 3 below. +However, a "simple scalar" includes an identifier that itself uses method +1 recursively. Therefore, the following prints "howdy". + + $refrefref = \\\"howdy"; + print $$$$refrefref; + +=item 2. + +Anywhere you'd put an identifier (or chain of identifiers) as part of a +variable or subroutine name, you can replace the identifier with a +BLOCK returning a reference of the correct type. In other words, the +previous examples could be written like this: + + $bar = ${$scalarref}; + push(@{$arrayref}, $filename); + ${$arrayref}[0] = "January"; + ${$hashref}{"KEY"} = "VALUE"; + &{$coderef}(1,2,3); + $globref->print("output\n"); # iff IO::Handle is loaded + +Admittedly, it's a little silly to use the curlies in this case, but +the BLOCK can contain any arbitrary expression, in particular, +subscripted expressions: + + &{ $dispatch{$index} }(1,2,3); # call correct routine + +Because of being able to omit the curlies for the simple case of C<$$x>, +people often make the mistake of viewing the dereferencing symbols as +proper operators, and wonder about their precedence. If they were, +though, you could use parentheses instead of braces. That's not the case. +Consider the difference below; case 0 is a short-hand version of case 1, +I case 2: + + $$hashref{"KEY"} = "VALUE"; # CASE 0 + ${$hashref}{"KEY"} = "VALUE"; # CASE 1 + ${$hashref{"KEY"}} = "VALUE"; # CASE 2 + ${$hashref->{"KEY"}} = "VALUE"; # CASE 3 + +Case 2 is also deceptive in that you're accessing a variable +called %hashref, not dereferencing through $hashref to the hash +it's presumably referencing. That would be case 3. + +=item 3. + +Subroutine calls and lookups of individual array elements arise often +enough that it gets cumbersome to use method 2. As a form of +syntactic sugar, the examples for method 2 may be written: + + $arrayref->[0] = "January"; # Array element + $hashref->{"KEY"} = "VALUE"; # Hash element + $coderef->(1,2,3); # Subroutine call + +The left side of the arrow can be any expression returning a reference, +including a previous dereference. Note that C<$array[$x]> is I the +same thing as C<$array-E[$x]> here: + + $array[$x]->{"foo"}->[0] = "January"; + +This is one of the cases we mentioned earlier in which references could +spring into existence when in an lvalue context. Before this +statement, C<$array[$x]> may have been undefined. If so, it's +automatically defined with a hash reference so that we can look up +C<{"foo"}> in it. Likewise C<$array[$x]-E{"foo"}> will automatically get +defined with an array reference so that we can look up C<[0]> in it. +This process is called I. + +One more thing here. The arrow is optional I brackets +subscripts, so you can shrink the above down to + + $array[$x]{"foo"}[0] = "January"; + +Which, in the degenerate case of using only ordinary arrays, gives you +multidimensional arrays just like C's: + + $score[$x][$y][$z] += 42; + +Well, okay, not entirely like C's arrays, actually. C doesn't know how +to grow its arrays on demand. Perl does. + +=item 4. + +If a reference happens to be a reference to an object, then there are +probably methods to access the things referred to, and you should probably +stick to those methods unless you're in the class package that defines the +object's methods. In other words, be nice, and don't violate the object's +encapsulation without a very good reason. Perl does not enforce +encapsulation. We are not totalitarians here. We do expect some basic +civility though. + +=back + +The ref() operator may be used to determine what type of thing the +reference is pointing to. See L. + +The bless() operator may be used to associate the object a reference +points to with a package functioning as an object class. See L. + +A typeglob may be dereferenced the same way a reference can, because +the dereference syntax always indicates the kind of reference desired. +So C<${*foo}> and C<${\$foo}> both indicate the same scalar variable. + +Here's a trick for interpolating a subroutine call into a string: + + print "My sub returned @{[mysub(1,2,3)]} that time.\n"; + +The way it works is that when the C<@{...}> is seen in the double-quoted +string, it's evaluated as a block. The block creates a reference to an +anonymous array containing the results of the call to C. So +the whole block returns a reference to an array, which is then +dereferenced by C<@{...}> and stuck into the double-quoted string. This +chicanery is also useful for arbitrary expressions: + + print "That yields @{[$n + 5]} widgets\n"; + +=head2 Symbolic references + +We said that references spring into existence as necessary if they are +undefined, but we didn't say what happens if a value used as a +reference is already defined, but I a hard reference. If you +use it as a reference in this case, it'll be treated as a symbolic +reference. That is, the value of the scalar is taken to be the I +of a variable, rather than a direct link to a (possibly) anonymous +value. + +People frequently expect it to work like this. So it does. + + $name = "foo"; + $$name = 1; # Sets $foo + ${$name} = 2; # Sets $foo + ${$name x 2} = 3; # Sets $foofoo + $name->[0] = 4; # Sets $foo[0] + @$name = (); # Clears @foo + &$name(); # Calls &foo() (as in Perl 4) + $pack = "THAT"; + ${"${pack}::$name"} = 5; # Sets $THAT::foo without eval + +This is very powerful, and slightly dangerous, in that it's possible +to intend (with the utmost sincerity) to use a hard reference, and +accidentally use a symbolic reference instead. To protect against +that, you can say + + use strict 'refs'; + +and then only hard references will be allowed for the rest of the enclosing +block. An inner block may countermand that with + + no strict 'refs'; + +Only package variables (globals, even if localized) are visible to +symbolic references. Lexical variables (declared with my()) aren't in +a symbol table, and thus are invisible to this mechanism. For example: + + local $value = 10; + $ref = \$value; + { + my $value = 20; + print $$ref; + } + +This will still print 10, not 20. Remember that local() affects package +variables, which are all "global" to the package. + +=head2 Not-so-symbolic references + +A new feature contributing to readability in perl version 5.001 is that the +brackets around a symbolic reference behave more like quotes, just as they +always have within a string. That is, + + $push = "pop on "; + print "${push}over"; + +has always meant to print "pop on over", despite the fact that push is +a reserved word. This has been generalized to work the same outside +of quotes, so that + + print ${push} . "over"; + +and even + + print ${ push } . "over"; + +will have the same effect. (This would have been a syntax error in +Perl 5.000, though Perl 4 allowed it in the spaceless form.) Note that this +construct is I considered to be a symbolic reference when you're +using strict refs: + + use strict 'refs'; + ${ bareword }; # Okay, means $bareword. + ${ "bareword" }; # Error, symbolic reference. + +Similarly, because of all the subscripting that is done using single +words, we've applied the same rule to any bareword that is used for +subscripting a hash. So now, instead of writing + + $array{ "aaa" }{ "bbb" }{ "ccc" } + +you can write just + + $array{ aaa }{ bbb }{ ccc } + +and not worry about whether the subscripts are reserved words. In the +rare event that you do wish to do something like + + $array{ shift } + +you can force interpretation as a reserved word by adding anything that +makes it more than a bareword: + + $array{ shift() } + $array{ +shift } + $array{ shift @_ } + +The B<-w> switch will warn you if it interprets a reserved word as a string. +But it will no longer warn you about using lowercase words, because the +string is effectively quoted. + +=head2 Pseudo-hashes: Using an array as a hash + +WARNING: This section describes an experimental feature. Details may +change without notice in future versions. + +Beginning with release 5.005 of Perl you can use an array reference +in some contexts that would normally require a hash reference. This +allows you to access array elements using symbolic names, as if they +were fields in a structure. + +For this to work, the array must contain extra information. The first +element of the array has to be a hash reference that maps field names +to array indices. Here is an example: + + $struct = [{foo => 1, bar => 2}, "FOO", "BAR"]; + + $struct->{foo}; # same as $struct->[1], i.e. "FOO" + $struct->{bar}; # same as $struct->[2], i.e. "BAR" + + keys %$struct; # will return ("foo", "bar") in some order + values %$struct; # will return ("FOO", "BAR") in same some order + + while (my($k,$v) = each %$struct) { + print "$k => $v\n"; + } + +Perl will raise an exception if you try to delete keys from a pseudo-hash +or try to access nonexistent fields. For better performance, Perl can also +do the translation from field names to array indices at compile time for +typed object references. See L. + + +=head2 Function Templates + +As explained above, a closure is an anonymous function with access to the +lexical variables visible when that function was compiled. It retains +access to those variables even though it doesn't get run until later, +such as in a signal handler or a Tk callback. + +Using a closure as a function template allows us to generate many functions +that act similarly. Suppopose you wanted functions named after the colors +that generated HTML font changes for the various colors: + + print "Be ", red("careful"), "with that ", green("light"); + +The red() and green() functions would be very similar. To create these, +we'll assign a closure to a typeglob of the name of the function we're +trying to build. + + @colors = qw(red blue green yellow orange purple violet); + for my $name (@colors) { + no strict 'refs'; # allow symbol table manipulation + *$name = *{uc $name} = sub { "@_" }; + } + +Now all those different functions appear to exist independently. You can +call red(), RED(), blue(), BLUE(), green(), etc. This technique saves on +both compile time and memory use, and is less error-prone as well, since +syntax checks happen at compile time. It's critical that any variables in +the anonymous subroutine be lexicals in order to create a proper closure. +That's the reasons for the C on the loop iteration variable. + +This is one of the only places where giving a prototype to a closure makes +much sense. If you wanted to impose scalar context on the arguments of +these functions (probably not a wise idea for this particular example), +you could have written it this way instead: + + *$name = sub ($) { "$_[0]" }; + +However, since prototype checking happens at compile time, the assignment +above happens too late to be of much use. You could address this by +putting the whole loop of assignments within a BEGIN block, forcing it +to occur during compilation. + +Access to lexicals that change over type--like those in the C loop +above--only works with closures, not general subroutines. In the general +case, then, named subroutines do not nest properly, although anonymous +ones do. If you are accustomed to using nested subroutines in other +programming languages with their own private variables, you'll have to +work at it a bit in Perl. The intuitive coding of this kind of thing +incurs mysterious warnings about ``will not stay shared''. For example, +this won't work: + + sub outer { + my $x = $_[0] + 35; + sub inner { return $x * 19 } # WRONG + return $x + inner(); + } + +A work-around is the following: + + sub outer { + my $x = $_[0] + 35; + local *inner = sub { return $x * 19 }; + return $x + inner(); + } + +Now inner() can only be called from within outer(), because of the +temporary assignments of the closure (anonymous subroutine). But when +it does, it has normal access to the lexical variable $x from the scope +of outer(). + +This has the interesting effect of creating a function local to another +function, something not normally supported in Perl. + +=head1 WARNING + +You may not (usefully) use a reference as the key to a hash. It will be +converted into a string: + + $x{ \$a } = $a; + +If you try to dereference the key, it won't do a hard dereference, and +you won't accomplish what you're attempting. You might want to do something +more like + + $r = \@a; + $x{ $r } = $r; + +And then at least you can use the values(), which will be +real refs, instead of the keys(), which won't. + +The standard Tie::RefHash module provides a convenient workaround to this. + +=head1 SEE ALSO + +Besides the obvious documents, source code can be instructive. +Some rather pathological examples of the use of references can be found +in the F regression test in the Perl source directory. + +See also L and L for how to use references to create +complex data structures, and L, L, and L +for how to use them to create objects. diff --git a/contrib/perl5/pod/perlrun.pod b/contrib/perl5/pod/perlrun.pod new file mode 100644 index 00000000000..a0c85b917b3 --- /dev/null +++ b/contrib/perl5/pod/perlrun.pod @@ -0,0 +1,731 @@ +=head1 NAME + +perlrun - how to execute the Perl interpreter + +=head1 SYNOPSIS + +B S<[ B<-sTuU> ]> + S<[ B<-hv> ] [ B<-V>[:I] ]> + S<[ B<-cw> ] [ B<-d>[:I] ] [ B<-D>[I] ]> + S<[ B<-pna> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> + S<[ B<-I>I ] [ B<-m>[B<->]I ] [ B<-M>[B<->]I<'module...'> ]> + S<[ B<-P> ]> + S<[ B<-S> ]> + S<[ B<-x>[I] ]> + S<[ B<-i>[I] ]> + S<[ B<-e> I<'command'> ] [ B<--> ] [ I ] [ I ]...> + +=head1 DESCRIPTION + +Upon startup, Perl looks for your script in one of the following +places: + +=over 4 + +=item 1. + +Specified line by line via B<-e> switches on the command line. + +=item 2. + +Contained in the file specified by the first filename on the command line. +(Note that systems supporting the #! notation invoke interpreters this +way. See L.) + +=item 3. + +Passed in implicitly via standard input. This works only if there are +no filename arguments--to pass arguments to a STDIN script you +must explicitly specify a "-" for the script name. + +=back + +With methods 2 and 3, Perl starts parsing the input file from the +beginning, unless you've specified a B<-x> switch, in which case it +scans for the first line starting with #! and containing the word +"perl", and starts there instead. This is useful for running a script +embedded in a larger message. (In this case you would indicate the end +of the script using the C<__END__> token.) + +The #! line is always examined for switches as the line is being +parsed. Thus, if you're on a machine that allows only one argument +with the #! line, or worse, doesn't even recognize the #! line, you +still can get consistent switch behavior regardless of how Perl was +invoked, even if B<-x> was used to find the beginning of the script. + +Because many operating systems silently chop off kernel interpretation of +the #! line after 32 characters, some switches may be passed in on the +command line, and some may not; you could even get a "-" without its +letter, if you're not careful. You probably want to make sure that all +your switches fall either before or after that 32 character boundary. +Most switches don't actually care if they're processed redundantly, but +getting a - instead of a complete switch could cause Perl to try to +execute standard input instead of your script. And a partial B<-I> switch +could also cause odd results. + +Some switches do care if they are processed twice, for instance combinations +of B<-l> and B<-0>. Either put all the switches after the 32 character +boundary (if applicable), or replace the use of B<-0>I by +C. + +Parsing of the #! switches starts wherever "perl" is mentioned in the line. +The sequences "-*" and "- " are specifically ignored so that you could, +if you were so inclined, say + + #!/bin/sh -- # -*- perl -*- -p + eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' + if $running_under_some_shell; + +to let Perl see the B<-p> switch. + +If the #! line does not contain the word "perl", the program named after +the #! is executed instead of the Perl interpreter. This is slightly +bizarre, but it helps people on machines that don't do #!, because they +can tell a program that their SHELL is /usr/bin/perl, and Perl will then +dispatch the program to the correct interpreter for them. + +After locating your script, Perl compiles the entire script to an +internal form. If there are any compilation errors, execution of the +script is not attempted. (This is unlike the typical shell script, +which might run part-way through before finding a syntax error.) + +If the script is syntactically correct, it is executed. If the script +runs off the end without hitting an exit() or die() operator, an implicit +C is provided to indicate successful completion. + +=head2 #! and quoting on non-Unix systems + +Unix's #! technique can be simulated on other systems: + +=over 4 + +=item OS/2 + +Put + + extproc perl -S -your_switches + +as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's +`extproc' handling). + +=item MS-DOS + +Create a batch file to run your script, and codify it in +C (see the F file in the source +distribution for more information). + +=item Win95/NT + +The Win95/NT installation, when using the Activeware port of Perl, +will modify the Registry to associate the F<.pl> extension with the perl +interpreter. If you install another port of Perl, including the one +in the Win32 directory of the Perl distribution, then you'll have to +modify the Registry yourself. Note that this means you can no +longer tell the difference between an executable Perl program +and a Perl library file. + +=item Macintosh + +Macintosh perl scripts will have the appropriate Creator and +Type, so that double-clicking them will invoke the perl application. + +=back + +Command-interpreters on non-Unix systems have rather different ideas +on quoting than Unix shells. You'll need to learn the special +characters in your command-interpreter (C<*>, C<\> and C<"> are +common) and how to protect whitespace and these characters to run +one-liners (see C<-e> below). + +On some systems, you may have to change single-quotes to double ones, +which you must I do on Unix or Plan9 systems. You might also +have to change a single % to a %%. + +For example: + + # Unix + perl -e 'print "Hello world\n"' + + # MS-DOS, etc. + perl -e "print \"Hello world\n\"" + + # Macintosh + print "Hello world\n" + (then Run "Myscript" or Shift-Command-R) + + # VMS + perl -e "print ""Hello world\n""" + +The problem is that none of this is reliable: it depends on the command +and it is entirely possible neither works. If 4DOS was the command shell, this would +probably work better: + + perl -e "print "Hello world\n"" + +CMD.EXE in Windows NT slipped a lot of standard Unix functionality in +when nobody was looking, but just try to find documentation for its +quoting rules. + +Under the Macintosh, it depends which environment you are using. The MacPerl +shell, or MPW, is much like Unix shells in its support for several +quoting variants, except that it makes free use of the Macintosh's non-ASCII +characters as control characters. + +There is no general solution to all of this. It's just a mess. + +=head2 Location of Perl + +It may seem obvious to say, but Perl is useful only when users can +easily find it. When possible, it's good for both B and +B to be symlinks to the actual binary. If that +can't be done, system administrators are strongly encouraged to put +(symlinks to) perl and its accompanying utilities, such as perldoc, into +a directory typically found along a user's PATH, or in another obvious +and convenient place. + +In this documentation, C<#!/usr/bin/perl> on the first line of the script +will stand in for whatever method works on your system. + +=head2 Switches + +A single-character switch may be combined with the following switch, if +any. + + #!/usr/bin/perl -spi.bak # same as -s -p -i.bak + +Switches include: + +=over 5 + +=item B<-0>[I] + +specifies the input record separator (C<$/>) as an octal number. If there are +no digits, the null character is the separator. Other switches may +precede or follow the digits. For example, if you have a version of +B which can print filenames terminated by the null character, you +can say this: + + find . -name '*.bak' -print0 | perl -n0e unlink + +The special value 00 will cause Perl to slurp files in paragraph mode. +The value 0777 will cause Perl to slurp files whole because there is no +legal character with that value. + +=item B<-a> + +turns on autosplit mode when used with a B<-n> or B<-p>. An implicit +split command to the @F array is done as the first thing inside the +implicit while loop produced by the B<-n> or B<-p>. + + perl -ane 'print pop(@F), "\n";' + +is equivalent to + + while (<>) { + @F = split(' '); + print pop(@F), "\n"; + } + +An alternate delimiter may be specified using B<-F>. + +=item B<-c> + +causes Perl to check the syntax of the script and then exit without +executing it. Actually, it I execute C, C, and C blocks, +because these are considered as occurring outside the execution of +your program. + +=item B<-d> + +runs the script under the Perl debugger. See L. + +=item B<-d:>I + +runs the script under the control of a debugging or tracing module +installed as Devel::foo. E.g., B<-d:DProf> executes the script using the +Devel::DProf profiler. See L. + +=item B<-D>I + +=item B<-D>I + +sets debugging flags. To watch how it executes your script, use +B<-Dtls>. (This works only if debugging is compiled into your +Perl.) Another nice value is B<-Dx>, which lists your compiled +syntax tree. And B<-Dr> displays compiled regular expressions. As an +alternative, specify a number instead of list of letters (e.g., B<-D14> is +equivalent to B<-Dtls>): + + 1 p Tokenizing and parsing + 2 s Stack snapshots + 4 l Context (loop) stack processing + 8 t Trace execution + 16 o Method and overloading resolution + 32 c String/numeric conversions + 64 P Print preprocessor command for -P + 128 m Memory allocation + 256 f Format processing + 512 r Regular expression parsing and execution + 1024 x Syntax tree dump + 2048 u Tainting checks + 4096 L Memory leaks (needs C<-DLEAKTEST> when compiling Perl) + 8192 H Hash dump -- usurps values() + 16384 X Scratchpad allocation + 32768 D Cleaning up + 65536 S Thread synchronization + +All these flags require C<-DDEBUGGING> when you compile the Perl +executable. This flag is automatically set if you include C<-g> +option when C asks you about optimizer/debugger flags. + +=item B<-e> I + +may be used to enter one line of script. +If B<-e> is given, Perl +will not look for a script filename in the argument list. +Multiple B<-e> commands may +be given to build up a multi-line script. +Make sure to use semicolons where you would in a normal program. + +=item B<-F>I + +specifies the pattern to split on if B<-a> is also in effect. The +pattern may be surrounded by C, C<"">, or C<''>, otherwise it will be +put in single quotes. + +=item B<-h> + +prints a summary of the options. + +=item B<-i>[I] + +specifies that files processed by the CE> construct are to be +edited in-place. It does this by renaming the input file, opening the +output file by the original name, and selecting that output file as the +default for print() statements. The extension, if supplied, is used to +modify the name of the old file to make a backup copy, following these +rules: + +If no extension is supplied, no backup is made and the current file is +overwritten. + +If the extension doesn't contain a C<*> then it is appended to the end +of the current filename as a suffix. + +If the extension does contain one or more C<*> characters, then each C<*> +is replaced with the current filename. In perl terms you could think of +this as: + + ($backup = $extension) =~ s/\*/$file_name/g; + +This allows you to add a prefix to the backup file, instead of (or in +addition to) a suffix: + + $ perl -pi'bak_*' -e 's/bar/baz/' fileA # backup to 'bak_fileA' + +Or even to place backup copies of the original files into another +directory (provided the directory already exists): + + $ perl -pi'old/*.bak' -e 's/bar/baz/' fileA # backup to 'old/fileA.bak' + +These sets of one-liners are equivalent: + + $ perl -pi -e 's/bar/baz/' fileA # overwrite current file + $ perl -pi'*' -e 's/bar/baz/' fileA # overwrite current file + + $ perl -pi'.bak' -e 's/bar/baz/' fileA # backup to 'fileA.bak' + $ perl -pi'*.bak' -e 's/bar/baz/' fileA # backup to 'fileA.bak' + +From the shell, saying + + $ perl -p -i.bak -e "s/foo/bar/; ... " + +is the same as using the script: + + #!/usr/bin/perl -pi.bak + s/foo/bar/; + +which is equivalent to + + #!/usr/bin/perl + $extension = '.bak'; + while (<>) { + if ($ARGV ne $oldargv) { + if ($extension !~ /\*/) { + $backup = $ARGV . $extension; + } + else { + ($backup = $extension) =~ s/\*/$ARGV/g; + } + rename($ARGV, $backup); + open(ARGVOUT, ">$ARGV"); + select(ARGVOUT); + $oldargv = $ARGV; + } + s/foo/bar/; + } + continue { + print; # this prints to original filename + } + select(STDOUT); + +except that the B<-i> form doesn't need to compare $ARGV to $oldargv to +know when the filename has changed. It does, however, use ARGVOUT for +the selected filehandle. Note that STDOUT is restored as the default +output filehandle after the loop. + +As shown above, Perl creates the backup file whether or not any output +is actually changed. So this is just a fancy way to copy files: + + $ perl -p -i'/some/file/path/*' -e 1 file1 file2 file3... + or + $ perl -p -i'.bak' -e 1 file1 file2 file3... + +You can use C without parentheses to locate the end of each input +file, in case you want to append to each file, or reset line numbering +(see example in L). + +If, for a given file, Perl is unable to create the backup file as +specified in the extension then it will skip that file and continue on +with the next one (if it exists). + +For a discussion of issues surrounding file permissions and C<-i>, see +L. + +You cannot use B<-i> to create directories or to strip extensions from +files. + +Perl does not expand C<~>, so don't do that. + +Finally, note that the B<-i> switch does not impede execution when no +files are given on the command line. In this case, no backup is made +(the original file cannot, of course, be determined) and processing +proceeds from STDIN to STDOUT as might be expected. + +=item B<-I>I + +Directories specified by B<-I> are prepended to the search path for +modules (C<@INC>), and also tells the C preprocessor where to search for +include files. The C preprocessor is invoked with B<-P>; by default it +searches /usr/include and /usr/lib/perl. + +=item B<-l>[I] + +enables automatic line-ending processing. It has two effects: first, +it automatically chomps "C<$/>" (the input record separator) when used +with B<-n> or B<-p>, and second, it assigns "C<$\>" +(the output record separator) to have the value of I so that +any print statements will have that separator added back on. If +I is omitted, sets "C<$\>" to the current value of "C<$/>". For +instance, to trim lines to 80 columns: + + perl -lpe 'substr($_, 80) = ""' + +Note that the assignment C<$\ = $/> is done when the switch is processed, +so the input record separator can be different than the output record +separator if the B<-l> switch is followed by a B<-0> switch: + + gnufind / -print0 | perl -ln0e 'print "found $_" if -p' + +This sets C<$\> to newline and then sets C<$/> to the null character. + +=item B<-m>[B<->]I + +=item B<-M>[B<->]I + +=item B<-M>[B<->]I<'module ...'> + +=item B<-[mM]>[B<->]I + +C<-m>I executes C I C<();> before executing your +script. + +C<-M>I executes C I C<;> before executing your +script. You can use quotes to add extra code after the module name, +e.g., C<-M'module qw(foo bar)'>. + +If the first character after the C<-M> or C<-m> is a dash (C<->) +then the 'use' is replaced with 'no'. + +A little builtin syntactic sugar means you can also say +C<-mmodule=foo,bar> or C<-Mmodule=foo,bar> as a shortcut for +C<-M'module qw(foo bar)'>. This avoids the need to use quotes when +importing symbols. The actual code generated by C<-Mmodule=foo,bar> is +C. Note that the C<=> form +removes the distinction between C<-m> and C<-M>. + +=item B<-n> + +causes Perl to assume the following loop around your script, which +makes it iterate over filename arguments somewhat like B or +B: + + while (<>) { + ... # your script goes here + } + +Note that the lines are not printed by default. See B<-p> to have +lines printed. If a file named by an argument cannot be opened for +some reason, Perl warns you about it, and moves on to the next file. + +Here is an efficient way to delete all files older than a week: + + find . -mtime +7 -print | perl -nle 'unlink;' + +This is faster than using the C<-exec> switch of B because you don't +have to start a process on every filename found. + +C and C blocks may be used to capture control before or after +the implicit loop, just as in B. + +=item B<-p> + +causes Perl to assume the following loop around your script, which +makes it iterate over filename arguments somewhat like B: + + + while (<>) { + ... # your script goes here + } continue { + print or die "-p destination: $!\n"; + } + +If a file named by an argument cannot be opened for some reason, Perl +warns you about it, and moves on to the next file. Note that the +lines are printed automatically. An error occuring during printing is +treated as fatal. To suppress printing use the B<-n> switch. A B<-p> +overrides a B<-n> switch. + +C and C blocks may be used to capture control before or after +the implicit loop, just as in awk. + +=item B<-P> + +causes your script to be run through the C preprocessor before +compilation by Perl. (Because both comments and cpp directives begin +with the # character, you should avoid starting comments with any words +recognized by the C preprocessor such as "if", "else", or "define".) + +=item B<-s> + +enables some rudimentary switch parsing for switches on the command +line after the script name but before any filename arguments (or before +a B<-->). Any switch found there is removed from @ARGV and sets the +corresponding variable in the Perl script. The following script +prints "true" if and only if the script is invoked with a B<-xyz> switch. + + #!/usr/bin/perl -s + if ($xyz) { print "true\n"; } + +=item B<-S> + +makes Perl use the PATH environment variable to search for the +script (unless the name of the script contains directory separators). +On some platforms, this also makes Perl append suffixes to the +filename while searching for it. For example, on Win32 platforms, +the ".bat" and ".cmd" suffixes are appended if a lookup for the +original name fails, and if the name does not already end in one +of those suffixes. If your Perl was compiled with DEBUGGING turned +on, using the -Dp switch to Perl shows how the search progresses. + +If the filename supplied contains directory separators (i.e. it is an +absolute or relative pathname), and if the file is not found, +platforms that append file extensions will do so and try to look +for the file with those extensions added, one by one. + +On DOS-like platforms, if the script does not contain directory +separators, it will first be searched for in the current directory +before being searched for on the PATH. On Unix platforms, the +script will be searched for strictly on the PATH. + +Typically this is used to emulate #! startup on platforms that +don't support #!. This example works on many platforms that +have a shell compatible with Bourne shell: + + #!/usr/bin/perl + eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' + if $running_under_some_shell; + +The system ignores the first line and feeds the script to /bin/sh, +which proceeds to try to execute the Perl script as a shell script. +The shell executes the second line as a normal shell command, and thus +starts up the Perl interpreter. On some systems $0 doesn't always +contain the full pathname, so the B<-S> tells Perl to search for the +script if necessary. After Perl locates the script, it parses the +lines and ignores them because the variable $running_under_some_shell +is never true. If the script will be interpreted by csh, you will need +to replace C<${1+"$@"}> with C<$*>, even though that doesn't understand +embedded spaces (and such) in the argument list. To start up sh rather +than csh, some systems may have to replace the #! line with a line +containing just a colon, which will be politely ignored by Perl. Other +systems can't control that, and need a totally devious construct that +will work under any of csh, sh, or Perl, such as the following: + + eval '(exit $?0)' && eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}' + & eval 'exec /usr/bin/perl -wS $0 $argv:q' + if $running_under_some_shell; + +=item B<-T> + +forces "taint" checks to be turned on so you can test them. Ordinarily +these checks are done only when running setuid or setgid. It's a good +idea to turn them on explicitly for programs run on another's behalf, +such as CGI programs. See L. Note that (for security reasons) +this option must be seen by Perl quite early; usually this means it must +appear early on the command line or in the #! line (for systems which +support that). + +=item B<-u> + +causes Perl to dump core after compiling your script. You can then +in theory take this core dump and turn it into an executable file by using the +B program (not supplied). This speeds startup at the expense of +some disk space (which you can minimize by stripping the executable). +(Still, a "hello world" executable comes out to about 200K on my +machine.) If you want to execute a portion of your script before dumping, +use the dump() operator instead. Note: availability of B is +platform specific and may not be available for a specific port of +Perl. It has been superseded by the new perl-to-C compiler, which is more +portable, even though it's still only considered beta. + +=item B<-U> + +allows Perl to do unsafe operations. Currently the only "unsafe" +operations are the unlinking of directories while running as superuser, +and running setuid programs with fatal taint checks turned into +warnings. Note that the B<-w> switch (or the C<$^W> variable) must +be used along with this option to actually B the +taint-check warnings. + +=item B<-v> + +prints the version and patchlevel of your Perl executable. + +=item B<-V> + +prints summary of the major perl configuration values and the current +value of @INC. + +=item B<-V:>I + +Prints to STDOUT the value of the named configuration variable. + +=item B<-w> + +prints warnings about variable names that are mentioned only once, and +scalar variables that are used before being set. Also warns about +redefined subroutines, and references to undefined filehandles or +filehandles opened read-only that you are attempting to write on. Also +warns you if you use values as a number that doesn't look like numbers, +using an array as though it were a scalar, if your subroutines recurse +more than 100 deep, and innumerable other things. + +You can disable specific warnings using C<__WARN__> hooks, as described +in L and L. See also L and L. + +=item B<-x> I + +tells Perl that the script is embedded in a message. Leading +garbage will be discarded until the first line that starts with #! and +contains the string "perl". Any meaningful switches on that line will +be applied. If a directory name is specified, Perl will switch to +that directory before running the script. The B<-x> switch controls +only the disposal of leading garbage. The script must be +terminated with C<__END__> if there is trailing garbage to be ignored (the +script can process any or all of the trailing garbage via the DATA +filehandle if desired). + +=back + +=head1 ENVIRONMENT + +=over 12 + +=item HOME + +Used if chdir has no argument. + +=item LOGDIR + +Used if chdir has no argument and HOME is not set. + +=item PATH + +Used in executing subprocesses, and in finding the script if B<-S> is +used. + +=item PERL5LIB + +A colon-separated list of directories in which to look for Perl library +files before looking in the standard library and the current +directory. If PERL5LIB is not defined, PERLLIB is used. When running +taint checks (because the script was running setuid or setgid, or the +B<-T> switch was used), neither variable is used. The script should +instead say + + use lib "/my/directory"; + +=item PERL5OPT + +Command-line options (switches). Switches in this variable are taken +as if they were on every Perl command line. Only the B<-[DIMUdmw]> +switches are allowed. When running taint checks (because the script +was running setuid or setgid, or the B<-T> switch was used), this +variable is ignored. + +=item PERLLIB + +A colon-separated list of directories in which to look for Perl library +files before looking in the standard library and the current directory. +If PERL5LIB is defined, PERLLIB is not used. + +=item PERL5DB + +The command used to load the debugger code. The default is: + + BEGIN { require 'perl5db.pl' } + +=item PERL5SHELL (specific to WIN32 port) + +May be set to an alternative shell that perl must use internally for +executing "backtick" commands or system(). Default is C +on WindowsNT and C on Windows95. The value is considered +to be space delimited. Precede any character that needs to be protected +(like a space or backslash) with a backslash. + +Note that Perl doesn't use COMSPEC for this purpose because +COMSPEC has a high degree of variability among users, leading to +portability concerns. Besides, perl can use a shell that may not be +fit for interactive use, and setting COMSPEC to such a shell may +interfere with the proper functioning of other programs (which usually +look in COMSPEC to find a shell fit for interactive use). + +=item PERL_DEBUG_MSTATS + +Relevant only if perl is compiled with the malloc included with the perl +distribution (that is, if C is 'define'). +If set, this causes memory statistics to be dumped after execution. If set +to an integer greater than one, also causes memory statistics to be dumped +after compilation. + +=item PERL_DESTRUCT_LEVEL + +Relevant only if your perl executable was built with B<-DDEBUGGING>, +this controls the behavior of global destruction of objects and other +references. + +=back + +Perl also has environment variables that control how Perl handles data +specific to particular natural languages. See L. + +Apart from these, Perl uses no other environment variables, except +to make them available to the script being executed, and to child +processes. However, scripts running setuid would do well to execute +the following lines before doing anything else, just to keep people +honest: + + $ENV{PATH} = '/bin:/usr/bin'; # or whatever you need + $ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL}; + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; + diff --git a/contrib/perl5/pod/perlsec.pod b/contrib/perl5/pod/perlsec.pod new file mode 100644 index 00000000000..0b22acd9cda --- /dev/null +++ b/contrib/perl5/pod/perlsec.pod @@ -0,0 +1,351 @@ +=head1 NAME + +perlsec - Perl security + +=head1 DESCRIPTION + +Perl is designed to make it easy to program securely even when running +with extra privileges, like setuid or setgid programs. Unlike most +command line shells, which are based on multiple substitution passes on +each line of the script, Perl uses a more conventional evaluation scheme +with fewer hidden snags. Additionally, because the language has more +builtin functionality, it can rely less upon external (and possibly +untrustworthy) programs to accomplish its purposes. + +Perl automatically enables a set of special security checks, called I, when it detects its program running with differing real and effective +user or group IDs. The setuid bit in Unix permissions is mode 04000, the +setgid bit mode 02000; either or both may be set. You can also enable taint +mode explicitly by using the B<-T> command line flag. This flag is +I suggested for server programs and any program run on behalf of +someone else, such as a CGI script. Once taint mode is on, it's on for +the remainder of your script. + +While in this mode, Perl takes special precautions called I to prevent both obvious and subtle traps. Some of these checks +are reasonably simple, such as verifying that path directories aren't +writable by others; careful programmers have always used checks like +these. Other checks, however, are best supported by the language itself, +and it is these checks especially that contribute to making a set-id Perl +program more secure than the corresponding C program. + +You may not use data derived from outside your program to affect +something else outside your program--at least, not by accident. All +command line arguments, environment variables, locale information (see +L), results of certain system calls (readdir, readlink, +the gecos field of getpw* calls), and all file input are marked as +"tainted". Tainted data may not be used directly or indirectly in any +command that invokes a sub-shell, nor in any command that modifies +files, directories, or processes. (B: If you pass +a list of arguments to either C or C, the elements of +that list are B checked for taintedness.) Any variable set +to a value derived from tainted data will itself be tainted, +even if it is logically impossible for the tainted data +to alter the variable. Because taintedness is associated with each +scalar value, some elements of an array can be tainted and others not. + +For example: + + $arg = shift; # $arg is tainted + $hid = $arg, 'bar'; # $hid is also tainted + $line = <>; # Tainted + $line = ; # Also tainted + open FOO, "/home/me/bar" or die $!; + $line = ; # Still tainted + $path = $ENV{'PATH'}; # Tainted, but see below + $data = 'abc'; # Not tainted + + system "echo $arg"; # Insecure + system "/bin/echo", $arg; # Secure (doesn't use sh) + system "echo $hid"; # Insecure + system "echo $data"; # Insecure until PATH set + + $path = $ENV{'PATH'}; # $path now tainted + + $ENV{'PATH'} = '/bin:/usr/bin'; + delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; + + $path = $ENV{'PATH'}; # $path now NOT tainted + system "echo $data"; # Is secure now! + + open(FOO, "< $arg"); # OK - read-only file + open(FOO, "> $arg"); # Not OK - trying to write + + open(FOO,"echo $arg|"); # Not OK, but... + open(FOO,"-|") + or exec 'echo', $arg; # OK + + $shout = `echo $arg`; # Insecure, $shout now tainted + + unlink $data, $arg; # Insecure + umask $arg; # Insecure + + exec "echo $arg"; # Insecure + exec "echo", $arg; # Secure (doesn't use the shell) + exec "sh", '-c', $arg; # Considered secure, alas! + + @files = <*.c>; # Always insecure (uses csh) + @files = glob('*.c'); # Always insecure (uses csh) + +If you try to do something insecure, you will get a fatal error saying +something like "Insecure dependency" or "Insecure $ENV{PATH}". Note that you +can still write an insecure B or B, but only by explicitly +doing something like the "considered secure" example above. + +=head2 Laundering and Detecting Tainted Data + +To test whether a variable contains tainted data, and whose use would thus +trigger an "Insecure dependency" message, check your nearby CPAN mirror +for the F module, which should become available around November +1997. Or you may be able to use the following I function. + + sub is_tainted { + return ! eval { + join('',@_), kill 0; + 1; + }; + } + +This function makes use of the fact that the presence of tainted data +anywhere within an expression renders the entire expression tainted. It +would be inefficient for every operator to test every argument for +taintedness. Instead, the slightly more efficient and conservative +approach is used that if any tainted value has been accessed within the +same expression, the whole expression is considered tainted. + +But testing for taintedness gets you only so far. Sometimes you have just +to clear your data's taintedness. The only way to bypass the tainting +mechanism is by referencing subpatterns from a regular expression match. +Perl presumes that if you reference a substring using $1, $2, etc., that +you knew what you were doing when you wrote the pattern. That means using +a bit of thought--don't just blindly untaint anything, or you defeat the +entire mechanism. It's better to verify that the variable has only good +characters (for certain values of "good") rather than checking whether it +has any bad characters. That's because it's far too easy to miss bad +characters that you never thought of. + +Here's a test to make sure that the data contains nothing but "word" +characters (alphabetics, numerics, and underscores), a hyphen, an at sign, +or a dot. + + if ($data =~ /^([-\@\w.]+)$/) { + $data = $1; # $data now untainted + } else { + die "Bad data in $data"; # log this somewhere + } + +This is fairly secure because C doesn't normally match shell +metacharacters, nor are dot, dash, or at going to mean something special +to the shell. Use of C would have been insecure in theory because +it lets everything through, but Perl doesn't check for that. The lesson +is that when untainting, you must be exceedingly careful with your patterns. +Laundering data using regular expression is the I mechanism for +untainting dirty data, unless you use the strategy detailed below to fork +a child of lesser privilege. + +The example does not untaint $data if C is in effect, +because the characters matched by C<\w> are determined by the locale. +Perl considers that locale definitions are untrustworthy because they +contain data from outside the program. If you are writing a +locale-aware program, and want to launder data with a regular expression +containing C<\w>, put C ahead of the expression in the same +block. See L for further discussion and examples. + +=head2 Switches On the "#!" Line + +When you make a script executable, in order to make it usable as a +command, the system will pass switches to perl from the script's #! +line. Perl checks that any command line switches given to a setuid +(or setgid) script actually match the ones set on the #! line. Some +Unix and Unix-like environments impose a one-switch limit on the #! +line, so you may need to use something like C<-wU> instead of C<-w -U> +under such systems. (This issue should arise only in Unix or +Unix-like environments that support #! and setuid or setgid scripts.) + +=head2 Cleaning Up Your Path + +For "Insecure C<$ENV{PATH}>" messages, you need to set C<$ENV{'PATH'}> to a +known value, and each directory in the path must be non-writable by others +than its owner and group. You may be surprised to get this message even +if the pathname to your executable is fully qualified. This is I +generated because you didn't supply a full path to the program; instead, +it's generated because you never set your PATH environment variable, or +you didn't set it to something that was safe. Because Perl can't +guarantee that the executable in question isn't itself going to turn +around and execute some other program that is dependent on your PATH, it +makes sure you set the PATH. + +The PATH isn't the only environment variable which can cause problems. +Because some shells may use the variables IFS, CDPATH, ENV, and +BASH_ENV, Perl checks that those are either empty or untainted when +starting subprocesses. You may wish to add something like this to your +setid and taint-checking scripts. + + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer + +It's also possible to get into trouble with other operations that don't +care whether they use tainted values. Make judicious use of the file +tests in dealing with any user-supplied filenames. When possible, do +opens and such B properly dropping any special user (or group!) +privileges. Perl doesn't prevent you from opening tainted filenames for reading, +so be careful what you print out. The tainting mechanism is intended to +prevent stupid mistakes, not to remove the need for thought. + +Perl does not call the shell to expand wild cards when you pass B +and B explicit parameter lists instead of strings with possible shell +wildcards in them. Unfortunately, the B, B, and +backtick functions provide no such alternate calling convention, so more +subterfuge will be required. + +Perl provides a reasonably safe way to open a file or pipe from a setuid +or setgid program: just create a child process with reduced privilege who +does the dirty work for you. First, fork a child using the special +B syntax that connects the parent and child by a pipe. Now the +child resets its ID set and any other per-process attributes, like +environment variables, umasks, current working directories, back to the +originals or known safe values. Then the child process, which no longer +has any special permissions, does the B or other system call. +Finally, the child passes the data it managed to access back to the +parent. Because the file or pipe was opened in the child while running +under less privilege than the parent, it's not apt to be tricked into +doing something it shouldn't. + +Here's a way to do backticks reasonably safely. Notice how the B is +not called with a string that the shell could expand. This is by far the +best way to call something that might be subjected to shell escapes: just +never call the shell at all. + + use English; + die "Can't fork: $!" unless defined $pid = open(KID, "-|"); + if ($pid) { # parent + while () { + # do something + } + close KID; + } else { + my @temp = ($EUID, $EGID); + $EUID = $UID; + $EGID = $GID; # initgroups() also called! + # Make sure privs are really gone + ($EUID, $EGID) = @temp; + die "Can't drop privileges" + unless $UID == $EUID && $GID eq $EGID; + $ENV{PATH} = "/bin:/usr/bin"; + exec 'myprog', 'arg1', 'arg2' + or die "can't exec myprog: $!"; + } + +A similar strategy would work for wildcard expansion via C, although +you can use C instead. + +Taint checking is most useful when although you trust yourself not to have +written a program to give away the farm, you don't necessarily trust those +who end up using it not to try to trick it into doing something bad. This +is the kind of security checking that's useful for set-id programs and +programs launched on someone else's behalf, like CGI programs. + +This is quite different, however, from not even trusting the writer of the +code not to try to do something evil. That's the kind of trust needed +when someone hands you a program you've never seen before and says, "Here, +run this." For that kind of safety, check out the Safe module, +included standard in the Perl distribution. This module allows the +programmer to set up special compartments in which all system operations +are trapped and namespace access is carefully controlled. + +=head2 Security Bugs + +Beyond the obvious problems that stem from giving special privileges to +systems as flexible as scripts, on many versions of Unix, set-id scripts +are inherently insecure right from the start. The problem is a race +condition in the kernel. Between the time the kernel opens the file to +see which interpreter to run and when the (now-set-id) interpreter turns +around and reopens the file to interpret it, the file in question may have +changed, especially if you have symbolic links on your system. + +Fortunately, sometimes this kernel "feature" can be disabled. +Unfortunately, there are two ways to disable it. The system can simply +outlaw scripts with any set-id bit set, which doesn't help much. +Alternately, it can simply ignore the set-id bits on scripts. If the +latter is true, Perl can emulate the setuid and setgid mechanism when it +notices the otherwise useless setuid/gid bits on Perl scripts. It does +this via a special executable called B that is automatically +invoked for you if it's needed. + +However, if the kernel set-id script feature isn't disabled, Perl will +complain loudly that your set-id script is insecure. You'll need to +either disable the kernel set-id script feature, or put a C wrapper around +the script. A C wrapper is just a compiled program that does nothing +except call your Perl program. Compiled programs are not subject to the +kernel bug that plagues set-id scripts. Here's a simple wrapper, written +in C: + + #define REAL_PATH "/path/to/script" + main(ac, av) + char **av; + { + execv(REAL_PATH, av); + } + +Compile this wrapper into a binary executable and then make I rather +than your script setuid or setgid. + +See the program B in the F directory of your Perl +distribution for a convenient way to do this automatically for all your +setuid Perl programs. It moves setuid scripts into files with the same +name plus a leading dot, and then compiles a wrapper like the one above +for each of them. + +In recent years, vendors have begun to supply systems free of this +inherent security bug. On such systems, when the kernel passes the name +of the set-id script to open to the interpreter, rather than using a +pathname subject to meddling, it instead passes I. This is a +special file already opened on the script, so that there can be no race +condition for evil scripts to exploit. On these systems, Perl should be +compiled with C<-DSETUID_SCRIPTS_ARE_SECURE_NOW>. The B +program that builds Perl tries to figure this out for itself, so you +should never have to specify this yourself. Most modern releases of +SysVr4 and BSD 4.4 use this approach to avoid the kernel race condition. + +Prior to release 5.003 of Perl, a bug in the code of B could +introduce a security hole in systems compiled with strict POSIX +compliance. + +=head2 Protecting Your Programs + +There are a number of ways to hide the source to your Perl programs, +with varying levels of "security". + +First of all, however, you I take away read permission, because +the source code has to be readable in order to be compiled and +interpreted. (That doesn't mean that a CGI script's source is +readable by people on the web, though.) So you have to leave the +permissions at the socially friendly 0755 level. This lets +people on your local system only see your source. + +Some people mistakenly regard this as a security problem. If your program does +insecure things, and relies on people not knowing how to exploit those +insecurities, it is not secure. It is often possible for someone to +determine the insecure things and exploit them without viewing the +source. Security through obscurity, the name for hiding your bugs +instead of fixing them, is little security indeed. + +You can try using encryption via source filters (Filter::* from CPAN). +But crackers might be able to decrypt it. You can try using the +byte code compiler and interpreter described below, but crackers might +be able to de-compile it. You can try using the native-code compiler +described below, but crackers might be able to disassemble it. These +pose varying degrees of difficulty to people wanting to get at your +code, but none can definitively conceal it (this is true of every +language, not just Perl). + +If you're concerned about people profiting from your code, then the +bottom line is that nothing but a restrictive licence will give you +legal security. License your software and pepper it with threatening +statements like "This is unpublished proprietary software of XYZ Corp. +Your access to it does not give you permission to use it blah blah +blah." You should see a lawyer to be sure your licence's wording will +stand up in court. + +=head1 SEE ALSO + +L for its description of cleaning up environment variables. diff --git a/contrib/perl5/pod/perlstyle.pod b/contrib/perl5/pod/perlstyle.pod new file mode 100644 index 00000000000..cf280ce1da0 --- /dev/null +++ b/contrib/perl5/pod/perlstyle.pod @@ -0,0 +1,275 @@ +=head1 NAME + +perlstyle - Perl style guide + +=head1 DESCRIPTION + +Each programmer will, of course, have his or her own preferences in +regards to formatting, but there are some general guidelines that will +make your programs easier to read, understand, and maintain. + +The most important thing is to run your programs under the B<-w> +flag at all times. You may turn it off explicitly for particular +portions of code via the C<$^W> variable if you must. You should +also always run under C or know the reason why not. +The C and even C pragmas may also prove +useful. + +Regarding aesthetics of code lay out, about the only thing Larry +cares strongly about is that the closing curly brace of +a multi-line BLOCK should line up with the keyword that started the construct. +Beyond that, he has other preferences that aren't so strong: + +=over 4 + +=item * + +4-column indent. + +=item * + +Opening curly on same line as keyword, if possible, otherwise line up. + +=item * + +Space before the opening curly of a multi-line BLOCK. + +=item * + +One-line BLOCK may be put on one line, including curlies. + +=item * + +No space before the semicolon. + +=item * + +Semicolon omitted in "short" one-line BLOCK. + +=item * + +Space around most operators. + +=item * + +Space around a "complex" subscript (inside brackets). + +=item * + +Blank lines between chunks that do different things. + +=item * + +Uncuddled elses. + +=item * + +No space between function name and its opening parenthesis. + +=item * + +Space after each comma. + +=item * + +Long lines broken after an operator (except "and" and "or"). + +=item * + +Space after last parenthesis matching on current line. + +=item * + +Line up corresponding items vertically. + +=item * + +Omit redundant punctuation as long as clarity doesn't suffer. + +=back + +Larry has his reasons for each of these things, but he doesn't claim that +everyone else's mind works the same as his does. + +Here are some other more substantive style issues to think about: + +=over 4 + +=item * + +Just because you I do something a particular way doesn't mean that +you I do it that way. Perl is designed to give you several +ways to do anything, so consider picking the most readable one. For +instance + + open(FOO,$foo) || die "Can't open $foo: $!"; + +is better than + + die "Can't open $foo: $!" unless open(FOO,$foo); + +because the second way hides the main point of the statement in a +modifier. On the other hand + + print "Starting analysis\n" if $verbose; + +is better than + + $verbose && print "Starting analysis\n"; + +because the main point isn't whether the user typed B<-v> or not. + +Similarly, just because an operator lets you assume default arguments +doesn't mean that you have to make use of the defaults. The defaults +are there for lazy systems programmers writing one-shot programs. If +you want your program to be readable, consider supplying the argument. + +Along the same lines, just because you I omit parentheses in many +places doesn't mean that you ought to: + + return print reverse sort num values %array; + return print(reverse(sort num (values(%array)))); + +When in doubt, parenthesize. At the very least it will let some poor +schmuck bounce on the % key in B. + +Even if you aren't in doubt, consider the mental welfare of the person +who has to maintain the code after you, and who will probably put +parentheses in the wrong place. + +=item * + +Don't go through silly contortions to exit a loop at the top or the +bottom, when Perl provides the C operator so you can exit in +the middle. Just "outdent" it a little to make it more visible: + + LINE: + for (;;) { + statements; + last LINE if $foo; + next LINE if /^#/; + statements; + } + +=item * + +Don't be afraid to use loop labels--they're there to enhance +readability as well as to allow multilevel loop breaks. See the +previous example. + +=item * + +Avoid using grep() (or map()) or `backticks` in a void context, that is, +when you just throw away their return values. Those functions all +have return values, so use them. Otherwise use a foreach() loop or +the system() function instead. + +=item * + +For portability, when using features that may not be implemented on +every machine, test the construct in an eval to see if it fails. If +you know what version or patchlevel a particular feature was +implemented, you can test C<$]> (C<$PERL_VERSION> in C) to see if it +will be there. The C module will also let you interrogate values +determined by the B program when Perl was installed. + +=item * + +Choose mnemonic identifiers. If you can't remember what mnemonic means, +you've got a problem. + +=item * + +While short identifiers like $gotit are probably ok, use underscores to +separate words. It is generally easier to read $var_names_like_this than +$VarNamesLikeThis, especially for non-native speakers of English. It's +also a simple rule that works consistently with VAR_NAMES_LIKE_THIS. + +Package names are sometimes an exception to this rule. Perl informally +reserves lowercase module names for "pragma" modules like C and +C. Other modules should begin with a capital letter and use mixed +case, but probably without underscores due to limitations in primitive +file systems' representations of module names as files that must fit into a +few sparse bytes. + +=item * + +You may find it helpful to use letter case to indicate the scope +or nature of a variable. For example: + + $ALL_CAPS_HERE constants only (beware clashes with perl vars!) + $Some_Caps_Here package-wide global/static + $no_caps_here function scope my() or local() variables + +Function and method names seem to work best as all lowercase. +E.g., $obj-Eas_string(). + +You can use a leading underscore to indicate that a variable or +function should not be used outside the package that defined it. + +=item * + +If you have a really hairy regular expression, use the C modifier and +put in some whitespace to make it look a little less like line noise. +Don't use slash as a delimiter when your regexp has slashes or backslashes. + +=item * + +Use the new "and" and "or" operators to avoid having to parenthesize +list operators so much, and to reduce the incidence of punctuation +operators like C<&&> and C<||>. Call your subroutines as if they were +functions or list operators to avoid excessive ampersands and parentheses. + +=item * + +Use here documents instead of repeated print() statements. + +=item * + +Line up corresponding things vertically, especially if it'd be too long +to fit on one line anyway. + + $IDX = $ST_MTIME; + $IDX = $ST_ATIME if $opt_u; + $IDX = $ST_CTIME if $opt_c; + $IDX = $ST_SIZE if $opt_s; + + mkdir $tmpdir, 0700 or die "can't mkdir $tmpdir: $!"; + chdir($tmpdir) or die "can't chdir $tmpdir: $!"; + mkdir 'tmp', 0777 or die "can't mkdir $tmpdir/tmp: $!"; + +=item * + +Always check the return codes of system calls. Good error messages should +go to STDERR, include which program caused the problem, what the failed +system call and arguments were, and (VERY IMPORTANT) should contain the +standard system error message for what went wrong. Here's a simple but +sufficient example: + + opendir(D, $dir) or die "can't opendir $dir: $!"; + +=item * + +Line up your transliterations when it makes sense: + + tr [abc] + [xyz]; + +=item * + +Think about reusability. Why waste brainpower on a one-shot when you +might want to do something like it again? Consider generalizing your +code. Consider writing a module or object class. Consider making your +code run cleanly with C and B<-w> in effect. Consider giving away +your code. Consider changing your whole world view. Consider... oh, +never mind. + +=item * + +Be consistent. + +=item * + +Be nice. + +=back diff --git a/contrib/perl5/pod/perlsub.pod b/contrib/perl5/pod/perlsub.pod new file mode 100644 index 00000000000..957b3d8ad81 --- /dev/null +++ b/contrib/perl5/pod/perlsub.pod @@ -0,0 +1,1149 @@ +=head1 NAME + +perlsub - Perl subroutines + +=head1 SYNOPSIS + +To declare subroutines: + + sub NAME; # A "forward" declaration. + sub NAME(PROTO); # ditto, but with prototypes + + sub NAME BLOCK # A declaration and a definition. + sub NAME(PROTO) BLOCK # ditto, but with prototypes + +To define an anonymous subroutine at runtime: + + $subref = sub BLOCK; # no proto + $subref = sub (PROTO) BLOCK; # with proto + +To import subroutines: + + use PACKAGE qw(NAME1 NAME2 NAME3); + +To call subroutines: + + NAME(LIST); # & is optional with parentheses. + NAME LIST; # Parentheses optional if predeclared/imported. + &NAME; # Makes current @_ visible to called subroutine. + +=head1 DESCRIPTION + +Like many languages, Perl provides for user-defined subroutines. These +may be located anywhere in the main program, loaded in from other files +via the C, C, or C keywords, or even generated on the +fly using C or anonymous subroutines (closures). You can even call +a function indirectly using a variable containing its name or a CODE reference +to it. + +The Perl model for function call and return values is simple: all +functions are passed as parameters one single flat list of scalars, and +all functions likewise return to their caller one single flat list of +scalars. Any arrays or hashes in these call and return lists will +collapse, losing their identities--but you may always use +pass-by-reference instead to avoid this. Both call and return lists may +contain as many or as few scalar elements as you'd like. (Often a +function without an explicit return statement is called a subroutine, but +there's really no difference from the language's perspective.) + +Any arguments passed to the routine come in as the array C<@_>. Thus if you +called a function with two arguments, those would be stored in C<$_[0]> +and C<$_[1]>. The array C<@_> is a local array, but its elements are +aliases for the actual scalar parameters. In particular, if an element +C<$_[0]> is updated, the corresponding argument is updated (or an error +occurs if it is not updatable). If an argument is an array or hash +element which did not exist when the function was called, that element is +created only when (and if) it is modified or if a reference to it is +taken. (Some earlier versions of Perl created the element whether or not +it was assigned to.) Note that assigning to the whole array C<@_> removes +the aliasing, and does not update any arguments. + +The return value of the subroutine is the value of the last expression +evaluated. Alternatively, a C 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, +the subroutine will return an empty list in a list context, an undefined +value in a scalar context, or nothing in a void context. If you return +one or more arrays and/or hashes, these will be flattened together into +one large indistinguishable list. + +Perl does not have named formal parameters, but in practice all you do is +assign to a C list of these. Any variables you use in the function +that aren't declared private are global variables. For the gory details +on creating private variables, see +L<"Private Variables via my()"> and L<"Temporary Values via local()">. +To create protected environments for a set of functions in a separate +package (and probably a separate file), see L. + +Example: + + sub max { + my $max = shift(@_); + foreach $foo (@_) { + $max = $foo if $max < $foo; + } + return $max; + } + $bestday = max($mon,$tue,$wed,$thu,$fri); + +Example: + + # get a line, combining continuation lines + # that start with whitespace + + sub get_line { + $thisline = $lookahead; # GLOBAL VARIABLES!! + LINE: while (defined($lookahead = )) { + if ($lookahead =~ /^[ \t]/) { + $thisline .= $lookahead; + } + else { + last LINE; + } + } + $thisline; + } + + $lookahead = ; # get first line + while ($_ = get_line()) { + ... + } + +Use array assignment to a local list to name your formal arguments: + + sub maybeset { + my($key, $value) = @_; + $Foo{$key} = $value unless $Foo{$key}; + } + +This also has the effect of turning call-by-reference into call-by-value, +because the assignment copies the values. Otherwise a function is free to +do in-place modifications of C<@_> and change its caller's values. + + upcase_in($v1, $v2); # this changes $v1 and $v2 + sub upcase_in { + for (@_) { tr/a-z/A-Z/ } + } + +You aren't allowed to modify constants in this way, of course. If an +argument were actually literal and you tried to change it, you'd take a +(presumably fatal) exception. For example, this won't work: + + upcase_in("frederick"); + +It would be much safer if the C function +were written to return a copy of its parameters instead +of changing them in place: + + ($v3, $v4) = upcase($v1, $v2); # this doesn't + sub upcase { + return unless defined wantarray; # void context, do nothing + my @parms = @_; + for (@parms) { tr/a-z/A-Z/ } + return wantarray ? @parms : $parms[0]; + } + +Notice how this (unprototyped) function doesn't care whether it was passed +real scalars or arrays. Perl will see everything as one big long flat C<@_> +parameter list. This is one of the ways where Perl's simple +argument-passing style shines. The C function would work perfectly +well without changing the C definition even if we fed it things +like this: + + @newlist = upcase(@list1, @list2); + @newlist = upcase( split /:/, $var ); + +Do not, however, be tempted to do this: + + (@a, @b) = upcase(@list1, @list2); + +Because like its flat incoming parameter list, the return list is also +flat. So all you have managed to do here is stored everything in C<@a> and +made C<@b> an empty list. See L for alternatives. + +A subroutine may be called using the "C<&>" prefix. The "C<&>" is optional +in modern Perls, and so are the parentheses if the subroutine has been +predeclared. (Note, however, that the "C<&>" is I optional when +you're just naming the subroutine, such as when it's used as an +argument to C or C. Nor is it optional when you want to +do an indirect subroutine call with a subroutine name or reference +using the C<&$subref()> or C<&{$subref}()> constructs. See L +for more on that.) + +Subroutines may be called recursively. If a subroutine is called using +the "C<&>" form, the argument list is optional, and if omitted, no C<@_> array is +set up for the subroutine: the C<@_> array at the time of the call is +visible to subroutine instead. This is an efficiency mechanism that +new users may wish to avoid. + + &foo(1,2,3); # pass three arguments + foo(1,2,3); # the same + + foo(); # pass a null list + &foo(); # the same + + &foo; # foo() get current args, like foo(@_) !! + foo; # like foo() IFF sub foo predeclared, else "foo" + +Not only does the "C<&>" form make the argument list optional, but it also +disables any prototype checking on the arguments you do provide. This +is partly for historical reasons, and partly for having a convenient way +to cheat if you know what you're doing. See the section on Prototypes below. + +Function whose names are in all upper case are reserved to the Perl core, +just as are modules whose names are in all lower case. A function in +all capitals is a loosely-held convention meaning it will be called +indirectly by the run-time system itself. Functions that do special, +pre-defined things are C, C, C, and C--plus all the +functions mentioned in L. The 5.005 release adds C +to this list. + +=head2 Private Variables via C + +Synopsis: + + my $foo; # declare $foo lexically local + my (@wid, %get); # declare list of variables local + my $foo = "flurp"; # declare $foo lexical, and init it + my @oof = @bar; # declare @oof lexical, and init it + +A "C" declares the listed variables to be confined (lexically) to the +enclosing block, conditional (C), loop +(C), subroutine, C, or +C'd file. If more than one value is listed, the list +must be placed in parentheses. All listed elements must be legal lvalues. +Only alphanumeric identifiers may be lexically scoped--magical +builtins like C<$/> must currently be Cize with "C" instead. + +Unlike dynamic variables created by the "C" operator, lexical +variables declared with "C" are totally hidden from the outside world, +including any called subroutines (even if it's the same subroutine called +from itself or elsewhere--every call gets its own copy). + +This doesn't mean that a C variable declared in a statically +I lexical scope would be invisible. Only the dynamic scopes +are cut off. For example, the C function below has access to the +lexical C<$x> variable because both the my and the sub occurred at the same +scope, presumably the file scope. + + my $x = 10; + sub bumpx { $x++ } + +(An C, however, can see the lexical variables of the scope it is +being evaluated in so long as the names aren't hidden by declarations within +the C itself. See L.) + +The parameter list to C may be assigned to if desired, which allows you +to initialize your variables. (If no initializer is given for a +particular variable, it is created with the undefined value.) Commonly +this is used to name the parameters to a subroutine. Examples: + + $arg = "fred"; # "global" variable + $n = cube_root(27); + print "$arg thinks the root is $n\n"; + fred thinks the root is 3 + + sub cube_root { + my $arg = shift; # name doesn't matter + $arg **= 1/3; + return $arg; + } + +The "C" is simply a modifier on something you might assign to. So when +you do assign to the variables in its argument list, the "C" doesn't +change whether those variables are viewed as a scalar or an array. So + + my ($foo) = ; # WRONG? + my @FOO = ; + +both supply a list context to the right-hand side, while + + my $foo = ; + +supplies a scalar context. But the following declares only one variable: + + my $foo, $bar = 1; # WRONG + +That has the same effect as + + my $foo; + $bar = 1; + +The declared variable is not introduced (is not visible) until after +the current statement. Thus, + + my $x = $x; + +can be used to initialize the new $x with the value of the old C<$x>, and +the expression + + my $x = 123 and $x == 123 + +is false unless the old C<$x> happened to have the value C<123>. + +Lexical scopes of control structures are not bounded precisely by the +braces that delimit their controlled blocks; control expressions are +part of the scope, too. Thus in the loop + + while (defined(my $line = <>)) { + $line = lc $line; + } continue { + print $line; + } + +the scope of C<$line> extends from its declaration throughout the rest of +the loop construct (including the C clause), but not beyond +it. Similarly, in the conditional + + if ((my $answer = ) =~ /^yes$/i) { + user_agrees(); + } elsif ($answer =~ /^no$/i) { + user_disagrees(); + } else { + chomp $answer; + die "'$answer' is neither 'yes' nor 'no'"; + } + +the scope of C<$answer> extends from its declaration throughout the rest +of the conditional (including C and C clauses, if any), +but not beyond it. + +(None of the foregoing applies to C or C +modifiers appended to simple statements. Such modifiers are not +control structures and have no effect on scoping.) + +The C loop defaults to scoping its index variable dynamically +(in the manner of C; see below). However, if the index +variable is prefixed with the keyword "C", then it is lexically +scoped instead. Thus in the loop + + for my $i (1, 2, 3) { + some_function(); + } + +the scope of C<$i> extends to the end of the loop, but not beyond it, and +so the value of C<$i> is unavailable in C. + +Some users may wish to encourage the use of lexically scoped variables. +As an aid to catching implicit references to package variables, +if you say + + use strict 'vars'; + +then any variable reference from there to the end of the enclosing +block must either refer to a lexical variable, or must be fully +qualified with the package name. A compilation error results +otherwise. An inner block may countermand this with S<"C">. + +A C has both a compile-time and a run-time effect. At compile time, +the compiler takes notice of it; the principle usefulness of this is to +quiet S<"C">. The actual initialization is delayed until +run time, so it gets executed appropriately; every time through a loop, +for example. + +Variables declared with "C" are not part of any package and are therefore +never fully qualified with the package name. In particular, you're not +allowed to try to make a package variable (or other global) lexical: + + my $pack::var; # ERROR! Illegal syntax + my $_; # also illegal (currently) + +In fact, a dynamic variable (also known as package or global variables) +are still accessible using the fully qualified C<::> notation even while a +lexical of the same name is also visible: + + package main; + local $x = 10; + my $x = 20; + print "$x and $::x\n"; + +That will print out C<20> and C<10>. + +You may declare "C" variables at the outermost scope of a file to hide +any such identifiers totally from the outside world. This is similar +to C's static variables at the file level. To do this with a subroutine +requires the use of a closure (anonymous function with lexical access). +If a block (such as an C, function, or C) wants to create +a private subroutine that cannot be called from outside that block, +it can declare a lexical variable containing an anonymous sub reference: + + my $secret_version = '1.001-beta'; + my $secret_sub = sub { print $secret_version }; + &$secret_sub(); + +As long as the reference is never returned by any function within the +module, no outside module can see the subroutine, because its name is not in +any package's symbol table. Remember that it's not I called +C<$some_pack::secret_version> or anything; it's just C<$secret_version>, +unqualified and unqualifiable. + +This does not work with object methods, however; all object methods have +to be in the symbol table of some package to be found. + +=head2 Peristent Private Variables + +Just because a lexical variable is lexically (also called statically) +scoped to its enclosing block, C, or C FILE, this doesn't mean that +within a function it works like a C static. It normally works more +like a C auto, but with implicit garbage collection. + +Unlike local variables in C or C++, Perl's lexical variables don't +necessarily get recycled just because their scope has exited. +If something more permanent is still aware of the lexical, it will +stick around. So long as something else references a lexical, that +lexical won't be freed--which is as it should be. You wouldn't want +memory being free until you were done using it, or kept around once you +were done. Automatic garbage collection takes care of this for you. + +This means that you can pass back or save away references to lexical +variables, whereas to return a pointer to a C auto is a grave error. +It also gives us a way to simulate C's function statics. Here's a +mechanism for giving a function private variables with both lexical +scoping and a static lifetime. If you do want to create something like +C's static variables, just enclose the whole function in an extra block, +and put the static variable outside the function but in the block. + + { + my $secret_val = 0; + sub gimme_another { + return ++$secret_val; + } + } + # $secret_val now becomes unreachable by the outside + # world, but retains its value between calls to gimme_another + +If this function is being sourced in from a separate file +via C or C, then this is probably just fine. If it's +all in the main program, you'll need to arrange for the C +to be executed early, either by putting the whole block above +your main program, or more likely, placing merely a C +sub around it to make sure it gets executed before your program +starts to run: + + sub BEGIN { + my $secret_val = 0; + sub gimme_another { + return ++$secret_val; + } + } + +See L about the C function. + +If declared at the outermost scope, the file scope, then lexicals work +someone like C's file statics. They are available to all functions in +that same file declared below them, but are inaccessible from outside of +the file. This is sometimes used in modules to create private variables +for the whole module. + +=head2 Temporary Values via local() + +B: In general, you should be using "C" instead of "C", because +it's faster and safer. Exceptions to this include the global punctuation +variables, filehandles and formats, and direct manipulation of the Perl +symbol table itself. Format variables often use "C" though, as do +other variables whose current value must be visible to called +subroutines. + +Synopsis: + + local $foo; # declare $foo dynamically local + local (@wid, %get); # declare list of variables local + local $foo = "flurp"; # declare $foo dynamic, and init it + local @oof = @bar; # declare @oof dynamic, and init it + + local *FH; # localize $FH, @FH, %FH, &FH ... + local *merlyn = *randal; # now $merlyn is really $randal, plus + # @merlyn is really @randal, etc + local *merlyn = 'randal'; # SAME THING: promote 'randal' to *randal + local *merlyn = \$randal; # just alias $merlyn, not @merlyn etc + +A C modifies its listed variables to be "local" to the enclosing +block, C, or C--and to I. +A C just gives temporary values to global (meaning package) +variables. It does B create a local variable. This is known as +dynamic scoping. Lexical scoping is done with "C", which works more +like C's auto declarations. + +If more than one variable is given to C, they must be placed in +parentheses. All listed elements must be legal lvalues. This operator works +by saving the current values of those variables in its argument list on a +hidden stack and restoring them upon exiting the block, subroutine, or +eval. This means that called subroutines can also reference the local +variable, but not the global one. The argument list may be assigned to if +desired, which allows you to initialize your local variables. (If no +initializer is given for a particular variable, it is created with an +undefined value.) Commonly this is used to name the parameters to a +subroutine. Examples: + + for $i ( 0 .. 9 ) { + $digits{$i} = $i; + } + # assume this function uses global %digits hash + parse_num(); + + # now temporarily add to %digits hash + if ($base12) { + # (NOTE: not claiming this is efficient!) + local %digits = (%digits, 't' => 10, 'e' => 11); + parse_num(); # parse_num gets this new %digits! + } + # old %digits restored here + +Because C is a run-time command, it gets executed every time +through a loop. In releases of Perl previous to 5.0, this used more stack +storage each time until the loop was exited. Perl now reclaims the space +each time through, but it's still more efficient to declare your variables +outside the loop. + +A C is simply a modifier on an lvalue expression. When you assign to +a Cized variable, the C doesn't change whether its list is viewed +as a scalar or an array. So + + local($foo) = ; + local @FOO = ; + +both supply a list context to the right-hand side, while + + local $foo = ; + +supplies a scalar context. + +A note about C and composite types is in order. Something +like C 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 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..] + +It's also worth taking a moment to explain what happens when you +Cize a member of a composite type (i.e. an array or hash element). +In this case, the element is Cized I. This means that +when the scope of the C ends, the saved value will be +restored to the hash element whose key was named in the C, or +the array element whose index was named in the C. If that +element was deleted while the C was in effect (e.g. by a +C from a hash or a C of an array), it will spring +back into existence, possibly extending an array and filling in the +skipped elements with C. For instance, if you say + + %hash = ( 'This' => 'is', 'a' => 'test' ); + @ary = ( 0..5 ); + { + local($ary[5]) = 6; + local($hash{'a'}) = 'drill'; + while (my $e = pop(@ary)) { + print "$e . . .\n"; + last unless $e > 3; + } + if (@ary) { + $hash{'only a'} = 'test'; + delete $hash{'a'}; + } + } + print join(' ', map { "$_ $hash{$_}" } sort keys %hash),".\n"; + print "The array has ",scalar(@ary)," elements: ", + join(', ', map { defined $_ ? $_ : 'undef' } @ary),"\n"; + +Perl will print + + 6 . . . + 4 . . . + 3 . . . + This is a test only a test. + The array has 6 elements: 0, 1, 2, undef, undef, 5 + +=head2 Passing Symbol Table Entries (typeglobs) + +[Note: The mechanism described in this section was originally the only +way to simulate pass-by-reference in older versions of Perl. While it +still works fine in modern versions, the new reference mechanism is +generally easier to work with. See below.] + +Sometimes you don't want to pass the value of an array to a subroutine +but rather the name of it, so that the subroutine can modify the global +copy of it rather than working with a local copy. In perl you can +refer to all objects of a particular name by prefixing the name +with a star: C<*foo>. This is often known as a "typeglob", because the +star on the front can be thought of as a wildcard match for all the +funny prefix characters on variables and subroutines and such. + +When evaluated, the typeglob produces a scalar value that represents +all the objects of that name, including any filehandle, format, or +subroutine. When assigned to, it causes the name mentioned to refer to +whatever "C<*>" value was assigned to it. Example: + + sub doubleary { + local(*someary) = @_; + foreach $elem (@someary) { + $elem *= 2; + } + } + doubleary(*foo); + doubleary(*bar); + +Note that scalars are already passed by reference, so you can modify +scalar arguments without using this mechanism by referring explicitly +to C<$_[0]> etc. You can modify all the elements of an array by passing +all the elements as scalars, but you have to use the C<*> mechanism (or +the equivalent reference mechanism) to C, C, or change the size of +an array. It will certainly be faster to pass the typeglob (or reference). + +Even if you don't want to modify an array, this mechanism is useful for +passing multiple arrays in a single LIST, because normally the LIST +mechanism will merge all the array values so that you can't extract out +the individual arrays. For more on typeglobs, see +L. + +=head2 When to Still Use local() + +Despite the existence of C, there are still three places where the +C operator still shines. In fact, in these three places, you +I use C instead of C. + +=over + +=item 1. You need to give a global variable a temporary value, especially C<$_>. + +The global variables, like C<@ARGV> or the punctuation variables, must be +Cized with C. This block reads in F, and splits +it up into chunks separated by lines of equal signs, which are placed +in C<@Fields>. + + { + local @ARGV = ("/etc/motd"); + local $/ = undef; + local $_ = <>; + @Fields = split /^\s*=+\s*$/; + } + +It particular, it's important to Cize C<$_> in any routine that assigns +to it. Look out for implicit assignments in C conditionals. + +=item 2. You need to create a local file or directory handle or a local function. + +A function that needs a filehandle of its own must use C uses +C on complete typeglob. This can be used to create new symbol +table entries: + + sub ioqueue { + local (*READER, *WRITER); # not my! + pipe (READER, WRITER); or die "pipe: $!"; + return (*READER, *WRITER); + } + ($head, $tail) = ioqueue(); + +See the Symbol module for a way to create anonymous symbol table +entries. + +Because assignment of a reference to a typeglob creates an alias, this +can be used to create what is effectively a local function, or at least, +a local alias. + + { + local *grow = \&shrink; # only until this block exists + grow(); # really calls shrink() + move(); # if move() grow()s, it shrink()s too + } + grow(); # get the real grow() again + +See L for more about manipulating +functions by name in this way. + +=item 3. You want to temporarily change just one element of an array or hash. + +You can Cize just one element of an aggregate. Usually this +is done on dynamics: + + { + local $SIG{INT} = 'IGNORE'; + funct(); # uninterruptible + } + # interruptibility automatically restored here + +But it also works on lexically declared aggregates. Prior to 5.005, +this operation could on occasion misbehave. + +=back + +=head2 Pass by Reference + +If you want to pass more than one array or hash into a function--or +return them from it--and have them maintain their integrity, then +you're going to have to use an explicit pass-by-reference. Before you +do that, you need to understand references as detailed in L. +This section may not make much sense to you otherwise. + +Here are a few simple examples. First, let's pass in several +arrays to a function and have it C all of then, return a new +list of all their former last elements: + + @tailings = popmany ( \@a, \@b, \@c, \@d ); + + sub popmany { + my $aref; + my @retlist = (); + foreach $aref ( @_ ) { + push @retlist, pop @$aref; + } + return @retlist; + } + +Here's how you might write a function that returns a +list of keys occurring in all the hashes passed to it: + + @common = inter( \%foo, \%bar, \%joe ); + sub inter { + my ($k, $href, %seen); # locals + foreach $href (@_) { + while ( $k = each %$href ) { + $seen{$k}++; + } + } + return grep { $seen{$_} == @_ } keys %seen; + } + +So far, we're using just the normal list return mechanism. +What happens if you want to pass or return a hash? Well, +if you're using only one of them, or you don't mind them +concatenating, then the normal calling convention is ok, although +a little expensive. + +Where people get into trouble is here: + + (@a, @b) = func(@c, @d); +or + (%a, %b) = func(%c, %d); + +That syntax simply won't work. It sets just C<@a> or C<%a> and clears the C<@b> or +C<%b>. Plus the function didn't get passed into two separate arrays or +hashes: it got one long list in C<@_>, as always. + +If you can arrange for everyone to deal with this through references, it's +cleaner code, although not so nice to look at. Here's a function that +takes two array references as arguments, returning the two array elements +in order of how many elements they have in them: + + ($aref, $bref) = func(\@c, \@d); + print "@$aref has more than @$bref\n"; + sub func { + my ($cref, $dref) = @_; + if (@$cref > @$dref) { + return ($cref, $dref); + } else { + return ($dref, $cref); + } + } + +It turns out that you can actually do this also: + + (*a, *b) = func(\@c, \@d); + print "@a has more than @b\n"; + sub func { + local (*c, *d) = @_; + if (@c > @d) { + return (\@c, \@d); + } else { + return (\@d, \@c); + } + } + +Here we're using the typeglobs to do symbol table aliasing. It's +a tad subtle, though, and also won't work if you're using C +variables, because only globals (well, and Cs) are in the symbol table. + +If you're passing around filehandles, you could usually just use the bare +typeglob, like C<*STDOUT>, but typeglobs references would be better because +they'll still work properly under S>. For example: + + splutter(\*STDOUT); + sub splutter { + my $fh = shift; + print $fh "her um well a hmmm\n"; + } + + $rec = get_rec(\*STDIN); + sub get_rec { + my $fh = shift; + return scalar <$fh>; + } + +Another way to do this is using C<*HANDLE{IO}>, see L for usage +and caveats. + +If you're planning on generating new filehandles, you could do this: + + sub openit { + my $name = shift; + local *FH; + return open (FH, $path) ? *FH : undef; + } + +Although that will actually produce a small memory leak. See the bottom +of L for a somewhat cleaner way using the C +package. + +=head2 Prototypes + +As of the 5.002 release of perl, if you declare + + sub mypush (\@@) + +then C takes arguments exactly like C does. The declaration +of the function to be called must be visible at compile time. The prototype +affects only the interpretation of new-style calls to the function, where +new-style is defined as not using the C<&> character. In other words, +if you call it like a builtin function, then it behaves like a builtin +function. If you call it like an old-fashioned subroutine, then it +behaves like an old-fashioned subroutine. It naturally falls out from +this rule that prototypes have no influence on subroutine references +like C<\&foo> or on indirect subroutine calls like C<&{$subref}>. + +Method calls are not influenced by prototypes either, because the +function to be called is indeterminate at compile time, because it depends +on inheritance. + +Because the intent is primarily to let you define subroutines that work +like builtin commands, here are the prototypes for some other functions +that parse almost exactly like the corresponding builtins. + + Declared as Called as + + sub mylink ($$) mylink $old, $new + sub myvec ($$$) myvec $var, $offset, 1 + sub myindex ($$;$) myindex &getstring, "substr" + sub mysyswrite ($$$;$) mysyswrite $buf, 0, length($buf) - $off, $off + sub myreverse (@) myreverse $a, $b, $c + sub myjoin ($@) myjoin ":", $a, $b, $c + sub mypop (\@) mypop @array + sub mysplice (\@$$@) mysplice @array, @array, 0, @pushme + sub mykeys (\%) mykeys %{$hashref} + sub myopen (*;$) myopen HANDLE, $name + sub mypipe (**) mypipe READHANDLE, WRITEHANDLE + sub mygrep (&@) mygrep { /foo/ } $a, $b, $c + sub myrand ($) myrand 42 + sub mytime () mytime + +Any backslashed prototype character represents an actual argument +that absolutely must start with that character. The value passed +to the subroutine (as part of C<@_>) will be a reference to the +actual argument given in the subroutine call, obtained by applying +C<\> to that argument. + +Unbackslashed prototype characters have special meanings. Any +unbackslashed C<@> or C<%> eats all the rest of the arguments, and forces +list context. An argument represented by C<$> forces scalar context. An +C<&> requires an anonymous subroutine, which, if passed as the first +argument, does not require the "C" keyword or a subsequent comma. A +C<*> does whatever it has to do to turn the argument into a reference to a +symbol table entry. + +A semicolon separates mandatory arguments from optional arguments. +(It is redundant before C<@> or C<%>.) + +Note how the last three examples above are treated specially by the parser. +C is parsed as a true list operator, C is parsed as a +true unary operator with unary precedence the same as C, and +C is truly without arguments, just like C. That is, if you +say + + mytime +2; + +you'll get C, not C, which is how it would be parsed +without the prototype. + +The interesting thing about C<&> is that you can generate new syntax with it: + + sub try (&@) { + my($try,$catch) = @_; + eval { &$try }; + if ($@) { + local $_ = $@; + &$catch; + } + } + sub catch (&) { $_[0] } + + try { + die "phooey"; + } catch { + /phooey/ and print "unphooey\n"; + }; + +That prints C<"unphooey">. (Yes, there are still unresolved +issues having to do with the visibility of C<@_>. I'm ignoring that +question for the moment. (But note that if we make C<@_> lexically +scoped, those anonymous subroutines can act like closures... (Gee, +is this sounding a little Lispish? (Never mind.)))) + +And here's a reimplementation of C: + + sub mygrep (&@) { + my $code = shift; + my @result; + foreach $_ (@_) { + push(@result, $_) if &$code; + } + @result; + } + +Some folks would prefer full alphanumeric prototypes. Alphanumerics have +been intentionally left out of prototypes for the express purpose of +someday in the future adding named, formal parameters. The current +mechanism's main goal is to let module writers provide better diagnostics +for module users. Larry feels the notation quite understandable to Perl +programmers, and that it will not intrude greatly upon the meat of the +module, nor make it harder to read. The line noise is visually +encapsulated into a small pill that's easy to swallow. + +It's probably best to prototype new functions, not retrofit prototyping +into older ones. That's because you must be especially careful about +silent impositions of differing list versus scalar contexts. For example, +if you decide that a function should take just one parameter, like this: + + sub func ($) { + my $n = shift; + print "you gave me $n\n"; + } + +and someone has been calling it with an array or expression +returning a list: + + func(@foo); + func( split /:/ ); + +Then you've just supplied an automatic C in front of their +argument, which can be more than a bit surprising. The old C<@foo> +which used to hold one thing doesn't get passed in. Instead, +the C now gets passed in C<1>, that is, the number of elements +in C<@foo>. And the C gets called in a scalar context and +starts scribbling on your C<@_> parameter list. + +This is all very powerful, of course, and should be used only in moderation +to make the world a better place. + +=head2 Constant Functions + +Functions with a prototype of C<()> are potential candidates for +inlining. If the result after optimization and constant folding is +either a constant or a lexically-scoped scalar which has no other +references, then it will be used in place of function calls made +without C<&> or C. Calls made using C<&> or C are never +inlined. (See F for an easy way to declare most +constants.) + +The following functions would all be inlined: + + sub pi () { 3.14159 } # Not exact, but close. + sub PI () { 4 * atan2 1, 1 } # As good as it gets, + # and it's inlined, too! + sub ST_DEV () { 0 } + sub ST_INO () { 1 } + + sub FLAG_FOO () { 1 << 8 } + sub FLAG_BAR () { 1 << 9 } + sub FLAG_MASK () { FLAG_FOO | FLAG_BAR } + + sub OPT_BAZ () { not (0x1B58 & FLAG_MASK) } + sub BAZ_VAL () { + if (OPT_BAZ) { + return 23; + } + else { + return 42; + } + } + + sub N () { int(BAZ_VAL) / 3 } + BEGIN { + my $prod = 1; + for (1..N) { $prod *= $_ } + sub N_FACTORIAL () { $prod } + } + +If you redefine a subroutine that was eligible for inlining, you'll get +a mandatory warning. (You can use this warning to tell whether or not a +particular subroutine is considered constant.) The warning is +considered severe enough not to be optional because previously compiled +invocations of the function will still be using the old value of the +function. If you need to be able to redefine the subroutine you need to +ensure that it isn't inlined, either by dropping the C<()> prototype +(which changes the calling semantics, so beware) or by thwarting the +inlining mechanism in some other way, such as + + sub not_inlined () { + 23 if $]; + } + +=head2 Overriding Builtin Functions + +Many builtin functions may be overridden, though this should be tried +only occasionally and for good reason. Typically this might be +done by a package attempting to emulate missing builtin functionality +on a non-Unix system. + +Overriding may be done only by importing the name from a +module--ordinary predeclaration isn't good enough. However, the +C pragma (compiler directive) lets you, in effect, predeclare subs +via the import syntax, and these names may then override the builtin ones: + + use subs 'chdir', 'chroot', 'chmod', 'chown'; + chdir $somewhere; + sub chdir { ... } + +To unambiguously refer to the builtin form, one may precede the +builtin name with the special package qualifier C. For example, +saying C will always refer to the builtin C, even +if the current package has imported some other subroutine called +C<&open()> from elsewhere. + +Library modules should not in general export builtin names like "C" +or "C" as part of their default C<@EXPORT> list, because these may +sneak into someone else's namespace and change the semantics unexpectedly. +Instead, if the module adds the name to the C<@EXPORT_OK> list, then it's +possible for a user to import the name explicitly, but not implicitly. +That is, they could say + + use Module 'open'; + +and it would import the C override, but if they said + + use Module; + +they would get the default imports without the overrides. + +The foregoing mechanism for overriding builtins is restricted, quite +deliberately, to the package that requests the import. There is a second +method that is sometimes applicable when you wish to override a builtin +everywhere, without regard to namespace boundaries. This is achieved by +importing a sub into the special namespace C. Here is an +example that quite brazenly replaces the C operator with something +that understands regular expressions. + + package REGlob; + require Exporter; + @ISA = 'Exporter'; + @EXPORT_OK = 'glob'; + + sub import { + my $pkg = shift; + return unless @_; + my $sym = shift; + my $where = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0)); + $pkg->export($where, $sym, @_); + } + + sub glob { + my $pat = shift; + my @got; + local(*D); + if (opendir D, '.') { @got = grep /$pat/, readdir D; closedir D; } + @got; + } + 1; + +And here's how it could be (ab)used: + + #use REGlob 'GLOBAL_glob'; # override glob() in ALL namespaces + package Foo; + use REGlob 'glob'; # override glob() in Foo:: only + print for <^[a-z_]+\.pm\$>; # show all pragmatic modules + +Note that the initial comment shows a contrived, even dangerous example. +By overriding C globally, you would be forcing the new (and +subversive) behavior for the C operator for B namespace, +without the complete cognizance or cooperation of the modules that own +those namespaces. Naturally, this should be done with extreme caution--if +it must be done at all. + +The C example above does not implement all the support needed to +cleanly override perl's C operator. The builtin C has +different behaviors depending on whether it appears in a scalar or list +context, but our C doesn't. Indeed, many perl builtins have such +context sensitive behaviors, and these must be adequately supported by +a properly written override. For a fully functional example of overriding +C, study the implementation of C in the standard +library. + + +=head2 Autoloading + +If you call a subroutine that is undefined, you would ordinarily get an +immediate fatal error complaining that the subroutine doesn't exist. +(Likewise for subroutines being used as methods, when the method +doesn't exist in any base class of the class package.) If, +however, there is an C subroutine defined in the package or +packages that were searched for the original subroutine, then that +C subroutine is called with the arguments that would have been +passed to the original subroutine. The fully qualified name of the +original subroutine magically appears in the C<$AUTOLOAD> variable in the +same package as the C routine. The name is not passed as an +ordinary argument because, er, well, just because, that's why... + +Most C routines will load in a definition for the subroutine in +question using eval, and then execute that subroutine using a special +form of "goto" that erases the stack frame of the C routine +without a trace. (See the standard C module, for example.) +But an C routine can also just emulate the routine and never +define it. For example, let's pretend that a function that wasn't defined +should just call C with those arguments. All you'd do is this: + + sub AUTOLOAD { + my $program = $AUTOLOAD; + $program =~ s/.*:://; + system($program, @_); + } + date(); + who('am', 'i'); + ls('-l'); + +In fact, if you predeclare the functions you want to call that way, you don't +even need the parentheses: + + use subs qw(date who ls); + date; + who "am", "i"; + ls -l; + +A more complete example of this is the standard Shell module, which +can treat undefined subroutine calls as calls to Unix programs. + +Mechanisms are available for modules writers to help split the modules +up into autoloadable files. See the standard AutoLoader module +described in L and in L, the standard +SelfLoader modules in L, and the document on adding C +functions to perl code in L. + +=head1 SEE ALSO + +See L for more about references and closures. See L if +you'd like to learn about calling C subroutines from perl. See L +to learn about bundling up your functions in separate files. diff --git a/contrib/perl5/pod/perlsyn.pod b/contrib/perl5/pod/perlsyn.pod new file mode 100644 index 00000000000..832123507be --- /dev/null +++ b/contrib/perl5/pod/perlsyn.pod @@ -0,0 +1,617 @@ +=head1 NAME + +perlsyn - Perl syntax + +=head1 DESCRIPTION + +A Perl script consists of a sequence of declarations and statements. +The only things that need to be declared in Perl are report formats +and subroutines. See the sections below for more information on those +declarations. All uninitialized user-created objects are assumed to +start with a C or C<0> value until they are defined by some explicit +operation such as assignment. (Though you can get warnings about the +use of undefined values if you like.) The sequence of statements is +executed just once, unlike in B and B scripts, where the +sequence of statements is executed for each input line. While this means +that you must explicitly loop over the lines of your input file (or +files), it also means you have much more control over which files and +which lines you look at. (Actually, I'm lying--it is possible to do an +implicit loop with either the B<-n> or B<-p> switch. It's just not the +mandatory default like it is in B and B.) + +=head2 Declarations + +Perl is, for the most part, a free-form language. (The only +exception to this is format declarations, for obvious reasons.) Comments +are indicated by the C<"#"> character, and extend to the end of the line. If +you attempt to use C C-style comments, it will be interpreted +either as division or pattern matching, depending on the context, and C++ +C comments just look like a null regular expression, so don't do +that. + +A declaration can be put anywhere a statement can, but has no effect on +the execution of the primary sequence of statements--declarations all +take effect at compile time. Typically all the declarations are put at +the beginning or the end of the script. However, if you're using +lexically-scoped private variables created with C, you'll have to make sure +your format or subroutine definition is within the same block scope +as the my if you expect to be able to access those private variables. + +Declaring a subroutine allows a subroutine name to be used as if it were a +list operator from that point forward in the program. You can declare a +subroutine without defining it by saying C, thus: + + sub myname; + $me = myname $0 or die "can't get myname"; + +Note that it functions as a list operator, not as a unary operator; so +be careful to use C instead of C<||> in this case. However, if +you were to declare the subroutine as C, then +C would function as a unary operator, so either C or +C<||> would work. + +Subroutines declarations can also be loaded up with the C statement +or both loaded and imported into your namespace with a C statement. +See L for details on this. + +A statement sequence may contain declarations of lexically-scoped +variables, but apart from declaring a variable name, the declaration acts +like an ordinary statement, and is elaborated within the sequence of +statements as if it were an ordinary statement. That means it actually +has both compile-time and run-time effects. + +=head2 Simple statements + +The only kind of simple statement is an expression evaluated for its +side effects. Every simple statement must be terminated with a +semicolon, unless it is the final statement in a block, in which case +the semicolon is optional. (A semicolon is still encouraged there if the +block takes up more than one line, because you may eventually add another line.) +Note that there are some operators like C and C that look +like compound statements, but aren't (they're just TERMs in an expression), +and thus need an explicit termination if used as the last item in a statement. + +Any simple statement may optionally be followed by a I modifier, +just before the terminating semicolon (or block ending). The possible +modifiers are: + + if EXPR + unless EXPR + while EXPR + until EXPR + foreach EXPR + +The C and C modifiers have the expected semantics, +presuming you're a speaker of English. The C modifier is an +iterator: For each value in EXPR, it aliases C<$_> to the value and +executes the statement. The C and C modifiers have the +usual "C loop" semantics (conditional evaluated first), except +when applied to a C-BLOCK (or to the now-deprecated C-SUBROUTINE +statement), in which case the block executes once before the +conditional is evaluated. This is so that you can write loops like: + + do { + $line = ; + ... + } until $line eq ".\n"; + +See L. Note also that the loop control statements described +later will I work in this construct, because modifiers don't take +loop labels. Sorry. You can always put another block inside of it +(for C) or around it (for C) to do that sort of thing. +For C, just double the braces: + + do {{ + next if $x == $y; + # do something here + }} until $x++ > $z; + +For C, you have to be more elaborate: + + LOOP: { + do { + last if $x = $y**2; + # do something here + } while $x++ <= $z; + } + +=head2 Compound statements + +In Perl, a sequence of statements that defines a scope is called a block. +Sometimes a block is delimited by the file containing it (in the case +of a required file, or the program as a whole), and sometimes a block +is delimited by the extent of a string (in the case of an eval). + +But generally, a block is delimited by curly brackets, also known as braces. +We will call this syntactic construct a BLOCK. + +The following compound statements may be used to control flow: + + if (EXPR) BLOCK + if (EXPR) BLOCK else BLOCK + if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK + LABEL while (EXPR) BLOCK + LABEL while (EXPR) BLOCK continue BLOCK + LABEL for (EXPR; EXPR; EXPR) BLOCK + LABEL foreach VAR (LIST) BLOCK + LABEL BLOCK continue BLOCK + +Note that, unlike C and Pascal, these are defined in terms of BLOCKs, +not statements. This means that the curly brackets are I--no +dangling statements allowed. If you want to write conditionals without +curly brackets there are several other ways to do it. The following +all do the same thing: + + if (!open(FOO)) { die "Can't open $FOO: $!"; } + die "Can't open $FOO: $!" unless open(FOO); + open(FOO) or die "Can't open $FOO: $!"; # FOO or bust! + open(FOO) ? 'hi mom' : die "Can't open $FOO: $!"; + # a bit exotic, that last one + +The C statement is straightforward. Because BLOCKs are always +bounded by curly brackets, there is never any ambiguity about which +C an C goes with. If you use C in place of C, +the sense of the test is reversed. + +The C statement executes the block as long as the expression is +true (does not evaluate to the null string (C<"">) or C<0> or C<"0")>. The LABEL is +optional, and if present, consists of an identifier followed by a colon. +The LABEL identifies the loop for the loop control statements C, +C, and C. If the LABEL is omitted, the loop control statement +refers to the innermost enclosing loop. This may include dynamically +looking back your call-stack at run time to find the LABEL. Such +desperate behavior triggers a warning if you use the B<-w> flag. + +If there is a C BLOCK, it is always executed just before the +conditional is about to be evaluated again, just like the third part of a +C loop in C. Thus it can be used to increment a loop variable, even +when the loop has been continued via the C statement (which is +similar to the C C statement). + +=head2 Loop Control + +The C command is like the C statement in C; it starts +the next iteration of the loop: + + LINE: while () { + next LINE if /^#/; # discard comments + ... + } + +The C command is like the C statement in C (as used in +loops); it immediately exits the loop in question. The +C block, if any, is not executed: + + LINE: while () { + last LINE if /^$/; # exit when done with header + ... + } + +The C command restarts the loop block without evaluating the +conditional again. The C block, if any, is I executed. +This command is normally used by programs that want to lie to themselves +about what was just input. + +For example, when processing a file like F. +If your input lines might end in backslashes to indicate continuation, you +want to skip ahead and get the next record. + + while (<>) { + chomp; + if (s/\\$//) { + $_ .= <>; + redo unless eof(); + } + # now process $_ + } + +which is Perl short-hand for the more explicitly written version: + + LINE: while (defined($line = )) { + chomp($line); + if ($line =~ s/\\$//) { + $line .= ; + redo LINE unless eof(); # not eof(ARGV)! + } + # now process $line + } + +Note that if there were a C block on the above code, it would get +executed even on discarded lines. This is often used to reset line counters +or C one-time matches. + + # inspired by :1,$g/fred/s//WILMA/ + while (<>) { + ?(fred)? && s//WILMA $1 WILMA/; + ?(barney)? && s//BETTY $1 BETTY/; + ?(homer)? && s//MARGE $1 MARGE/; + } continue { + print "$ARGV $.: $_"; + close ARGV if eof(); # reset $. + reset if eof(); # reset ?pat? + } + +If the word C is replaced by the word C, the sense of the +test is reversed, but the conditional is still tested before the first +iteration. + +The loop control statements don't work in an C or C, since +they aren't loops. You can double the braces to make them such, though. + + if (/pattern/) {{ + next if /fred/; + next if /barney/; + # so something here + }} + +The form C, available in Perl 4, is no longer +available. Replace any occurrence of C by C. + +=head2 For Loops + +Perl's C-style C loop works exactly like the corresponding C loop; +that means that this: + + for ($i = 1; $i < 10; $i++) { + ... + } + +is the same as this: + + $i = 1; + while ($i < 10) { + ... + } continue { + $i++; + } + +(There is one minor difference: The first form implies a lexical scope +for variables declared with C in the initialization expression.) + +Besides the normal array index looping, C can lend itself +to many other interesting applications. Here's one that avoids the +problem you get into if you explicitly test for end-of-file on +an interactive file descriptor causing your program to appear to +hang. + + $on_a_tty = -t STDIN && -t STDOUT; + sub prompt { print "yes? " if $on_a_tty } + for ( prompt(); ; prompt() ) { + # do something + } + +=head2 Foreach Loops + +The C loop iterates over a normal list value and sets the +variable VAR to be each element of the list in turn. If the variable +is preceded with the keyword C, then it is lexically scoped, and +is therefore visible only within the loop. Otherwise, the variable is +implicitly local to the loop and regains its former value upon exiting +the loop. If the variable was previously declared with C, it uses +that variable instead of the global one, but it's still localized to +the loop. (Note that a lexically scoped variable can cause problems +if you have subroutine or format declarations within the loop which +refer to it.) + +The C keyword is actually a synonym for the C keyword, so +you can use C for readability or C for brevity. (Or because +the Bourne shell is more familiar to you than I, so writing C +comes more naturally.) If VAR is omitted, C<$_> is set to each value. +If any element of LIST is an lvalue, you can modify it by modifying VAR +inside the loop. That's because the C loop index variable is +an implicit alias for each item in the list that you're looping over. + +If any part of LIST is an array, C will get very confused if +you add or remove elements within the loop body, for example with +C. So don't do that. + +C probably won't do what you expect if VAR is a tied or other +special variable. Don't do that either. + +Examples: + + for (@ary) { s/foo/bar/ } + + foreach my $elem (@elements) { + $elem *= 2; + } + + for $count (10,9,8,7,6,5,4,3,2,1,'BOOM') { + print $count, "\n"; sleep(1); + } + + for (1..15) { print "Merry Christmas\n"; } + + foreach $item (split(/:[\\\n:]*/, $ENV{TERMCAP})) { + print "Item: $item\n"; + } + +Here's how a C programmer might code up a particular algorithm in Perl: + + for (my $i = 0; $i < @ary1; $i++) { + for (my $j = 0; $j < @ary2; $j++) { + if ($ary1[$i] > $ary2[$j]) { + last; # can't go to outer :-( + } + $ary1[$i] += $ary2[$j]; + } + # this is where that last takes me + } + +Whereas here's how a Perl programmer more comfortable with the idiom might +do it: + + OUTER: foreach my $wid (@ary1) { + INNER: foreach my $jet (@ary2) { + next OUTER if $wid > $jet; + $wid += $jet; + } + } + +See how much easier this is? It's cleaner, safer, and faster. It's +cleaner because it's less noisy. It's safer because if code gets added +between the inner and outer loops later on, the new code won't be +accidentally executed. The C explicitly iterates the other loop +rather than merely terminating the inner one. And it's faster because +Perl executes a C statement more rapidly than it would the +equivalent C loop. + +=head2 Basic BLOCKs and Switch Statements + +A BLOCK by itself (labeled or not) is semantically equivalent to a +loop that executes once. Thus you can use any of the loop control +statements in it to leave or restart the block. (Note that this is +I true in C, C, or contrary to popular belief +C blocks, which do I count as loops.) The C +block is optional. + +The BLOCK construct is particularly nice for doing case +structures. + + SWITCH: { + if (/^abc/) { $abc = 1; last SWITCH; } + if (/^def/) { $def = 1; last SWITCH; } + if (/^xyz/) { $xyz = 1; last SWITCH; } + $nothing = 1; + } + +There is no official C statement in Perl, because there are +already several ways to write the equivalent. In addition to the +above, you could write + + SWITCH: { + $abc = 1, last SWITCH if /^abc/; + $def = 1, last SWITCH if /^def/; + $xyz = 1, last SWITCH if /^xyz/; + $nothing = 1; + } + +(That's actually not as strange as it looks once you realize that you can +use loop control "operators" within an expression, That's just the normal +C comma operator.) + +or + + SWITCH: { + /^abc/ && do { $abc = 1; last SWITCH; }; + /^def/ && do { $def = 1; last SWITCH; }; + /^xyz/ && do { $xyz = 1; last SWITCH; }; + $nothing = 1; + } + +or formatted so it stands out more as a "proper" C statement: + + SWITCH: { + /^abc/ && do { + $abc = 1; + last SWITCH; + }; + + /^def/ && do { + $def = 1; + last SWITCH; + }; + + /^xyz/ && do { + $xyz = 1; + last SWITCH; + }; + $nothing = 1; + } + +or + + SWITCH: { + /^abc/ and $abc = 1, last SWITCH; + /^def/ and $def = 1, last SWITCH; + /^xyz/ and $xyz = 1, last SWITCH; + $nothing = 1; + } + +or even, horrors, + + if (/^abc/) + { $abc = 1 } + elsif (/^def/) + { $def = 1 } + elsif (/^xyz/) + { $xyz = 1 } + else + { $nothing = 1 } + +A common idiom for a C statement is to use C's aliasing to make +a temporary assignment to C<$_> for convenient matching: + + SWITCH: for ($where) { + /In Card Names/ && do { push @flags, '-e'; last; }; + /Anywhere/ && do { push @flags, '-h'; last; }; + /In Rulings/ && do { last; }; + die "unknown value for form variable where: `$where'"; + } + +Another interesting approach to a switch statement is arrange +for a C block to return the proper value: + + $amode = do { + if ($flag & O_RDONLY) { "r" } # XXX: isn't this 0? + elsif ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } + elsif ($flag & O_RDWR) { + if ($flag & O_CREAT) { "w+" } + else { ($flag & O_APPEND) ? "a+" : "r+" } + } + }; + +Or + + print do { + ($flags & O_WRONLY) ? "write-only" : + ($flags & O_RDWR) ? "read-write" : + "read-only"; + }; + +Or if you are certainly that all the C<&&> clauses are true, you can use +something like this, which "switches" on the value of the +C envariable. + + #!/usr/bin/perl + # pick out jargon file page based on browser + $dir = 'http://www.wins.uva.nl/~mes/jargon'; + for ($ENV{HTTP_USER_AGENT}) { + $page = /Mac/ && 'm/Macintrash.html' + || /Win(dows )?NT/ && 'e/evilandrude.html' + || /Win|MSIE|WebTV/ && 'm/MicroslothWindows.html' + || /Linux/ && 'l/Linux.html' + || /HP-UX/ && 'h/HP-SUX.html' + || /SunOS/ && 's/ScumOS.html' + || 'a/AppendixB.html'; + } + print "Location: $dir/$page\015\012\015\012"; + +That kind of switch statement only works when you know the C<&&> clauses +will be true. If you don't, the previous C example should be used. + +You might also consider writing a hash instead of synthesizing a C +statement. + +=head2 Goto + +Although not for the faint of heart, Perl does support a C statement. +A loop's LABEL is not actually a valid target for a C; +it's just the name of the loop. There are three forms: C-LABEL, +C-EXPR, and C-&NAME. + +The C-LABEL form finds the statement labeled with LABEL and resumes +execution there. It may not be used to go into any construct that +requires initialization, such as a subroutine or a C loop. It +also can't be used to go into a construct that is optimized away. It +can be used to go almost anywhere else within the dynamic scope, +including out of subroutines, but it's usually better to use some other +construct such as C or C. The author of Perl has never felt the +need to use this form of C (in Perl, that is--C is another matter). + +The C-EXPR form expects a label name, whose scope will be resolved +dynamically. This allows for computed Cs per FORTRAN, but isn't +necessarily recommended if you're optimizing for maintainability: + + goto ("FOO", "BAR", "GLARCH")[$i]; + +The C-&NAME form is highly magical, and substitutes a call to the +named subroutine for the currently running subroutine. This is used by +C subroutines that wish to load another subroutine and then +pretend that the other subroutine had been called in the first place +(except that any modifications to C<@_> in the current subroutine are +propagated to the other subroutine.) After the C, not even C +will be able to tell that this routine was called first. + +In almost all cases like this, it's usually a far, far better idea to use the +structured control flow mechanisms of C, C, or C instead of +resorting to a C. For certain applications, the catch and throw pair of +C and die() for exception processing can also be a prudent approach. + +=head2 PODs: Embedded Documentation + +Perl has a mechanism for intermixing documentation with source code. +While it's expecting the beginning of a new statement, if the compiler +encounters a line that begins with an equal sign and a word, like this + + =head1 Here There Be Pods! + +Then that text and all remaining text up through and including a line +beginning with C<=cut> will be ignored. The format of the intervening +text is described in L. + +This allows you to intermix your source code +and your documentation text freely, as in + + =item snazzle($) + + The snazzle() function will behave in the most spectacular + form that you can possibly imagine, not even excepting + cybernetic pyrotechnics. + + =cut back to the compiler, nuff of this pod stuff! + + sub snazzle($) { + my $thingie = shift; + ......... + } + +Note that pod translators should look at only paragraphs beginning +with a pod directive (it makes parsing easier), whereas the compiler +actually knows to look for pod escapes even in the middle of a +paragraph. This means that the following secret stuff will be +ignored by both the compiler and the translators. + + $a=3; + =secret stuff + warn "Neither POD nor CODE!?" + =cut back + print "got $a\n"; + +You probably shouldn't rely upon the C being podded out forever. +Not all pod translators are well-behaved in this regard, and perhaps +the compiler will become pickier. + +One may also use pod directives to quickly comment out a section +of code. + +=head2 Plain Old Comments (Not!) + +Much like the C preprocessor, Perl can process line directives. Using +this, one can control Perl's idea of filenames and line numbers in +error or warning messages (especially for strings that are processed +with C). The syntax for this mechanism is the same as for most +C preprocessors: it matches the regular expression +C with C<$1> being the line +number for the next line, and C<$2> being the optional filename +(specified within quotes). + +Here are some examples that you should be able to type into your command +shell: + + % perl + # line 200 "bzzzt" + # the `#' on the previous line must be the first char on line + die 'foo'; + __END__ + foo at bzzzt line 201. + + % perl + # line 200 "bzzzt" + eval qq[\n#line 2001 ""\ndie 'foo']; print $@; + __END__ + foo at - line 2001. + + % perl + eval qq[\n#line 200 "foo bar"\ndie 'foo']; print $@; + __END__ + foo at foo bar line 200. + + % perl + # line 345 "goop" + eval "\n#line " . __LINE__ . ' "' . __FILE__ ."\"\ndie 'foo'"; + print $@; + __END__ + foo at goop line 345. + +=cut diff --git a/contrib/perl5/pod/perltie.pod b/contrib/perl5/pod/perltie.pod new file mode 100644 index 00000000000..cae0a15a549 --- /dev/null +++ b/contrib/perl5/pod/perltie.pod @@ -0,0 +1,876 @@ +=head1 NAME + +perltie - how to hide an object class in a simple variable + +=head1 SYNOPSIS + + tie VARIABLE, CLASSNAME, LIST + + $object = tied VARIABLE + + untie VARIABLE + +=head1 DESCRIPTION + +Prior to release 5.0 of Perl, a programmer could use dbmopen() +to connect an on-disk database in the standard Unix dbm(3x) +format magically to a %HASH in their program. However, their Perl was either +built with one particular dbm library or another, but not both, and +you couldn't extend this mechanism to other packages or types of variables. + +Now you can. + +The tie() function binds a variable to a class (package) that will provide +the implementation for access methods for that variable. Once this magic +has been performed, accessing a tied variable automatically triggers +method calls in the proper class. The complexity of the class is +hidden behind magic methods calls. The method names are in ALL CAPS, +which is a convention that Perl uses to indicate that they're called +implicitly rather than explicitly--just like the BEGIN() and END() +functions. + +In the tie() call, C is the name of the variable to be +enchanted. C is the name of a class implementing objects of +the correct type. Any additional arguments in the C are passed to +the appropriate constructor method for that class--meaning TIESCALAR(), +TIEARRAY(), TIEHASH(), or TIEHANDLE(). (Typically these are arguments +such as might be passed to the dbminit() function of C.) The object +returned by the "new" method is also returned by the tie() function, +which would be useful if you wanted to access other methods in +C. (You don't actually have to return a reference to a right +"type" (e.g., HASH or C) so long as it's a properly blessed +object.) You can also retrieve a reference to the underlying object +using the tied() function. + +Unlike dbmopen(), the tie() function will not C or C a module +for you--you need to do that explicitly yourself. + +=head2 Tying Scalars + +A class implementing a tied scalar should define the following methods: +TIESCALAR, FETCH, STORE, and possibly DESTROY. + +Let's look at each in turn, using as an example a tie class for +scalars that allows the user to do something like: + + tie $his_speed, 'Nice', getppid(); + tie $my_speed, 'Nice', $$; + +And now whenever either of those variables is accessed, its current +system priority is retrieved and returned. If those variables are set, +then the process's priority is changed! + +We'll use Jarkko Hietaniemi >'s BSD::Resource class (not +included) to access the PRIO_PROCESS, PRIO_MIN, and PRIO_MAX constants +from your system, as well as the getpriority() and setpriority() system +calls. Here's the preamble of the class. + + package Nice; + use Carp; + use BSD::Resource; + use strict; + $Nice::DEBUG = 0 unless defined $Nice::DEBUG; + +=over + +=item TIESCALAR classname, LIST + +This is the constructor for the class. That means it is +expected to return a blessed reference to a new scalar +(probably anonymous) that it's creating. For example: + + sub TIESCALAR { + my $class = shift; + my $pid = shift || $$; # 0 means me + + if ($pid !~ /^\d+$/) { + carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W; + return undef; + } + + unless (kill 0, $pid) { # EPERM or ERSCH, no doubt + carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W; + return undef; + } + + return bless \$pid, $class; + } + +This tie class has chosen to return an error rather than raising an +exception if its constructor should fail. While this is how dbmopen() works, +other classes may well not wish to be so forgiving. It checks the global +variable C<$^W> to see whether to emit a bit of noise anyway. + +=item FETCH this + +This method will be triggered every time the tied variable is accessed +(read). It takes no arguments beyond its self reference, which is the +object representing the scalar we're dealing with. Because in this case +we're using just a SCALAR ref for the tied scalar object, a simple $$self +allows the method to get at the real value stored there. In our example +below, that real value is the process ID to which we've tied our variable. + + sub FETCH { + my $self = shift; + confess "wrong type" unless ref $self; + croak "usage error" if @_; + my $nicety; + local($!) = 0; + $nicety = getpriority(PRIO_PROCESS, $$self); + if ($!) { croak "getpriority failed: $!" } + return $nicety; + } + +This time we've decided to blow up (raise an exception) if the renice +fails--there's no place for us to return an error otherwise, and it's +probably the right thing to do. + +=item STORE this, value + +This method will be triggered every time the tied variable is set +(assigned). Beyond its self reference, it also expects one (and only one) +argument--the new value the user is trying to assign. + + sub STORE { + my $self = shift; + confess "wrong type" unless ref $self; + my $new_nicety = shift; + croak "usage error" if @_; + + if ($new_nicety < PRIO_MIN) { + carp sprintf + "WARNING: priority %d less than minimum system priority %d", + $new_nicety, PRIO_MIN if $^W; + $new_nicety = PRIO_MIN; + } + + if ($new_nicety > PRIO_MAX) { + carp sprintf + "WARNING: priority %d greater than maximum system priority %d", + $new_nicety, PRIO_MAX if $^W; + $new_nicety = PRIO_MAX; + } + + unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) { + confess "setpriority failed: $!"; + } + return $new_nicety; + } + +=item DESTROY this + +This method will be triggered when the tied variable needs to be destructed. +As with other object classes, such a method is seldom necessary, because Perl +deallocates its moribund object's memory for you automatically--this isn't +C++, you know. We'll use a DESTROY method here for debugging purposes only. + + sub DESTROY { + my $self = shift; + confess "wrong type" unless ref $self; + carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG; + } + +=back + +That's about all there is to it. Actually, it's more than all there +is to it, because we've done a few nice things here for the sake +of completeness, robustness, and general aesthetics. Simpler +TIESCALAR classes are certainly possible. + +=head2 Tying Arrays + +A class implementing a tied ordinary array should define the following +methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY. + +FETCHSIZE and STORESIZE are used to provide C<$#array> and +equivalent C access. + +The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE are required if the perl +operator with the corresponding (but lowercase) name is to operate on the +tied array. The B class can be used as a base class to implement +these in terms of the basic five methods above. + +In addition EXTEND will be called when perl would have pre-extended +allocation in a real array. + +This means that tied arrays are now I. The example below needs +upgrading to illustrate this. (The documentation in B is more +complete.) + +For this discussion, we'll implement an array whose indices are fixed at +its creation. If you try to access anything beyond those bounds, you'll +take an exception. For example: + + require Bounded_Array; + tie @ary, 'Bounded_Array', 2; + $| = 1; + for $i (0 .. 10) { + print "setting index $i: "; + $ary[$i] = 10 * $i; + $ary[$i] = 10 * $i; + print "value of elt $i now $ary[$i]\n"; + } + +The preamble code for the class is as follows: + + package Bounded_Array; + use Carp; + use strict; + +=over + +=item TIEARRAY classname, LIST + +This is the constructor for the class. That means it is expected to +return a blessed reference through which the new array (probably an +anonymous ARRAY ref) will be accessed. + +In our example, just to show you that you don't I have to return an +ARRAY reference, we'll choose a HASH reference to represent our object. +A HASH works out well as a generic record type: the C<{BOUND}> field will +store the maximum bound allowed, and the C<{ARRAY}> field will hold the +true ARRAY ref. If someone outside the class tries to dereference the +object returned (doubtless thinking it an ARRAY ref), they'll blow up. +This just goes to show you that you should respect an object's privacy. + + sub TIEARRAY { + my $class = shift; + my $bound = shift; + confess "usage: tie(\@ary, 'Bounded_Array', max_subscript)" + if @_ || $bound =~ /\D/; + return bless { + BOUND => $bound, + ARRAY => [], + }, $class; + } + +=item FETCH this, index + +This method will be triggered every time an individual element the tied array +is accessed (read). It takes one argument beyond its self reference: the +index whose value we're trying to fetch. + + sub FETCH { + my($self,$idx) = @_; + if ($idx > $self->{BOUND}) { + confess "Array OOB: $idx > $self->{BOUND}"; + } + return $self->{ARRAY}[$idx]; + } + +As you may have noticed, the name of the FETCH method (et al.) is the same +for all accesses, even though the constructors differ in names (TIESCALAR +vs TIEARRAY). While in theory you could have the same class servicing +several tied types, in practice this becomes cumbersome, and it's easiest +to keep them at simply one tie type per class. + +=item STORE this, index, value + +This method will be triggered every time an element in the tied array is set +(written). It takes two arguments beyond its self reference: the index at +which we're trying to store something and the value we're trying to put +there. For example: + + sub STORE { + my($self, $idx, $value) = @_; + print "[STORE $value at $idx]\n" if _debug; + if ($idx > $self->{BOUND} ) { + confess "Array OOB: $idx > $self->{BOUND}"; + } + return $self->{ARRAY}[$idx] = $value; + } + +=item DESTROY this + +This method will be triggered when the tied variable needs to be destructed. +As with the scalar tie class, this is almost never needed in a +language that does its own garbage collection, so this time we'll +just leave it out. + +=back + +The code we presented at the top of the tied array class accesses many +elements of the array, far more than we've set the bounds to. Therefore, +it will blow up once they try to access beyond the 2nd element of @ary, as +the following output demonstrates: + + setting index 0: value of elt 0 now 0 + setting index 1: value of elt 1 now 10 + setting index 2: value of elt 2 now 20 + setting index 3: Array OOB: 3 > 2 at Bounded_Array.pm line 39 + Bounded_Array::FETCH called at testba line 12 + +=head2 Tying Hashes + +As the first Perl data type to be tied (see dbmopen()), hashes have the +most complete and useful tie() implementation. A class implementing a +tied hash should define the following methods: TIEHASH is the constructor. +FETCH and STORE access the key and value pairs. EXISTS reports whether a +key is present in the hash, and DELETE deletes one. CLEAR empties the +hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY +implement the keys() and each() functions to iterate over all the keys. +And DESTROY is called when the tied variable is garbage collected. + +If this seems like a lot, then feel free to inherit from merely the +standard Tie::Hash module for most of your methods, redefining only the +interesting ones. See L for details. + +Remember that Perl distinguishes between a key not existing in the hash, +and the key existing in the hash but having a corresponding value of +C. The two possibilities can be tested with the C and +C functions. + +Here's an example of a somewhat interesting tied hash class: it gives you +a hash representing a particular user's dot files. You index into the hash +with the name of the file (minus the dot) and you get back that dot file's +contents. For example: + + use DotFiles; + tie %dot, 'DotFiles'; + if ( $dot{profile} =~ /MANPATH/ || + $dot{login} =~ /MANPATH/ || + $dot{cshrc} =~ /MANPATH/ ) + { + print "you seem to set your MANPATH\n"; + } + +Or here's another sample of using our tied class: + + tie %him, 'DotFiles', 'daemon'; + foreach $f ( keys %him ) { + printf "daemon dot file %s is size %d\n", + $f, length $him{$f}; + } + +In our tied hash DotFiles example, we use a regular +hash for the object containing several important +fields, of which only the C<{LIST}> field will be what the +user thinks of as the real hash. + +=over 5 + +=item USER + +whose dot files this object represents + +=item HOME + +where those dot files live + +=item CLOBBER + +whether we should try to change or remove those dot files + +=item LIST + +the hash of dot file names and content mappings + +=back + +Here's the start of F: + + package DotFiles; + use Carp; + sub whowasi { (caller(1))[3] . '()' } + my $DEBUG = 0; + sub debug { $DEBUG = @_ ? shift : 1 } + +For our example, we want to be able to emit debugging info to help in tracing +during development. We keep also one convenience function around +internally to help print out warnings; whowasi() returns the function name +that calls it. + +Here are the methods for the DotFiles tied hash. + +=over + +=item TIEHASH classname, LIST + +This is the constructor for the class. That means it is expected to +return a blessed reference through which the new object (probably but not +necessarily an anonymous hash) will be accessed. + +Here's the constructor: + + sub TIEHASH { + my $self = shift; + my $user = shift || $>; + my $dotdir = shift || ''; + croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_; + $user = getpwuid($user) if $user =~ /^\d+$/; + my $dir = (getpwnam($user))[7] + || croak "@{[&whowasi]}: no user $user"; + $dir .= "/$dotdir" if $dotdir; + + my $node = { + USER => $user, + HOME => $dir, + LIST => {}, + CLOBBER => 0, + }; + + opendir(DIR, $dir) + || croak "@{[&whowasi]}: can't opendir $dir: $!"; + foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) { + $dot =~ s/^\.//; + $node->{LIST}{$dot} = undef; + } + closedir DIR; + return bless $node, $self; + } + +It's probably worth mentioning that if you're going to filetest the +return values out of a readdir, you'd better prepend the directory +in question. Otherwise, because we didn't chdir() there, it would +have been testing the wrong file. + +=item FETCH this, key + +This method will be triggered every time an element in the tied hash is +accessed (read). It takes one argument beyond its self reference: the key +whose value we're trying to fetch. + +Here's the fetch for our DotFiles example. + + sub FETCH { + carp &whowasi if $DEBUG; + my $self = shift; + my $dot = shift; + my $dir = $self->{HOME}; + my $file = "$dir/.$dot"; + + unless (exists $self->{LIST}->{$dot} || -f $file) { + carp "@{[&whowasi]}: no $dot file" if $DEBUG; + return undef; + } + + if (defined $self->{LIST}->{$dot}) { + return $self->{LIST}->{$dot}; + } else { + return $self->{LIST}->{$dot} = `cat $dir/.$dot`; + } + } + +It was easy to write by having it call the Unix cat(1) command, but it +would probably be more portable to open the file manually (and somewhat +more efficient). Of course, because dot files are a Unixy concept, we're +not that concerned. + +=item STORE this, key, value + +This method will be triggered every time an element in the tied hash is set +(written). It takes two arguments beyond its self reference: the index at +which we're trying to store something, and the value we're trying to put +there. + +Here in our DotFiles example, we'll be careful not to let +them try to overwrite the file unless they've called the clobber() +method on the original object reference returned by tie(). + + sub STORE { + carp &whowasi if $DEBUG; + my $self = shift; + my $dot = shift; + my $value = shift; + my $file = $self->{HOME} . "/.$dot"; + my $user = $self->{USER}; + + croak "@{[&whowasi]}: $file not clobberable" + unless $self->{CLOBBER}; + + open(F, "> $file") || croak "can't open $file: $!"; + print F $value; + close(F); + } + +If they wanted to clobber something, they might say: + + $ob = tie %daemon_dots, 'daemon'; + $ob->clobber(1); + $daemon_dots{signature} = "A true daemon\n"; + +Another way to lay hands on a reference to the underlying object is to +use the tied() function, so they might alternately have set clobber +using: + + tie %daemon_dots, 'daemon'; + tied(%daemon_dots)->clobber(1); + +The clobber method is simply: + + sub clobber { + my $self = shift; + $self->{CLOBBER} = @_ ? shift : 1; + } + +=item DELETE this, key + +This method is triggered when we remove an element from the hash, +typically by using the delete() function. Again, we'll +be careful to check whether they really want to clobber files. + + sub DELETE { + carp &whowasi if $DEBUG; + + my $self = shift; + my $dot = shift; + my $file = $self->{HOME} . "/.$dot"; + croak "@{[&whowasi]}: won't remove file $file" + unless $self->{CLOBBER}; + delete $self->{LIST}->{$dot}; + my $success = unlink($file); + carp "@{[&whowasi]}: can't unlink $file: $!" unless $success; + $success; + } + +The value returned by DELETE becomes the return value of the call +to delete(). If you want to emulate the normal behavior of delete(), +you should return whatever FETCH would have returned for this key. +In this example, we have chosen instead to return a value which tells +the caller whether the file was successfully deleted. + +=item CLEAR this + +This method is triggered when the whole hash is to be cleared, usually by +assigning the empty list to it. + +In our example, that would remove all the user's dot files! It's such a +dangerous thing that they'll have to set CLOBBER to something higher than +1 to make it happen. + + sub CLEAR { + carp &whowasi if $DEBUG; + my $self = shift; + croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}" + unless $self->{CLOBBER} > 1; + my $dot; + foreach $dot ( keys %{$self->{LIST}}) { + $self->DELETE($dot); + } + } + +=item EXISTS this, key + +This method is triggered when the user uses the exists() function +on a particular hash. In our example, we'll look at the C<{LIST}> +hash element for this: + + sub EXISTS { + carp &whowasi if $DEBUG; + my $self = shift; + my $dot = shift; + return exists $self->{LIST}->{$dot}; + } + +=item FIRSTKEY this + +This method will be triggered when the user is going +to iterate through the hash, such as via a keys() or each() +call. + + sub FIRSTKEY { + carp &whowasi if $DEBUG; + my $self = shift; + my $a = keys %{$self->{LIST}}; # reset each() iterator + each %{$self->{LIST}} + } + +=item NEXTKEY this, lastkey + +This method gets triggered during a keys() or each() iteration. It has a +second argument which is the last key that had been accessed. This is +useful if you're carrying about ordering or calling the iterator from more +than one sequence, or not really storing things in a hash anywhere. + +For our example, we're using a real hash so we'll do just the simple +thing, but we'll have to go through the LIST field indirectly. + + sub NEXTKEY { + carp &whowasi if $DEBUG; + my $self = shift; + return each %{ $self->{LIST} } + } + +=item DESTROY this + +This method is triggered when a tied hash is about to go out of +scope. You don't really need it unless you're trying to add debugging +or have auxiliary state to clean up. Here's a very simple function: + + sub DESTROY { + carp &whowasi if $DEBUG; + } + +=back + +Note that functions such as keys() and values() may return huge lists +when used on large objects, like DBM files. You may prefer to use the +each() function to iterate over such. Example: + + # print out history file offsets + use NDBM_File; + tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0); + while (($key,$val) = each %HIST) { + print $key, ' = ', unpack('L',$val), "\n"; + } + untie(%HIST); + +=head2 Tying FileHandles + +This is partially implemented now. + +A class implementing a tied filehandle should define the following +methods: TIEHANDLE, at least one of PRINT, PRINTF, WRITE, READLINE, GETC, +READ, and possibly CLOSE and DESTROY. + +It is especially useful when perl is embedded in some other program, +where output to STDOUT and STDERR may have to be redirected in some +special way. See nvi and the Apache module for examples. + +In our example we're going to create a shouting handle. + + package Shout; + +=over + +=item TIEHANDLE classname, LIST + +This is the constructor for the class. That means it is expected to +return a blessed reference of some sort. The reference can be used to +hold some internal information. + + sub TIEHANDLE { print "\n"; my $i; bless \$i, shift } + +=item WRITE this, LIST + +This method will be called when the handle is written to via the +C function. + + sub WRITE { + $r = shift; + my($buf,$len,$offset) = @_; + print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset"; + } + +=item PRINT this, LIST + +This method will be triggered every time the tied handle is printed to +with the C function. +Beyond its self reference it also expects the list that was passed to +the print function. + + sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ } + +=item PRINTF this, LIST + +This method will be triggered every time the tied handle is printed to +with the C function. +Beyond its self reference it also expects the format and list that was +passed to the printf function. + + sub PRINTF { + shift; + my $fmt = shift; + print sprintf($fmt, @_)."\n"; + } + +=item READ this, LIST + +This method will be called when the handle is read from via the C +or C functions. + + sub READ { + $r = shift; + my($buf,$len,$offset) = @_; + print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset"; + } + +=item READLINE this + +This method will be called when the handle is read from via . +The method should return undef when there is no more data. + + sub READLINE { $r = shift; "PRINT called $$r times\n"; } + +=item GETC this + +This method will be called when the C function is called. + + sub GETC { print "Don't GETC, Get Perl"; return "a"; } + +=item CLOSE this + +This method will be called when the handle is closed via the C +function. + + sub CLOSE { print "CLOSE called.\n" } + +=item DESTROY this + +As with the other types of ties, this method will be called when the +tied handle is about to be destroyed. This is useful for debugging and +possibly cleaning up. + + sub DESTROY { print "\n" } + +=back + +Here's how to use our little example: + + tie(*FOO,'Shout'); + print FOO "hello\n"; + $a = 4; $b = 6; + print FOO $a, " plus ", $b, " equals ", $a + $b, "\n"; + print ; + +=head2 The C Gotcha + +If you intend making use of the object returned from either tie() or +tied(), and if the tie's target class defines a destructor, there is a +subtle gotcha you I guard against. + +As setup, consider this (admittedly rather contrived) example of a +tie; all it does is use a file to keep a log of the values assigned to +a scalar. + + package Remember; + + use strict; + use IO::File; + + sub TIESCALAR { + my $class = shift; + my $filename = shift; + my $handle = new IO::File "> $filename" + or die "Cannot open $filename: $!\n"; + + print $handle "The Start\n"; + bless {FH => $handle, Value => 0}, $class; + } + + sub FETCH { + my $self = shift; + return $self->{Value}; + } + + sub STORE { + my $self = shift; + my $value = shift; + my $handle = $self->{FH}; + print $handle "$value\n"; + $self->{Value} = $value; + } + + sub DESTROY { + my $self = shift; + my $handle = $self->{FH}; + print $handle "The End\n"; + close $handle; + } + + 1; + +Here is an example that makes use of this tie: + + use strict; + use Remember; + + my $fred; + tie $fred, 'Remember', 'myfile.txt'; + $fred = 1; + $fred = 4; + $fred = 5; + untie $fred; + system "cat myfile.txt"; + +This is the output when it is executed: + + The Start + 1 + 4 + 5 + The End + +So far so good. Those of you who have been paying attention will have +spotted that the tied object hasn't been used so far. So lets add an +extra method to the Remember class to allow comments to be included in +the file -- say, something like this: + + sub comment { + my $self = shift; + my $text = shift; + my $handle = $self->{FH}; + print $handle $text, "\n"; + } + +And here is the previous example modified to use the C method +(which requires the tied object): + + use strict; + use Remember; + + my ($fred, $x); + $x = tie $fred, 'Remember', 'myfile.txt'; + $fred = 1; + $fred = 4; + comment $x "changing..."; + $fred = 5; + untie $fred; + system "cat myfile.txt"; + +When this code is executed there is no output. Here's why: + +When a variable is tied, it is associated with the object which is the +return value of the TIESCALAR, TIEARRAY, or TIEHASH function. This +object normally has only one reference, namely, the implicit reference +from the tied variable. When untie() is called, that reference is +destroyed. Then, as in the first example above, the object's +destructor (DESTROY) is called, which is normal for objects that have +no more valid references; and thus the file is closed. + +In the second example, however, we have stored another reference to +the tied object in C<$x>. That means that when untie() gets called +there will still be a valid reference to the object in existence, so +the destructor is not called at that time, and thus the file is not +closed. The reason there is no output is because the file buffers +have not been flushed to disk. + +Now that you know what the problem is, what can you do to avoid it? +Well, the good old C<-w> flag will spot any instances where you call +untie() and there are still valid references to the tied object. If +the second script above is run with the C<-w> flag, Perl prints this +warning message: + + untie attempted while 1 inner references still exist + +To get the script to work properly and silence the warning make sure +there are no valid references to the tied object I untie() is +called: + + undef $x; + untie $fred; + +=head1 SEE ALSO + +See L or L for some interesting tie() implementations. + +=head1 BUGS + +Tied arrays are I. They are also distinctly lacking something +for the C<$#ARRAY> access (which is hard, as it's an lvalue), as well as +the other obvious array functions, like push(), pop(), shift(), unshift(), +and splice(). + +You cannot easily tie a multilevel data structure (such as a hash of +hashes) to a dbm file. The first problem is that all but GDBM and +Berkeley DB have size limitations, but beyond that, you also have problems +with how references are to be represented on disk. One experimental +module that does attempt to address this need partially is the MLDBM +module. Check your nearest CPAN site as described in L for +source code to MLDBM. + +=head1 AUTHOR + +Tom Christiansen + +TIEHANDLE by Sven Verdoolaege > and Doug MacEachern > diff --git a/contrib/perl5/pod/perltoc.pod b/contrib/perl5/pod/perltoc.pod new file mode 100644 index 00000000000..980ca8f943e --- /dev/null +++ b/contrib/perl5/pod/perltoc.pod @@ -0,0 +1,5840 @@ + +=head1 NAME + +perltoc - perl documentation table of contents + +=head1 DESCRIPTION + +This page provides a brief table of contents for the rest of the Perl +documentation set. It is meant to be scanned quickly or grepped +through to locate the proper section you're looking for. + +=head1 BASIC DOCUMENTATION + +=head2 perl - Practical Extraction and Report Language + +=item SYNOPSIS + +=item DESCRIPTION + +Many usability enhancements, Simplified grammar, Lexical scoping, +Arbitrarily nested data structures, Modularity and reusability, +Object-oriented programming, Embeddable and Extensible, POSIX compliant, +Package constructors and destructors, Multiple simultaneous DBM +implementations, Subroutine definitions may now be autoloaded, Regular +expression enhancements, Innumerable Unbundled Modules, Compilability + +=item ENVIRONMENT + +=item AUTHOR + +=item FILES + +=item SEE ALSO + +=item DIAGNOSTICS + +=item BUGS + +=item NOTES + +=head2 perlfaq - frequently asked questions about Perl ($Date: 1998/07/20 +23:12:17 $) + +=item DESCRIPTION + +perlfaq: Structural overview of the FAQ, L: General Questions +About Perl, L: Obtaining and Learning about Perl, L: +Programming Tools, L: Data Manipulation, L: Files and +Formats, L: Regexps, L: General Perl Language Issues, +L: System Interaction, L: Networking + +=over + +=item Where to get this document + +=item How to contribute to this document + +=item What will happen if you mail your Perl programming problems to the +authors + +=back + +=item Credits + +=item Author and Copyright Information + +=over + +=item Bundled Distributions + +=item Disclaimer + +=back + +=item Changes + +24/April/97, 23/April/97, 25/March/97, 18/March/97, 17/March/97 Version, +Initial Release: 11/March/97 + +=head2 perlfaq1 - General Questions About Perl ($Revision: 1.14 $, $Date: +1998/06/14 22:15:25 $) + +=item DESCRIPTION + +=over + +=item What is Perl? + +=item Who supports Perl? Who develops it? Why is it free? + +=item Which version of Perl should I use? + +=item What are perl4 and perl5? + +=item How stable is Perl? + +=item Is Perl difficult to learn? + +=item How does Perl compare with other languages like Java, Python, REXX, +Scheme, or Tcl? + +=item Can I do [task] in Perl? + +=item When shouldn't I program in Perl? + +=item What's the difference between "perl" and "Perl"? + +=item Is it a Perl program or a Perl script? + +=item What is a JAPH? + +=item Where can I get a list of Larry Wall witticisms? + +=item How can I convince my sysadmin/supervisor/employees to use version +(5/5.004/Perl instead of some other language)? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.24 $, +$Date: 1998/07/20 23:40:28 $) + +=item DESCRIPTION + +=over + +=item What machines support Perl? Where do I get it? + +=item How can I get a binary version of Perl? + +=item I don't have a C compiler on my system. How can I compile perl? + +=item I copied the Perl binary from one machine to another, but scripts +don't work. + +=item I grabbed the sources and tried to compile but gdbm/dynamic +loading/malloc/linking/... failed. How do I make it work? + +=item What modules and extensions are available for Perl? What is CPAN? +What does CPAN/src/... mean? + +=item Is there an ISO or ANSI certified version of Perl? + +=item Where can I get information on Perl? + +=item What are the Perl newsgroups on USENET? Where do I post questions? + +=item Where should I post source code? + +=item Perl Books + +References, Tutorials +*Learning Perl [2nd edition] +by Randal L. Schwartz and Tom Christiansen, Task-Oriented, Special Topics + +=item Perl in Magazines + +=item Perl on the Net: FTP and WWW Access + +=item What mailing lists are there for perl? + +MacPerl, Perl5-Porters, NTPerl, Perl-Packrats + +=item Archives of comp.lang.perl.misc + +=item Where can I buy a commercial version of Perl? + +=item Where do I send bug reports? + +=item What is perl.com? perl.org? The Perl Institute? + +=item How do I learn about object-oriented Perl programming? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq3 - Programming Tools ($Revision: 1.28 $, $Date: 1998/07/16 +22:08:49 $) + +=item DESCRIPTION + +=over + +=item How do I do (anything)? + +=item How can I use Perl interactively? + +=item Is there a Perl shell? + +=item How do I debug my Perl programs? + +=item How do I profile my Perl programs? + +=item How do I cross-reference my Perl programs? + +=item Is there a pretty-printer (formatter) for Perl? + +=item Is there a ctags for Perl? + +=item Where can I get Perl macros for vi? + +=item Where can I get perl-mode for emacs? + +=item How can I use curses with Perl? + +=item How can I use X or Tk with Perl? + +=item How can I generate simple menus without using CGI or Tk? + +=item What is undump? + +=item How can I make my Perl program run faster? + +=item How can I make my Perl program take less memory? + +=item Is it unsafe to return a pointer to local data? + +=item How can I free an array or hash so my program shrinks? + +=item How can I make my CGI script more efficient? + +=item How can I hide the source for my Perl program? + +=item How can I compile my Perl program into byte code or C? + +=item How can I get C<#!perl> to work on [MS-DOS,NT,...]? + +=item Can I write useful perl programs on the command line? + +=item Why don't perl one-liners work on my DOS/Mac/VMS system? + +=item Where can I learn about CGI or Web programming in Perl? + +=item Where can I learn about object-oriented Perl programming? + +=item Where can I learn about linking C with Perl? [h2xs, xsubpp] + +=item I've read perlembed, perlguts, etc., but I can't embed perl in +my C program, what am I doing wrong? + +=item When I tried to run my script, I got this message. What does it +mean? + +=item What's MakeMaker? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq4 - Data Manipulation ($Revision: 1.25 $, $Date: 1998/07/16 +22:49:55 $) + +=item DESCRIPTION + +=item Data: Numbers + +=over + +=item Why am I getting long decimals (eg, 19.9499999999999) instead of the +numbers I should be getting (eg, 19.95)? + +=item Why isn't my octal data interpreted correctly? + +=item Does perl have a round function? What about ceil() and floor()? +Trig functions? + +=item How do I convert bits into ints? + +=item How do I multiply matrices? + +=item How do I perform an operation on a series of integers? + +=item How can I output Roman numerals? + +=item Why aren't my random numbers random? + +=back + +=item Data: Dates + +=over + +=item How do I find the week-of-the-year/day-of-the-year? + +=item How can I compare two dates and find the difference? + +=item How can I take a string and turn it into epoch seconds? + +=item How can I find the Julian Day? + +=item Does Perl have a year 2000 problem? Is Perl Y2K compliant? + +=back + +=item Data: Strings + +=over + +=item How do I validate input? + +=item How do I unescape a string? + +=item How do I remove consecutive pairs of characters? + +=item How do I expand function calls in a string? + +=item How do I find matching/nesting anything? + +=item How do I reverse a string? + +=item How do I expand tabs in a string? + +=item How do I reformat a paragraph? + +=item How can I access/change the first N letters of a string? + +=item How do I change the Nth occurrence of something? + +=item How can I count the number of occurrences of a substring within a +string? + +=item How do I capitalize all the words on one line? + +=item How can I split a [character] delimited string except when inside +[character]? (Comma-separated files) + +=item How do I strip blank space from the beginning/end of a string? + +=item How do I extract selected columns from a string? + +=item How do I find the soundex value of a string? + +=item How can I expand variables in text strings? + +=item What's wrong with always quoting "$vars"? + +=item Why don't my <? + +=item Is there a leak/bug in glob()? + +=item How can I open a file with a leading "E" or trailing blanks? + +=item How can I reliably rename a file? + +=item How can I lock a file? + +=item What can't I just open(FH, ">file.lock")? + +=item I still don't get locking. I just want to increment the number in +the file. How can I do this? + +=item How do I randomly update a binary file? + +=item How do I get a file's timestamp in perl? + +=item How do I set a file's timestamp in perl? + +=item How do I print to more than one file at once? + +=item How can I read in a file by paragraphs? + +=item How can I read a single character from a file? From the keyboard? + +=item How can I tell if there's a character waiting on a filehandle? + +=item How do I do a C in perl? + +=item How do I dup() a filehandle in Perl? + +=item How do I close a file descriptor by number? + +=item Why can't I use "C:\temp\foo" in DOS paths? What doesn't +`C:\temp\foo.exe` work? + +=item Why doesn't glob("*.*") get all the files? + +=item Why does Perl let me delete read-only files? Why does C<-i> clobber +protected files? Isn't this a bug in Perl? + +=item How do I select a random line from a file? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq6 - Regexps ($Revision: 1.22 $, $Date: 1998/07/16 14:01:07 $) + +=item DESCRIPTION + +=over + +=item How can I hope to use regular expressions without creating illegible +and unmaintainable code? + +Comments Outside the Regexp, Comments Inside the Regexp, Different +Delimiters + +=item I'm having trouble matching over more than one line. What's wrong? + +=item How can I pull out lines between two patterns that are themselves on +different lines? + +=item I put a regular expression into $/ but it didn't work. What's wrong? + +=item How do I substitute case insensitively on the LHS, but preserving +case on the RHS? + +=item How can I make C<\w> match national character sets? + +=item How can I match a locale-smart version of C? + +=item How can I quote a variable to use in a regexp? + +=item What is C really for? + +=item How do I use a regular expression to strip C style comments from a +file? + +=item Can I use Perl regular expressions to match balanced text? + +=item What does it mean that regexps are greedy? How can I get around it? + +=item How do I process each word on each line? + +=item How can I print out a word-frequency or line-frequency summary? + +=item How can I do approximate matching? + +=item How do I efficiently match many regular expressions at once? + +=item Why don't word-boundary searches with C<\b> work for me? + +=item Why does using $&, $`, or $' slow my program down? + +=item What good is C<\G> in a regular expression? + +=item Are Perl regexps DFAs or NFAs? Are they POSIX compliant? + +=item What's wrong with using grep or map in a void context? + +=item How can I match strings with multibyte characters? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq7 - Perl Language Issues ($Revision: 1.21 $, $Date: +1998/06/22 15:20:07 $) + +=item DESCRIPTION + +=over + +=item Can I get a BNF/yacc/RE for the Perl language? + +=item What are all these $@%* punctuation signs, and how do I know when to +use them? + +=item Do I always/never have to quote my strings or use semicolons and +commas? + +=item How do I skip some return values? + +=item How do I temporarily block warnings? + +=item What's an extension? + +=item Why do Perl operators have different precedence than C operators? + +=item How do I declare/create a structure? + +=item How do I create a module? + +=item How do I create a class? + +=item How can I tell if a variable is tainted? + +=item What's a closure? + +=item What is variable suicide and how can I prevent it? + +=item How can I pass/return a {Function, FileHandle, Array, Hash, Method, +Regexp}? + +Passing Variables and Functions, Passing Filehandles, Passing Regexps, +Passing Methods + +=item How do I create a static variable? + +=item What's the difference between dynamic and lexical (static) scoping? +Between local() and my()? + +=item How can I access a dynamic variable while a similarly named lexical +is in scope? + +=item What's the difference between deep and shallow binding? + +=item Why doesn't "my($foo) = ;" work right? + +=item How do I redefine a builtin function, operator, or method? + +=item What's the difference between calling a function as &foo and foo()? + +=item How do I create a switch or case statement? + +=item How can I catch accesses to undefined variables/functions/methods? + +=item Why can't a method included in this same file be found? + +=item How can I find out my current package? + +=item How can I comment out a large block of perl code? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq8 - System Interaction ($Revision: 1.25 $, $Date: 1998/07/05 +15:07:20 $) + +=item DESCRIPTION + +=over + +=item How do I find out which operating system I'm running under? + +=item How come exec() doesn't return? + +=item How do I do fancy stuff with the keyboard/screen/mouse? + +Keyboard, Screen, Mouse + +=item How do I print something out in color? + +=item How do I read just one key without waiting for a return key? + +=item How do I check whether input is ready on the keyboard? + +=item How do I clear the screen? + +=item How do I get the screen size? + +=item How do I ask the user for a password? + +=item How do I read and write the serial port? + +lockfiles, open mode, end of line, flushing output, non-blocking input + +=item How do I decode encrypted password files? + +=item How do I start a process in the background? + +STDIN, STDOUT, and STDERR are shared, Signals, Zombies + +=item How do I trap control characters/signals? + +=item How do I modify the shadow password file on a Unix system? + +=item How do I set the time and date? + +=item How can I sleep() or alarm() for under a second? + +=item How can I measure time under a second? + +=item How can I do an atexit() or setjmp()/longjmp()? (Exception handling) + +=item Why doesn't my sockets program work under System V (Solaris)? What +does the error message "Protocol not supported" mean? + +=item How can I call my system's unique C functions from Perl? + +=item Where do I get the include files to do ioctl() or syscall()? + +=item Why do setuid perl scripts complain about kernel problems? + +=item How can I open a pipe both to and from a command? + +=item Why can't I get the output of a command with system()? + +=item How can I capture STDERR from an external command? + +=item Why doesn't open() return an error when a pipe open fails? + +=item What's wrong with using backticks in a void context? + +=item How can I call backticks without shell processing? + +=item Why can't my script read from STDIN after I gave it EOF (^D on Unix, +^Z on MS-DOS)? + +=item How can I convert my shell script to perl? + +=item Can I use perl to run a telnet or ftp session? + +=item How can I write expect in Perl? + +=item Is there a way to hide perl's command line from programs such as +"ps"? + +=item I {changed directory, modified my environment} in a perl script. How +come the change disappeared when I exited the script? How do I get my +changes to be visible? + +Unix + +=item How do I close a process's filehandle without waiting for it to +complete? + +=item How do I fork a daemon process? + +=item How do I make my program run with sh and csh? + +=item How do I find out if I'm running interactively or not? + +=item How do I timeout a slow event? + +=item How do I set CPU limits? + +=item How do I avoid zombies on a Unix system? + +=item How do I use an SQL database? + +=item How do I make a system() exit on control-C? + +=item How do I open a file without blocking? + +=item How do I install a CPAN module? + +=item What's the difference between require and use? + +=item How do I keep my own module/library directory? + +=item How do I add the directory my program lives in to the module/library +search path? + +=item How do I add a directory to my include path at runtime? + +=back + +=item AUTHOR AND COPYRIGHT + +=head2 perlfaq9 - Networking ($Revision: 1.20 $, $Date: 1998/06/22 18:31:09 +$) + +=item DESCRIPTION + +=over + +=item My CGI script runs from the command line but not the browser. (500 +Server Error) + +=item How can I get better error messages from a CGI program? + +=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 automate an HTML form submission? + +=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 a mail header? + +=item How do I decode a CGI form? + +=item How do I check a valid mail address? + +=item How do I decode a MIME/BASE64 string? + +=item How do I return the user's mail address? + +=item How do I send mail? + +=item How do I 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 perldelta - what's new for perl5.005 + +=item DESCRIPTION + +=item About the new versioning system + +=item Incompatible Changes + +=over + +=item WARNING: This version is not binary compatible with Perl 5.004. + +=item Default installation structure has changed + +=item Perl Source Compatibility + +=item C Source Compatibility + +Core sources now require ANSI C compiler, All Perl global variables must +now be referenced with an explicit prefix, Enabling threads has source +compatibility issues + +=item Binary Compatibility + +=item Security fixes may affect compatibility + +=item Relaxed new mandatory warnings introduced in 5.004 + +=item Licensing + +=back + +=item Core Changes + +=over + +=item Threads + +=item Compiler + +=item Regular Expressions + +Many new and improved optimizations, Many bug fixes, New regular expression +constructs, New operator for precompiled regular expressions, Other +improvements, Incompatible changes + +=item Improved malloc() + +=item Quicksort is internally implemented + +=item Reliable signals + +=item Reliable stack pointers + +=item More generous treatment of carriage returns + +=item Memory leaks + +=item Better support for multiple interpreters + +=item Behavior of local() on array and hash elements is now well-defined + +=item C<%!> is transparently tied to the L module + +=item Pseudo-hashes are supported + +=item C is supported + +=item Keywords can be globally overridden + +=item C<$^E> is meaningful on Win32 + +=item C optimized + +=item C can be used as implicitly quoted package name + +=item C tests existence of a package + +=item Better locale support + +=item Experimental support for 64-bit platforms + +=item prototype() returns useful results on builtins + +=item Extended support for exception handling + +=item Re-blessing in DESTROY() supported for chaining DESTROY() methods + +=item All C format conversions are handled internally + +=item New C keyword + +=item New C keyword + +=item New C operator + +=item C is now a reserved word + +=item Tied arrays are now fully supported + +=item Tied handles support is better + +=item 4th argument to substr + +=item Negative LENGTH argument to splice + +=item Magic lvalues are now more magical + +=item EE now reads in records + +=back + +=item Supported Platforms + +=over + +=item New Platforms + +=item Changes in existing support + +=back + +=item Modules and Pragmata + +=over + +=item New Modules + +B, Data::Dumper, Errno, File::Spec, ExtUtils::Installed, +ExtUtils::Packlist, Fatal, IPC::SysV, Test, Tie::Array, Tie::Handle, +Thread, attrs, fields, re + +=item Changes in existing modules + +CGI, POSIX, DB_File, MakeMaker, CPAN, Cwd, Benchmark + +=back + +=item Utility Changes + +=item Documentation Changes + +=item New Diagnostics + +Ambiguous call resolved as CORE::%s(), qualify as such or use &, Bad index +while coercing array into hash, Bareword "%s" refers to nonexistent +package, Can't call method "%s" on an undefined value, Can't coerce array +into hash, Can't goto subroutine from an eval-string, Can't localize +pseudo-hash element, Can't use %%! because Errno.pm is not available, +Cannot find an opnumber for "%s", Character class syntax [. .] is reserved +for future extensions, Character class syntax [: :] is reserved for future +extensions, Character class syntax [= =] is reserved for future extensions, +%s: Eval-group in insecure regular expression, %s: Eval-group not allowed, +use re 'eval', %s: Eval-group not allowed at run time, Explicit blessing to +'' (assuming package main), Illegal hex digit ignored, No such array field, +No such field "%s" in variable %s of type %s, Out of memory during +ridiculously large request, Range iterator outside integer range, Recursive +inheritance detected while looking for method '%s' in package '%s', +Reference found where even-sized list expected, Undefined value assigned to +typeglob, Use of reserved word "%s" is deprecated, perl: warning: Setting +locale failed + +=item Obsolete Diagnostics + +Can't mktemp(), Can't write to temp file for B<-e>: %s, Cannot open +temporary file + +=item BUGS + +=item SEE ALSO + +=item HISTORY + +=head2 perldata - Perl data types + +=item DESCRIPTION + +=over + +=item Variable names + +=item Context + +=item Scalar values + +=item Scalar value constructors + +=item List value constructors + +=item Typeglobs and Filehandles + +=back + +=head2 perlsyn - Perl syntax + +=item DESCRIPTION + +=over + +=item Declarations + +=item Simple statements + +=item Compound statements + +=item Loop Control + +=item For Loops + +=item Foreach Loops + +=item Basic BLOCKs and Switch Statements + +=item Goto + +=item PODs: Embedded Documentation + +=item Plain Old Comments (Not!) + +=back + +=head2 perlop - Perl operators and precedence + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Terms and List Operators (Leftward) + +=item The Arrow Operator + +=item Auto-increment and Auto-decrement + +=item Exponentiation + +=item Symbolic Unary Operators + +=item Binding Operators + +=item Multiplicative Operators + +=item Additive Operators + +=item Shift Operators + +=item Named Unary Operators + +=item Relational Operators + +=item Equality Operators + +=item Bitwise And + +=item Bitwise Or and Exclusive Or + +=item C-style Logical And + +=item C-style Logical Or + +=item Range Operators + +=item Conditional Operator + +=item Assignment Operators + +=item Comma Operator + +=item List Operators (Rightward) + +=item Logical Not + +=item Logical And + +=item Logical or and Exclusive Or + +=item C Operators Missing From Perl + +unary &, unary *, (TYPE) + +=item Quote and Quote-like Operators + +=item Regexp Quote-Like Operators + +?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>, +qq/STRING/, "STRING", qr/STRING/imosx, qx/STRING/, `STRING`, qw/STRING/, +s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds, +y/SEARCHLIST/REPLACEMENTLIST/cds + +=item Gory details of parsing quoted constructs + +Finding the end, Removal of backslashes before delimiters, Interpolation, +C<<<'EOF'>, C, C, C    , C, C<''>, C, C<"">, +C<``>, C, C, C<>, C, C, C, +C,, Interpolation of regular expressions, Optimization of +regular expressions + +=item I/O Operators + +=item Constant Folding + +=item Bitwise String Operators + +=item Integer Arithmetic + +=item Floating-point Arithmetic + +=item Bigger Numbers + +=back + +=head2 perlre - Perl regular expressions + +=item DESCRIPTION + +i, m, s, x + +=over + +=item Regular Expressions + +C<(?#text)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, C<(?=pattern)>, +C<(?!pattern)>, C<(?E=pattern)>, C<(?, C<(?{ code })>, +C<(?Epattern)>, C<(?(condition)yes-pattern|no-pattern)>, +C<(?(condition)yes-pattern)>, C<(?imsx-imsx)> + +=item Backtracking + +=item Version 8 Regular Expressions + +=item WARNING on \1 vs $1 + +=item Repeated patterns matching zero-length substring + +=item Creating custom RE engines + +=item SEE ALSO + +=back + +=head2 perlrun - how to execute the Perl interpreter + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item #! and quoting on non-Unix systems + +OS/2, MS-DOS, Win95/NT, Macintosh + +=item Location of Perl + +=item Switches + +B<-0>[I], B<-a>, B<-c>, B<-d>, B<-d:>I, B<-D>I, +B<-D>I, B<-e> I, B<-F>I, B<-h>, +B<-i>[I], B<-I>I, B<-l>[I], +B<-m>[B<->]I, B<-M>[B<->]I, B<-M>[B<->]I<'module ...'>, +B<-[mM]>[B<->]I, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, +B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I, B<-w>, B<-x> I + +=back + +=item ENVIRONMENT + +HOME, LOGDIR, PATH, PERL5LIB, PERL5OPT, PERLLIB, PERL5DB, PERL5SHELL +(specific to WIN32 port), PERL_DEBUG_MSTATS, PERL_DESTRUCT_LEVEL + +=head2 perlfunc - Perl builtin functions + +=item DESCRIPTION + +=over + +=item Perl Functions by Category + +Functions for SCALARs or strings, Regular expressions and pattern matching, +Numeric functions, Functions for real @ARRAYs, Functions for list data, +Functions for real %HASHes, Input and output functions, Functions for fixed +length data or records, Functions for filehandles, files, or directories, +Keywords related to the control flow of your perl program, Keywords related +to scoping, Miscellaneous functions, Functions for processes and process +groups, Keywords related to perl modules, Keywords related to classes and +object-orientedness, Low-level socket functions, System V interprocess +communication functions, Fetching user and group info, Fetching network +info, Time-related functions, Functions new in perl5, Functions obsoleted +in perl5 + +=item Alphabetical Listing of Perl Functions + +I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept +NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME, +binmode FILEHANDLE, bless REF,CLASSNAME, bless REF, caller EXPR, caller, +chdir EXPR, chmod LIST, chomp VARIABLE, chomp LIST, chomp, chop VARIABLE, +chop LIST, chop, chown LIST, chr NUMBER, chr, chroot FILENAME, chroot, +close FILEHANDLE, close, closedir DIRHANDLE, connect SOCKET,NAME, continue +BLOCK, cos EXPR, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen +HASH,DBNAME,MODE, defined EXPR, defined, delete EXPR, die LIST, do BLOCK, +do SUBROUTINE(LIST), do EXPR, dump LABEL, each HASH, eof FILEHANDLE, eof +(), eof, eval EXPR, eval BLOCK, exec LIST, exec PROGRAM LIST, exists EXPR, +exit EXPR, exp EXPR, exp, fcntl FILEHANDLE,FUNCTION,SCALAR, fileno +FILEHANDLE, flock FILEHANDLE,OPERATION, fork, format, formline +PICTURE,LIST, getc FILEHANDLE, getc, getlogin, getpeername SOCKET, getpgrp +PID, getppid, getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, +gethostbyname NAME, getnetbyname NAME, getprotobyname NAME, getpwuid UID, +getgrgid GID, getservbyname NAME,PROTO, gethostbyaddr ADDR,ADDRTYPE, +getnetbyaddr ADDR,ADDRTYPE, getprotobynumber NUMBER, getservbyport +PORT,PROTO, getpwent, getgrent, gethostent, getnetent, getprotoent, +getservent, setpwent, setgrent, sethostent STAYOPEN, setnetent STAYOPEN, +setprotoent STAYOPEN, setservent STAYOPEN, endpwent, endgrent, endhostent, +endnetent, endprotoent, endservent, getsockname SOCKET, getsockopt +SOCKET,LEVEL,OPTNAME, glob EXPR, glob, gmtime EXPR, goto LABEL, goto EXPR, +goto &NAME, grep BLOCK LIST, grep EXPR,LIST, hex EXPR, hex, import, index +STR,SUBSTR,POSITION, index STR,SUBSTR, int EXPR, int, ioctl +FILEHANDLE,FUNCTION,SCALAR, join EXPR,LIST, keys HASH, kill LIST, last +LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, link +OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, log +EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map +EXPR,LIST, mkdir FILENAME,MODE, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd +ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, next, no +Module LIST, oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, opendir +DIRHANDLE,EXPR, ord EXPR, ord, pack TEMPLATE,LIST, package, package +NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos, +print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, +printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, +qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, +rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read +FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readline EXPR, readlink EXPR, +readlink, readpipe EXPR, recv SOCKET,SCALAR,LEN,FLAGS, redo LABEL, redo, +ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require, reset EXPR, +reset, return EXPR, return, reverse LIST, rewinddir DIRHANDLE, rindex +STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar +EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select +FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl +ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send +SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority +WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY, +shift, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, +shmwrite ID,STRING,POS,SIZE, shutdown SOCKET,HOW, sin EXPR, sin, sleep +EXPR, sleep, socket SOCKET,DOMAIN,TYPE,PROTOCOL, socketpair +SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, sort SUBNAME LIST, sort BLOCK LIST, +sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH, +splice ARRAY,OFFSET, split /PATTERN/,EXPR,LIMIT, split /PATTERN/,EXPR, +split /PATTERN/, split, sprintf FORMAT, LIST, sqrt EXPR, sqrt, srand EXPR, +srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, study, sub BLOCK, +sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN,REPLACEMENT, substr +EXPR,OFFSET,LEN, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, +sysopen FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, +sysread FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, +sysseek FILEHANDLE,POSITION,WHENCE, system LIST, system PROGRAM LIST, +syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite +FILEHANDLE,SCALAR,LENGTH, tell FILEHANDLE, tell, telldir DIRHANDLE, tie +VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, times, tr///, truncate +FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, +ucfirst, umask EXPR, umask, undef EXPR, undef, unlink LIST, unlink, unpack +TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use Module LIST, use +Module, use Module VERSION LIST, use VERSION, utime LIST, values HASH, vec +EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn LIST, write +FILEHANDLE, write EXPR, write, y/// + +=back + +=head2 perlvar - Perl predefined variables + +=item DESCRIPTION + +=over + +=item Predefined Names + +$ARG, $_, $EIE, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $', +$LAST_PAREN_MATCH, $+, $MULTILINE_MATCHING, $*, input_line_number HANDLE +EXPR, $INPUT_LINE_NUMBER, $NR, $, input_record_separator HANDLE EXPR, +$INPUT_RECORD_SEPARATOR, $RS, $/, autoflush HANDLE EXPR, $OUTPUT_AUTOFLUSH, +$|, output_field_separator HANDLE EXPR, $OUTPUT_FIELD_SEPARATOR, $OFS, $,, +output_record_separator HANDLE EXPR, $OUTPUT_RECORD_SEPARATOR, $ORS, $\, +$LIST_SEPARATOR, $", $SUBSCRIPT_SEPARATOR, $SUBSEP, $;, $OFMT, $#, +format_page_number HANDLE EXPR, $FORMAT_PAGE_NUMBER, $%, +format_lines_per_page HANDLE EXPR, $FORMAT_LINES_PER_PAGE, $=, +format_lines_left HANDLE EXPR, $FORMAT_LINES_LEFT, $-, format_name HANDLE +EXPR, $FORMAT_NAME, $~, format_top_name HANDLE EXPR, $FORMAT_TOP_NAME, $^, +format_line_break_characters HANDLE EXPR, $FORMAT_LINE_BREAK_CHARACTERS, +$:, format_formfeed HANDLE EXPR, $FORMAT_FORMFEED, $^L, $ACCUMULATOR, $^A, +$CHILD_ERROR, $?, $OS_ERROR, $ERRNO, $!, $EXTENDED_OS_ERROR, $^E, +$EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID, $UID, $<, +$EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(, +$EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $PERL_VERSION, $], +$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $^M, +$OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, $^R, $^S, +$BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @INC, +@_, %INC, %ENV $ENV{expr}, %SIG $SIG{expr} + +=item Error Indicators + +=back + +=head2 perlsub - Perl subroutines + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Private Variables via C + +=item Peristent Private Variables + +=item Temporary Values via local() + +=item Passing Symbol Table Entries (typeglobs) + +=item When to Still Use local() + +1. You need to give a global variable a temporary value, especially C<$_>, +2. You need to create a local file or directory handle or a local function, +3. You want to temporarily change just one element of an array or hash + +=item Pass by Reference + +=item Prototypes + +=item Constant Functions + +=item Overriding Builtin Functions + +=item Autoloading + +=back + +=item SEE ALSO + +=head2 perlmod - Perl modules (packages and symbol tables) + +=item DESCRIPTION + +=over + +=item Packages + +=item Symbol Tables + +=item Package Constructors and Destructors + +=item Perl Classes + +=item Perl Modules + +=back + +=item SEE ALSO + +=head2 perlmodlib - constructing new Perl modules and finding existing ones + +=item DESCRIPTION + +=item THE PERL MODULE LIBRARY + +=over + +=item Pragmatic Modules + +use autouse MODULE => qw(sub1 sub2 sub3), blib, diagnostics, integer, less, +lib, locale, ops, overload, re, sigtrap, strict, subs, vmsish, vars + +=item Standard Modules + +AnyDBM_File, AutoLoader, AutoSplit, Benchmark, CPAN, CPAN::FirstTime, +CPAN::Nox, Carp, Class::Struct, Config, Cwd, DB_File, Devel::SelfStubber, +DirHandle, DynaLoader, English, Env, Exporter, ExtUtils::Embed, +ExtUtils::Install, ExtUtils::Liblist, ExtUtils::MM_OS2, ExtUtils::MM_Unix, +ExtUtils::MM_VMS, ExtUtils::MakeMaker, ExtUtils::Manifest, +ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::testlib, Fatal, +Fcntl, File::Basename, File::CheckTree, File::Compare, File::Copy, +File::Find, File::Path, File::stat, FileCache, FileHandle, FindBin, +GDBM_File, Getopt::Long, Getopt::Std, I18N::Collate, IO, IO::File, +IO::Handle, IO::Pipe, IO::Seekable, IO::Select, IO::Socket, IPC::Open2, +IPC::Open3, Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig, +NDBM_File, Net::Ping, Net::hostent, Net::netent, Net::protoent, +Net::servent, Opcode, Pod::Text, POSIX, SDBM_File, Safe, Search::Dict, +SelectSaver, SelfLoader, Shell, Socket, Symbol, Sys::Hostname, Sys::Syslog, +Term::Cap, Term::Complete, Term::ReadLine, Test::Harness, Text::Abbrev, +Text::ParseWords, Text::Soundex, Text::Tabs, Text::Wrap, Tie::Hash, +Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local, Time::gmtime, +Time::localtime, Time::tm, UNIVERSAL, User::grent, User::pwent + +=item Extension Modules + +=back + +=item CPAN + +Language Extensions and Documentation Tools, Development Support, Operating +System Interfaces, Networking, Device Control (modems) and InterProcess +Communication, Data Types and Data Type Utilities, Database Interfaces, +User Interfaces, Interfaces to / Emulations of Other Programming Languages, +File Names, File Systems and File Locking (see also File Handles), String +Processing, Language Text Processing, Parsing, and Searching, Option, +Argument, Parameter, and Configuration File Processing, +Internationalization and Locale, Authentication, Security, and Encryption, +World Wide Web, HTML, HTTP, CGI, MIME, Server and Daemon Utilities, +Archiving and Compression, Images, Pixmap and Bitmap Manipulation, Drawing, +and Graphing, Mail and Usenet News, Control Flow Utilities (callbacks and +exceptions etc), File Handle and Input/Output Stream Utilities, +Miscellaneous Modules, Africa, Asia, Australasia, Europe, North America, +South America + +=item Modules: Creation, Use, and Abuse + +=over + +=item Guidelines for Module Creation + +Do similar modules already exist in some form?, Try to design the new +module to be easy to extend and reuse, Some simple style guidelines, Select +what to export, Select a name for the module, Have you got it right?, +README and other Additional Files, A description of the +module/package/extension etc, A copyright notice - see below, Prerequisites +- what else you may need to have, How to build it - possible changes to +Makefile.PL etc, How to install it, Recent changes in this release, +especially incompatibilities, Changes / enhancements you plan to make in +the future, Adding a Copyright Notice, Give the module a +version/issue/release number, How to release and distribute a module, Take +care when changing a released module + +=item Guidelines for Converting Perl 4 Library Scripts into Modules + +There is no requirement to convert anything, Consider the implications, +Make the most of the opportunity, The pl2pm utility will get you started, +Adds the standard Module prologue lines, Converts package specifiers from ' +to ::, Converts die(...) to croak(...), Several other minor changes + +=item Guidelines for Reusing Application Code + +Complete applications rarely belong in the Perl Module Library, Many +applications contain some Perl code that could be reused, Break-out the +reusable code into one or more separate module files, Take the opportunity +to reconsider and redesign the interfaces, In some cases the 'application' +can then be reduced to a small + +=back + +=item NOTE + +=head2 perlmodinstall - Installing CPAN Modules + +=item DESCRIPTION + +=over + +=item PREAMBLE + +B the file, B the file into a directory, B the +module (sometimes unnecessary), B the module + +=back + +=item HEY + +=item AUTHOR + +=item COPYRIGHT + +=head2 perlform - Perl formats + +=item DESCRIPTION + +=over + +=item Format Variables + +=back + +=item NOTES + +=over + +=item Footers + +=item Accessing Formatting Internals + +=back + +=item WARNINGS + +=head2 perllocale - Perl locale handling (internationalization and +localization) + +=item DESCRIPTION + +=item PREPARING TO USE LOCALES + +=item USING LOCALES + +=over + +=item The use locale pragma + +=item The setlocale function + +=item Finding locales + +=item LOCALE PROBLEMS + +=item Temporarily fixing locale problems + +=item Permanently fixing locale problems + +=item Permanently fixing your locale configuration + +=item Permanently fixing system locale configuration + +=item The localeconv function + +=back + +=item LOCALE CATEGORIES + +=over + +=item Category LC_COLLATE: Collation + +=item Category LC_CTYPE: Character Types + +=item Category LC_NUMERIC: Numeric Formatting + +=item Category LC_MONETARY: Formatting of monetary amounts + +=item LC_TIME + +=item Other categories + +=back + +=item SECURITY + +B (C, C, C, C and C):, +B (with C<\l>, C<\L>, C<\u> or C<\U>), +B (C):, B (C):, +B (sprintf()):, B (printf() and write()):, B (lc(), +lcfirst(), uc(), ucfirst()):, B +(localeconv(), strcoll(),strftime(), strxfrm()):, B (isalnum(), isalpha(), isdigit(),isgraph(), islower(), isprint(), +ispunct(), isspace(), isupper(), +isxdigit()): + +=item ENVIRONMENT + +PERL_BADLANG, LC_ALL, LC_CTYPE, LC_COLLATE, LC_MONETARY, LC_NUMERIC, +LC_TIME, LANG + +=item NOTES + +=over + +=item Backward compatibility + +=item I18N:Collate obsolete + +=item Sort speed and memory use impacts + +=item write() and LC_NUMERIC + +=item Freely available locale definitions + +=item I18n and l10n + +=item An imperfect standard + +=back + +=item BUGS + +=over + +=item Broken systems + +=back + +=item SEE ALSO + +=item HISTORY + +=head2 perlref - Perl references and nested data structures + +=item DESCRIPTION + +=over + +=item Making References + +=item Using References + +=item Symbolic references + +=item Not-so-symbolic references + +=item Pseudo-hashes: Using an array as a hash + +=item Function Templates + +=back + +=item WARNING + +=item SEE ALSO + +=head2 perldsc - Perl Data Structures Cookbook + +=item DESCRIPTION + +arrays of arrays, hashes of arrays, arrays of hashes, hashes of hashes, +more elaborate constructs + +=item REFERENCES + +=item COMMON MISTAKES + +=item CAVEAT ON PRECEDENCE + +=item WHY YOU SHOULD ALWAYS C + +=item DEBUGGING + +=item CODE EXAMPLES + +=item LISTS OF LISTS + +=over + +=item Declaration of a LIST OF LISTS + +=item Generation of a LIST OF LISTS + +=item Access and Printing of a LIST OF LISTS + +=back + +=item HASHES OF LISTS + +=over + +=item Declaration of a HASH OF LISTS + +=item Generation of a HASH OF LISTS + +=item Access and Printing of a HASH OF LISTS + +=back + +=item LISTS OF HASHES + +=over + +=item Declaration of a LIST OF HASHES + +=item Generation of a LIST OF HASHES + +=item Access and Printing of a LIST OF HASHES + +=back + +=item HASHES OF HASHES + +=over + +=item Declaration of a HASH OF HASHES + +=item Generation of a HASH OF HASHES + +=item Access and Printing of a HASH OF HASHES + +=back + +=item MORE ELABORATE RECORDS + +=over + +=item Declaration of MORE ELABORATE RECORDS + +=item Declaration of a HASH OF COMPLEX RECORDS + +=item Generation of a HASH OF COMPLEX RECORDS + +=back + +=item Database Ties + +=item SEE ALSO + +=item AUTHOR + +=head2 perllol, perlLoL - Manipulating Lists of Lists in Perl + +=item DESCRIPTION + +=item Declaration and Access of Lists of Lists + +=item Growing Your Own + +=item Access and Printing + +=item Slices + +=item SEE ALSO + +=item AUTHOR + +=head2 perltoot - Tom's object-oriented tutorial for perl + +=item DESCRIPTION + +=item Creating a Class + +=over + +=item Object Representation + +=item Class Interface + +=item Constructors and Instance Methods + +=item Planning for the Future: Better Constructors + +=item Destructors + +=item Other Object Methods + +=back + +=item Class Data + +=over + +=item Accessing Class Data + +=item Debugging Methods + +=item Class Destructors + +=item Documenting the Interface + +=back + +=item Aggregation + +=item Inheritance + +=over + +=item Overridden Methods + +=item Multiple Inheritance + +=item UNIVERSAL: The Root of All Objects + +=back + +=item Alternate Object Representations + +=over + +=item Arrays as Objects + +=item Closures as Objects + +=back + +=item AUTOLOAD: Proxy Methods + +=over + +=item Autoloaded Data Methods + +=item Inherited Autoloaded Data Methods + +=back + +=item Metaclassical Tools + +=over + +=item Class::Struct + +=item Data Members as Variables + +=item NOTES + +=item Object Terminology + +=back + +=item SEE ALSO + +=item AUTHOR AND COPYRIGHT + +=item COPYRIGHT + +=over + +=item Acknowledgments + +=back + +=head2 perlobj - Perl objects + +=item DESCRIPTION + +=over + +=item An Object is Simply a Reference + +=item A Class is Simply a Package + +=item A Method is Simply a Subroutine + +=item Method Invocation + +=item Default UNIVERSAL methods + +isa(CLASS), can(METHOD), VERSION( [NEED] ) + +=item Destructors + +=item WARNING + +=item Summary + +=item Two-Phased Garbage Collection + +=back + +=item SEE ALSO + +=head2 perltie - how to hide an object class in a simple variable + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Tying Scalars + +TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this + +=item Tying Arrays + +TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value, +DESTROY this + +=item Tying Hashes + +USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key, STORE +this, key, value, DELETE this, key, CLEAR this, EXISTS this, key, FIRSTKEY +this, NEXTKEY this, lastkey, DESTROY this + +=item Tying FileHandles + +TIEHANDLE classname, LIST, WRITE this, LIST, PRINT this, LIST, PRINTF this, +LIST, READ this, LIST, READLINE this, GETC this, CLOSE this, DESTROY this + +=item The C Gotcha + +=back + +=item SEE ALSO + +=item BUGS + +=item AUTHOR + +=head2 perlbot - Bag'o Object Tricks (the BOT) + +=item DESCRIPTION + +=item OO SCALING TIPS + +=item INSTANCE VARIABLES + +=item SCALAR INSTANCE VARIABLES + +=item INSTANCE VARIABLE INHERITANCE + +=item OBJECT RELATIONSHIPS + +=item OVERRIDING SUPERCLASS METHODS + +=item USING RELATIONSHIP WITH SDBM + +=item THINKING OF CODE REUSE + +=item CLASS CONTEXT AND THE OBJECT + +=item INHERITING A CONSTRUCTOR + +=item DELEGATION + +=head2 perlipc - Perl interprocess communication (signals, fifos, pipes, +safe subprocesses, sockets, and semaphores) + +=item DESCRIPTION + +=item Signals + +=item Named Pipes + +=over + +=item WARNING + +=back + +=item Using open() for IPC + +=over + +=item Filehandles + +=item Background Processes + +=item Complete Dissociation of Child from Parent + +=item Safe Pipe Opens + +=item Bidirectional Communication with Another Process + +=item Bidirectional Communication with Yourself + +=back + +=item Sockets: Client/Server Communication + +=over + +=item Internet Line Terminators + +=item Internet TCP Clients and Servers + +=item Unix-Domain TCP Clients and Servers + +=back + +=item TCP Clients with IO::Socket + +=over + +=item A Simple Client + +C, C, C + +=item A Webget Client + +=item Interactive Client with IO::Socket + +=back + +=item TCP Servers with IO::Socket + +Proto, LocalPort, Listen, Reuse + +=item UDP: Message Passing + +=item SysV IPC + +=item NOTES + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + +=head2 perldebug - Perl debugging + +=item DESCRIPTION + +=item The Perl Debugger + +=over + +=item Debugger Commands + +h [command], p expr, x expr, V [pkg [vars]], X [vars], T, s [expr], n +[expr], ECRE, c [line|sub], l, l min+incr, l min-max, l line, l +subname, -, w [line], f filename, /pattern/, ?pattern?, L, S [[!]pattern], +t, t expr, b [line] [condition], b subname [condition], b postpone subname +[condition], b load filename, b compile subname, d [line], D, a [line] +command, A, W [expr], W, O [opt[=val]] [opt"val"] [opt?].., +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, E [ command ], +EE command, E command, EE command, { [ command ], {{ +command, ! number, ! -number, ! pattern, !! cmd, H -number, q or ^D, R, +|dbcmd, ||dbcmd, command, m expr, m package + +=item Debugger input/output + +Prompt, Multiline commands, Stack backtrace, Listing, Frame listing + +=item Debugging compile-time statements + +=item Debugger Customization + +=item Readline Support + +=item Editor Support for Debugging + +=item The Perl Profiler + +=item Debugger support in perl + +=item Debugger Internals + +=item Other resources + +=item BUGS + +=back + +=item Debugging Perl memory usage + +=over + +=item Using C<$ENV{PERL_DEBUG_MSTATS}> + +C, Free/Used, C, C, C, C, C + +=item Example of using B<-DL> switch + +C<717>, C<002>, C<054>, C<602>, C<702>, C<704> + +=item B<-DL> details + +C, C, C + +=item Limitations of B<-DL> statistic + +=back + +=item Debugging regular expressions + +=over + +=item Compile-time output + +C I C I, C I C +I, C, C, C +I, C, C, C, C, C, C, +C + +=item Types of nodes + +=item Run-time output + +=back + +=head2 perldiag - various Perl diagnostics + +=item DESCRIPTION + +=head2 perlsec - Perl security + +=item DESCRIPTION + +=over + +=item Laundering and Detecting Tainted Data + +=item Switches On the "#!" Line + +=item Cleaning Up Your Path + +=item Security Bugs + +=item Protecting Your Programs + +=back + +=item SEE ALSO + +=head2 perltrap - Perl traps for the unwary + +=item DESCRIPTION + +=over + +=item Awk Traps + +=item C Traps + +=item Sed Traps + +=item Shell Traps + +=item Perl Traps + +=item Perl4 to Perl5 Traps + +Discontinuance, Deprecation, and BugFix traps, Parsing Traps, Numerical +Traps, General data type traps, Context Traps - scalar, list contexts, +Precedence Traps, General Regular Expression Traps using s///, etc, +Subroutine, Signal, Sorting Traps, OS Traps, DBM Traps, Unclassified Traps + +=item Discontinuance, Deprecation, and BugFix traps + +Discontinuance, Deprecation, BugFix, Discontinuance, Discontinuance, +Discontinuance, BugFix, Discontinuance, Discontinuance, BugFix, +Discontinuance, Discontinuance, Deprecation, Discontinuance + +=item Parsing Traps + +Parsing, Parsing, Parsing, Parsing + +=item Numerical Traps + +Numerical, Numerical, Numerical + +=item General data type traps + +(Arrays), (Arrays), (Hashes), (Globs), (Globs), (Scalar String), +(Constants), (Scalars), (Variable Suicide) + +=item Context Traps - scalar, list contexts + +(list context), (scalar context), (scalar context), (list, builtin) + +=item Precedence Traps + +Precedence, Precedence, Precedence, Precedence, Precedence, Precedence, +Precedence + +=item General Regular Expression Traps using s///, etc. + +Regular Expression, Regular Expression, Regular Expression, Regular +Expression, Regular Expression, Regular Expression, Regular Expression, +Regular Expression + +=item Subroutine, Signal, Sorting Traps + +(Signals), (Sort Subroutine), warn() won't let you specify a filehandle + +=item OS Traps + +(SysV), (SysV) + +=item Interpolation Traps + +Interpolation, Interpolation, Interpolation, Interpolation, Interpolation, +Interpolation, Interpolation, Interpolation, Interpolation + +=item DBM Traps + +DBM, DBM + +=item Unclassified Traps + +C/C trap using returned value, C on empty string with +LIMIT specified + +=back + +=head2 perlport - Writing portable Perl + +=item DESCRIPTION + +Not all Perl programs have to be portable, The vast majority of Perl B +portable + +=item ISSUES + +=over + +=item Newlines + +=item File Paths + +=item System Interaction + +=item Interprocess Communication (IPC) + +=item External Subroutines (XS) + +=item Standard Modules + +=item Time and Date + +=item System Resources + +=item Security + +=item Style + +=back + +=item CPAN TESTERS + +Mailing list: cpan-testers@perl.org, Testing results: +C + +=item PLATFORMS + +=over + +=item Unix + +=item DOS and Derivatives + +The djgpp environment for DOS, C, The EMX +environment for DOS, OS/2, etc. +C,C, Build instructions +for Win32, L, The ActiveState Pages, +C + +=item MacPerl + +The MacPerl Pages, C, The MacPerl mailing +list, C + +=item VMS + +L, vmsperl list, C, vmsperl +on the web, C + +=item EBCDIC Platforms + +perl-mvs list, AS/400 Perl information at C + +=item Other perls + +Atari, Guido Flohr's page C, HP 300 +MPE/iX C, Novell Netware + +=back + +=item FUNCTION IMPLEMENTATIONS + +=over + +=item Alphabetical Listing of Perl Functions + +-I FILEHANDLE, -I EXPR, -I, binmode FILEHANDLE, chmod LIST, chown +LIST, chroot FILENAME, chroot, crypt PLAINTEXT,SALT, dbmclose HASH, dbmopen +HASH,DBNAME,MODE, dump LABEL, exec LIST, fcntl FILEHANDLE,FUNCTION,SCALAR, +flock FILEHANDLE,OPERATION, fork, getlogin, getpgrp PID, getppid, +getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, getnetbyname NAME, +getpwuid UID, getgrgid GID, getnetbyaddr ADDR,ADDRTYPE, getprotobynumber +NUMBER, getservbyport PORT,PROTO, getpwent, getgrent, gethostent, +getnetent, getprotoent, getservent, setpwent, setgrent, sethostent +STAYOPEN, setnetent STAYOPEN, setprotoent STAYOPEN, setservent STAYOPEN, +endpwent, endgrent, endhostent, endnetent, endprotoent, endservent, +getsockopt SOCKET,LEVEL,OPTNAME, glob EXPR, glob, ioctl +FILEHANDLE,FUNCTION,SCALAR, kill LIST, link OLDFILE,NEWFILE, lstat +FILEHANDLE, lstat EXPR, lstat, msgctl ID,CMD,ARG, msgget KEY,FLAGS, msgsnd +ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, open FILEHANDLE,EXPR, open +FILEHANDLE, pipe READHANDLE,WRITEHANDLE, readlink EXPR, readlink, select +RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget +KEY,NSEMS,FLAGS, semop KEY,OPSTRING, setpgrp PID,PGRP, setpriority +WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shmctl +ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, shmwrite +ID,STRING,POS,SIZE, socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, stat +FILEHANDLE, stat EXPR, stat, symlink OLDFILE,NEWFILE, syscall LIST, system +LIST, times, truncate FILEHANDLE,LENGTH, truncate EXPR,LENGTH, umask EXPR, +umask, utime LIST, wait, waitpid PID,FLAGS + +=back + +=item AUTHORS / CONTRIBUTORS + +=item VERSION + +=head2 perlstyle - Perl style guide + +=item DESCRIPTION + +=head2 perlpod - plain old documentation + +=item DESCRIPTION + +=over + +=item Verbatim Paragraph + +=item Command Paragraph + +=item Ordinary Block of Text + +=item The Intent + +=item Embedding Pods in Perl Modules + +=item Common Pod Pitfalls + +=back + +=item SEE ALSO + +=item AUTHOR + +=head2 perlbook - Perl book information + +=item DESCRIPTION + +=head2 perlembed - how to embed perl in your C program + +=item DESCRIPTION + +=over + +=item PREAMBLE + +B, B, B, B, B + +=item ROADMAP + +=item Compiling your C program + +=item Adding a Perl interpreter to your C program + +=item Calling a Perl subroutine from your C program + +=item Evaluating a Perl statement from your C program + +=item Performing Perl pattern matches and substitutions from your C program + +=item Fiddling with the Perl stack from your C program + +=item Maintaining a persistent interpreter + +=item Maintaining multiple interpreter instances + +=item Using Perl modules, which themselves use C libraries, from your C +program + +=back + +=item Embedding Perl under Win32 + +=item MORAL + +=item AUTHOR + +=item COPYRIGHT + +=head2 perlapio - perl's IO abstraction interface. + +=item SYNOPSIS + +=item DESCRIPTION + +B, B, B, B, +B, B, +B, B, +B, B, +B, B, B, +B, B, B, +B, B, B, +B, B, B, +B, B, B, +B, B + +=over + +=item Co-existence with stdio + +B, B, +B, B, B, +B, B, B, +B, B, +B, B, B, +B, B + +=back + +=head2 perlxs - XS language reference manual + +=item DESCRIPTION + +=over + +=item Introduction + +=item On The Road + +=item The Anatomy of an XSUB + +=item The Argument Stack + +=item The RETVAL Variable + +=item The MODULE Keyword + +=item The PACKAGE Keyword + +=item The PREFIX Keyword + +=item The OUTPUT: Keyword + +=item The CODE: Keyword + +=item The INIT: Keyword + +=item The NO_INIT Keyword + +=item Initializing Function Parameters + +=item Default Parameter Values + +=item The PREINIT: Keyword + +=item The SCOPE: Keyword + +=item The INPUT: Keyword + +=item Variable-length Parameter Lists + +=item The C_ARGS: Keyword + +=item The PPCODE: Keyword + +=item Returning Undef And Empty Lists + +=item The REQUIRE: Keyword + +=item The CLEANUP: Keyword + +=item The BOOT: Keyword + +=item The VERSIONCHECK: Keyword + +=item The PROTOTYPES: Keyword + +=item The PROTOTYPE: Keyword + +=item The ALIAS: Keyword + +=item The INTERFACE: Keyword + +=item The INTERFACE_MACRO: Keyword + +=item The INCLUDE: Keyword + +=item The CASE: Keyword + +=item The & Unary Operator + +=item Inserting Comments and C Preprocessor Directives + +=item Using XS With C++ + +=item Interface Strategy + +=item Perl Objects And C Structures + +=item The Typemap + +=back + +=item EXAMPLES + +=item XS VERSION + +=item AUTHOR + +=head2 perlxstut, perlXStut - Tutorial for XSUBs + +=item DESCRIPTION + +=over + +=item VERSION CAVEAT + +=item DYNAMIC VERSUS STATIC + +=item EXAMPLE 1 + +=item EXAMPLE 2 + +=item WHAT HAS GONE ON? + +=item WRITING GOOD TEST SCRIPTS + +=item EXAMPLE 3 + +=item WHAT'S NEW HERE? + +=item INPUT AND OUTPUT PARAMETERS + +=item THE XSUBPP COMPILER + +=item THE TYPEMAP FILE + +=item WARNING + +=item EXAMPLE 4 + +=item WHAT HAS HAPPENED HERE? + +=item SPECIFYING ARGUMENTS TO XSUBPP + +=item THE ARGUMENT STACK + +=item EXTENDING YOUR EXTENSION + +=item DOCUMENTING YOUR EXTENSION + +=item INSTALLING YOUR EXTENSION + +=item SEE ALSO + +=item Author + +=item Last Changed + +=back + +=head2 perlguts - Perl's Internal Functions + +=item DESCRIPTION + +=item Variables + +=over + +=item Datatypes + +=item What is an "IV"? + +=item Working with SVs + +=item What's Really Stored in an SV? + +=item Working with AVs + +=item Working with HVs + +=item Hash API Extensions + +=item References + +=item Blessed References and Class Objects + +=item Creating New Variables + +=item Reference Counts and Mortality + +=item Stashes and Globs + +=item Double-Typed SVs + +=item Magic Variables + +=item Assigning Magic + +=item Magic Virtual Tables + +=item Finding Magic + +=item Understanding the Magic of Tied Hashes and Arrays + +=item Localizing changes + +C, C, C, C, +C, C, C, C, C, C, C, C, C, C, C, C, +C, C, +C, C, C + +=back + +=item Subroutines + +=over + +=item XSUBs and the Argument Stack + +=item Calling Perl Routines from within C Programs + +=item Memory Allocation + +=item PerlIO + +=item Putting a C value on Perl stack + +=item Scratchpads + +=item Scratchpads and recursion + +=back + +=item Compiled code + +=over + +=item Code tree + +=item Examining the tree + +=item Compile pass 1: check routines + +=item Compile pass 1a: constant folding + +=item Compile pass 2: context propagation + +=item Compile pass 3: peephole optimization + +=back + +=item API LISTING + +av_clear, av_extend, av_fetch, AvFILL, av_len, av_make, av_pop, av_push, +av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH, +PL_DBsingle, PL_DBsub, PL_DBtrace, dMARK, dORIGMARK, PL_dowarn, dSP, +dXSARGS, dXSI32, do_binmode, ENTER, EXTEND, fbm_compile, fbm_instr, +FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, GIMME_V, G_NOARGS, G_SCALAR, +gv_fetchmeth, gv_fetchmethod, gv_fetchmethod_autoload, G_VOID, gv_stashpv, +gv_stashsv, GvSV, HEf_SVKEY, HeHASH, HeKEY, HeKLEN, HePV, HeSVKEY, +HeSVKEY_force, HeSVKEY_set, HeVAL, hv_clear, hv_delayfree_ent, hv_delete, +hv_delete_ent, hv_exists, hv_exists_ent, hv_fetch, hv_fetch_ent, +hv_free_ent, hv_iterinit, hv_iterkey, hv_iterkeysv, hv_iternext, +hv_iternextsv, hv_iterval, hv_magic, HvNAME, hv_store, hv_store_ent, +hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE, isUPPER, items, ix, +LEAVE, looks_like_number, MARK, mg_clear, mg_copy, mg_find, mg_free, +mg_get, mg_len, mg_magical, mg_set, Move, PL_na, New, newAV, Newc, +newCONSTSUB, newHV, newRV_inc, newRV_noinc, NEWSV, newSViv, newSVnv, +newSVpv, newSVpvf, newSVpvn, newSVrv, newSVsv, newXS, newXSproto, Newz, +Nullav, Nullch, Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc, +perl_call_argv, perl_call_method, perl_call_pv, perl_call_sv, +perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv, perl_free, +perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse, +perl_require_pv, perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi, +PUSHn, PUSHp, PUSHs, PUSHu, PUTBACK, Renew, Renewc, RETVAL, safefree, +safemalloc, saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, +strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless, +sv_catpv, sv_catpv_mg, sv_catpvn, sv_catpvn_mg, sv_catpvf, sv_catpvf_mg, +sv_catsv, sv_catsv_mg, sv_chop, sv_cmp, SvCUR, SvCUR_set, sv_dec, +sv_derived_from, sv_derived_from, SvEND, sv_eq, SvGETMAGIC, SvGROW, +sv_grow, sv_inc, sv_insert, SvIOK, SvIOK_off, SvIOK_on, SvIOK_only, SvIOKp, +sv_isa, sv_isobject, SvIV, SvIVX, SvLEN, sv_len, sv_magic, sv_mortalcopy, +sv_newmortal, SvNIOK, SvNIOK_off, SvNIOKp, PL_sv_no, SvNOK, SvNOK_off, +SvNOK_on, SvNOK_only, SvNOKp, SvNV, SvNVX, SvOK, SvOOK, SvPOK, SvPOK_off, +SvPOK_on, SvPOK_only, SvPOKp, SvPV, SvPV_force, SvPVX, SvREFCNT, +SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV, SvSETMAGIC, +sv_setiv, sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpv_mg, +sv_setpviv, sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpvf, +sv_setpvf_mg, sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, +SvSetSV, SvSetSV_nosteal, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, +SvSTASH, SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, SVt_IV, SVt_PV, +SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE, SvTYPE, svtype, +PL_sv_undef, sv_unref, SvUPGRADE, sv_upgrade, sv_usepvn, sv_usepvn_mg, +sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale), +sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale), SvUV, +SvUVX, PL_sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp, +XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, +XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNV, +XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, +Zero + +=item AUTHORS + +=head2 perlcall - Perl calling conventions from C + +=item DESCRIPTION + +An Error Handler, An Event Driven Program + +=item THE PERL_CALL FUNCTIONS + +B, B, B, B + +=item FLAG VALUES + +=over + +=item G_VOID + +=item G_SCALAR + +=item G_ARRAY + +=item G_DISCARD + +=item G_NOARGS + +=item G_EVAL + +=item G_KEEPERR + +=item Determining the Context + +=back + +=item KNOWN PROBLEMS + +=item EXAMPLES + +=over + +=item No Parameters, Nothing returned + +=item Passing Parameters + +=item Returning a Scalar + +=item Returning a list of values + +=item Returning a list in a scalar context + +=item Returning Data from Perl via the parameter list + +=item Using G_EVAL + +=item Using G_KEEPERR + +=item Using perl_call_sv + +=item Using perl_call_argv + +=item Using perl_call_method + +=item Using GIMME_V + +=item Using Perl to dispose of temporaries + +=item Strategies for storing Callback Context Information + +1. Ignore the problem - Allow only 1 callback, 2. Create a sequence of +callbacks - hard wired limit, 3. Use a parameter to map to the Perl +callback + +=item Alternate Stack Manipulation + +=item Creating and calling an anonymous subroutine in C + +=back + +=item SEE ALSO + +=item AUTHOR + +=item DATE + +=head2 perlhist - the Perl history records + +=item DESCRIPTION + +=item INTRODUCTION + +=item THE KEEPERS OF THE PUMPKIN + +=over + +=item PUMPKIN? + +=back + +=item THE RECORDS + +=over + +=item SELECTED RELEASE SIZES + +=item SELECTED PATCH SIZES + +=back + +=item THE KEEPERS OF THE RECORDS + +=head1 PRAGMA DOCUMENTATION + +=head2 attrs - set/get attributes of a subroutine + +=item SYNOPSIS + +=item DESCRIPTION + +method, locked + +=head2 re - Perl pragma to alter regular expression behaviour + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 autouse - postpone load of modules until a function is used + +=item SYNOPSIS + +=item DESCRIPTION + +=item WARNING + +=item AUTHOR + +=item SEE ALSO + +=head2 base - Establish IS-A relationship with base class at compile time + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=head2 blib - Use MakeMaker's uninstalled version of a package + +=item SYNOPSIS + +=item DESCRIPTION + +=item BUGS + +=item AUTHOR + +=head2 constant - Perl pragma to declare constants + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTES + +=item TECHNICAL NOTE + +=item BUGS + +=item AUTHOR + +=item COPYRIGHT + +=head2 diagnostics - Perl compiler pragma to force verbose warning +diagnostics + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item The C Pragma + +=item The I Program + +=back + +=item EXAMPLES + +=item INTERNALS + +=item BUGS + +=item AUTHOR + +=head2 fields - compile-time class fields + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=head2 integer - Perl pragma to compute arithmetic in integer instead of +double + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 less - perl pragma to request less of something from the compiler + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 lib - manipulate @INC at compile time + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item ADDING DIRECTORIES TO @INC + +=item DELETING DIRECTORIES FROM @INC + +=item RESTORING ORIGINAL @INC + +=back + +=item SEE ALSO + +=item AUTHOR + +=head2 locale - Perl pragma to use and avoid POSIX locales for built-in +operations + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 overload - Package for overloading perl operations + +=item SYNOPSIS + +=item CAVEAT SCRIPTOR + +=item DESCRIPTION + +=over + +=item Declaration of overloaded functions + +=item Calling Conventions for Binary Operations + +FALSE, TRUE, C + +=item Calling Conventions for Unary Operations + +=item Overloadable Operations + +I, I, I, +I, I, I, I + +=item Inheritance and overloading + +Strings as values of C directive, Overloading of an operation +is inherited by derived classes + +=back + +=item SPECIAL SYMBOLS FOR C + +=over + +=item Last Resort + +=item Fallback + +C, TRUE, defined, but FALSE + +=item Copy Constructor + +B + +=back + +=item MAGIC AUTOGENERATION + +I, I, +I, C, I, I, +I, I, I + +=item WARNING + +=item Run-time Overloading + +=item Public functions + +overload::StrVal(arg), overload::Overloaded(arg), overload::Method(obj,op) + +=item Overloading constants + +integer, float, binary, q, qr + +=item IMPLEMENTATION + +=item AUTHOR + +=item DIAGNOSTICS + +=item BUGS + +=head2 sigtrap - Perl pragma to enable simple signal handling + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +=over + +=item SIGNAL HANDLERS + +B, B, B I + +=item SIGNAL LISTS + +B, B, B + +=item OTHER + +B, B, I, I + +=back + +=item EXAMPLES + +=head2 strict - Perl pragma to restrict unsafe constructs + +=item SYNOPSIS + +=item DESCRIPTION + +C, C, C + +=head2 subs - Perl pragma to predeclare sub names + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 vars - Perl pragma to predeclare global variable names + +=item SYNOPSIS + +=item DESCRIPTION + +=head1 MODULE DOCUMENTATION + +=head2 AnyDBM_File - provide framework for multiple DBMs + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item DBM Comparisons + +[0], [1], [2], [3] + +=back + +=item SEE ALSO + +=head2 AutoLoader - load subroutines only on demand + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Subroutine Stubs + +=item Using B's AUTOLOAD Subroutine + +=item Overriding B's AUTOLOAD Subroutine + +=item Package Lexicals + +=item B vs. B + +=back + +=item CAVEATS + +=item SEE ALSO + +=head2 AutoSplit - split a package for autoloading + +=item SYNOPSIS + +=item DESCRIPTION + +$keep, $check, $modtime + +=over + +=item Multiple packages + +=back + +=item DIAGNOSTICS + +=head2 B - The Perl Compiler + +=item SYNOPSIS + +=item DESCRIPTION + +=item OVERVIEW OF CLASSES + +=over + +=item SV-RELATED CLASSES + +=item B::SV METHODS + +REFCNT, FLAGS + +=item B::IV METHODS + +IV, IVX, needs64bits, packiv + +=item B::NV METHODS + +NV, NVX + +=item B::RV METHODS + +RV + +=item B::PV METHODS + +PV + +=item B::PVMG METHODS + +MAGIC, SvSTASH + +=item B::MAGIC METHODS + +MOREMAGIC, PRIVATE, TYPE, FLAGS, OBJ, PTR + +=item B::PVLV METHODS + +TARGOFF, TARGLEN, TYPE, TARG + +=item B::BM METHODS + +USEFUL, PREVIOUS, RARE, TABLE + +=item B::GV METHODS + +NAME, STASH, SV, IO, FORM, AV, HV, EGV, CV, CVGEN, LINE, FILEGV, GvREFCNT, +FLAGS + +=item B::IO METHODS + +LINES, PAGE, PAGE_LEN, LINES_LEFT, TOP_NAME, TOP_GV, FMT_NAME, FMT_GV, +BOTTOM_NAME, BOTTOM_GV, SUBPROCESS, IoTYPE, IoFLAGS + +=item B::AV METHODS + +FILL, MAX, OFF, ARRAY, AvFLAGS + +=item B::CV METHODS + +STASH, START, ROOT, GV, FILEGV, DEPTH, PADLIST, OUTSIDE, XSUB, XSUBANY + +=item B::HV METHODS + +FILL, MAX, KEYS, RITER, NAME, PMROOT, ARRAY + +=item OP-RELATED CLASSES + +=item B::OP METHODS + +next, sibling, ppaddr, desc, targ, type, seq, flags, private + +=item B::UNOP METHOD + +first + +=item B::BINOP METHOD + +last + +=item B::LOGOP METHOD + +other + +=item B::CONDOP METHODS + +true, false + +=item B::LISTOP METHOD + +children + +=item B::PMOP METHODS + +pmreplroot, pmreplstart, pmnext, pmregexp, pmflags, pmpermflags, precomp + +=item B::SVOP METHOD + +sv + +=item B::GVOP METHOD + +gv + +=item B::PVOP METHOD + +pv + +=item B::LOOP METHODS + +redoop, nextop, lastop + +=item B::COP METHODS + +label, stash, filegv, cop_seq, arybase, line + +=back + +=item FUNCTIONS EXPORTED BY C + +main_cv, main_root, main_start, comppadlist, sv_undef, sv_yes, sv_no, +walkoptree(OP, METHOD), walkoptree_debug(DEBUG), walksymtable(SYMREF, +METHOD, RECURSE), svref_2object(SV), ppname(OPNUM), hash(STR), cast_I32(I), +minus_c, cstring(STR), class(OBJ), threadsv_names, byteload_fh(FILEHANDLE) + +=item AUTHOR + +=head2 B::Asmdata - Autogenerated data about Perl ops, used to generate +bytecode + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Assembler - Assemble Perl bytecode + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Bblock - Walk basic blocks + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Bytecode - Perl compiler's bytecode backend + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +B<-ofilename>, B<-->, B<-f>, B<-fcompress-nullops>, +B<-fomit-sequence-numbers>, B<-fbypass-nullops>, B<-fstrip-syntax-tree>, +B<-On>, B<-D>, B<-Do>, B<-Db>, B<-Da>, B<-DC>, B<-S>, B<-m> + +=item BUGS + +=item AUTHOR + +=head2 B::C - Perl compiler's C backend + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +B<-ofilename>, B<-v>, B<-->, B<-uPackname>, B<-D>, B<-Do>, B<-Dc>, B<-DA>, +B<-DC>, B<-DM>, B<-f>, B<-fcog>, B<-fno-cog>, B<-On> + +=item EXAMPLES + +=item BUGS + +=item AUTHOR + +=head2 B::CC - Perl compiler's optimized C translation backend + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +B<-ofilename>, B<-v>, B<-->, B<-uPackname>, B<-mModulename>, B<-D>, B<-Dr>, +B<-DO>, B<-Ds>, B<-Dp>, B<-Dq>, B<-Dl>, B<-Dt>, B<-f>, +B<-ffreetmps-each-bblock>, B<-ffreetmps-each-loop>, B<-fomit-taint>, B<-On> + +=item EXAMPLES + +=item BUGS + +=item DIFFERENCES + +=over + +=item Loops + +=item Context of ".." + +=item Arithmetic + +=item Deprecated features + +=back + +=item AUTHOR + +=head2 B::Debug - Walk Perl syntax tree, printing debug info about ops + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Deparse - Perl compiler backend to produce perl code + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +B<-p>, B<-u>I, B<-l>, B<-s>I, B + +=item BUGS + +=item AUTHOR + +=head2 B::Disassembler - Disassemble Perl bytecode + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Lint - Perl lint + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS AND LINT CHECKS + +B, B and B, B, +B, B, B, B, B + +=item NON LINT-CHECK OPTIONS + +B<-u Package> + +=item BUGS + +=item AUTHOR + +=head2 B::O, O - Generic interface to Perl Compiler backends + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONVENTIONS + +=item IMPLEMENTATION + +=item AUTHOR + +=head2 B::Showlex - Show lexical variables used in functions or files + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Stackobj - Helper module for CC backend + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Terse - Walk Perl syntax tree, printing terse info about ops + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 B::Xref - Generates cross reference reports for Perl programs + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPTIONS + +C<-oFILENAME>, C<-r>, C<-D[tO]> + +=item BUGS + +=item AUTHOR + +=head2 Benchmark - benchmark running times of code + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Methods + +new, debug + +=item Standard Exports + +timeit(COUNT, CODE), timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ), +timethese ( COUNT, CODEHASHREF, [ STYLE ] ), timediff ( T1, T2 ), timestr ( +TIMEDIFF, [ STYLE, [ FORMAT ] ] ) + +=item Optional Exports + +clearcache ( COUNT ), clearallcache ( ), disablecache ( ), enablecache ( ) + +=back + +=item NOTES + +=item INHERITANCE + +=item CAVEATS + +=item AUTHORS + +=item MODIFICATION HISTORY + +=head2 CGI - Simple Common Gateway Interface Class + +=item SYNOPSIS + +=item ABSTRACT + +=item DESCRIPTION + +=over + +=item PROGRAMMING STYLE + +=item CALLING CGI.PM ROUTINES + +1. Use another name for the argument, if one is available. Forexample, +-value is an alias for -values, 2. Change the capitalization, e.g. -Values, +3. Put quotes around the argument name, e.g. '-values' + +=item CREATING A NEW QUERY OBJECT (OBJECT-ORIENTED STYLE): + +=item CREATING A NEW QUERY OBJECT FROM AN INPUT FILE + +=item FETCHING A LIST OF KEYWORDS FROM THE QUERY: + +=item FETCHING THE NAMES OF ALL THE PARAMETERS PASSED TO YOUR SCRIPT: + +=item FETCHING THE VALUE OR VALUES OF A SINGLE NAMED PARAMETER: + +=item SETTING THE VALUE(S) OF A NAMED PARAMETER: + +=item APPENDING ADDITIONAL VALUES TO A NAMED PARAMETER: + +=item IMPORTING ALL PARAMETERS INTO A NAMESPACE: + +=item DELETING A PARAMETER COMPLETELY: + +=item DELETING ALL PARAMETERS: + +=item DIRECT ACCESS TO THE PARAMETER LIST: + +=item SAVING THE STATE OF THE SCRIPT TO A FILE: + +=item USING THE FUNCTION-ORIENTED INTERFACE + +B<:cgi>, B<:form>, B<:html2>, B<:html3>, B<:netscape>, B<:html>, +B<:standard>, B<:all> + +=item PRAGMAS + +-any, -compile, -nph, -autoload, -no_debug, -private_tempfiles + +=back + +=item GENERATING DYNAMIC DOCUMENTS + +=over + +=item CREATING A STANDARD HTTP HEADER: + +=item GENERATING A REDIRECTION HEADER + +=item CREATING THE HTML DOCUMENT HEADER + +B, 4, 5, 6.. + +=item ENDING THE HTML DOCUMENT: + +=item CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION: + +=item OBTAINING THE SCRIPT'S URL + +B<-absolute>, B<-relative>, B<-full>, B<-path> (B<-path_info>), B<-query> +(B<-query_string>) + +=back + +=item CREATING STANDARD HTML ELEMENTS: + +=over + +=item PROVIDING ARGUMENTS TO HTML SHORTCUTS + +=item THE DISTRIBUTIVE PROPERTY OF HTML SHORTCUTS + +=item HTML SHORTCUTS AND LIST INTERPOLATION + +=item NON-STANDARD HTML SHORTCUTS + +=back + +=item CREATING FILL-OUT FORMS: + +=over + +=item CREATING AN ISINDEX TAG + +=item STARTING AND ENDING A FORM + +B, B + +=item CREATING A TEXT FIELD + +B + +=item CREATING A BIG TEXT FIELD + +=item CREATING A PASSWORD FIELD + +=item CREATING A FILE UPLOAD FIELD + +B + +=item CREATING A POPUP MENU + +=item CREATING A SCROLLING LIST + +B + +=item CREATING A GROUP OF RELATED CHECKBOXES + +B + +=item CREATING A STANDALONE CHECKBOX + +B + +=item CREATING A RADIO BUTTON GROUP + +B + +=item CREATING A SUBMIT BUTTON + +B + +=item CREATING A RESET BUTTON + +=item CREATING A DEFAULT BUTTON + +=item CREATING A HIDDEN FIELD + +B + +=item CREATING A CLICKABLE IMAGE BUTTON + +B, 3.The third option (-align, optional) is an alignment type, +and may be +TOP, BOTTOM or MIDDLE + +=item CREATING A JAVASCRIPT ACTION BUTTON + +=back + +=item NETSCAPE COOKIES + +1. an expiration time, 2. a domain, 3. a path, 4. a "secure" flag, +B<-name>, B<-value>, B<-path>, B<-domain>, B<-expires>, B<-secure> + +=item WORKING WITH NETSCAPE FRAMES + +1. Create a document, 2. Specify the destination for the +document in the HTTP header, 3. Specify the destination for the document in +the
    tag + +=item LIMITED SUPPORT FOR CASCADING STYLE SHEETS + +=item DEBUGGING + +=over + +=item DUMPING OUT ALL THE NAME/VALUE PAIRS + +=back + +=item FETCHING ENVIRONMENT VARIABLES + +B, B, B, B, +B, B, BReturn the script +name as a partial URL, for self-refering +scripts, B, B, B, B, B, B, B, +B + +=item USING NPH SCRIPTS + +In the B statement, By calling the B method:, By using B<-nph> +parameters in the B and B statements: + +=item Server Push + +multipart_init() +multipart_init(-boundary=>$boundary);, multipart_start(), multipart_end() + +=item Avoiding Denial of Service Attacks + +B<$CGI::POST_MAX>, B<$CGI::DISABLE_UPLOADS>, B<1. On a script-by-script +basis>, B<2. Globally for all scripts> + +=item COMPATIBILITY WITH CGI-LIB.PL + +=item AUTHOR INFORMATION + +=item CREDITS + +Matt Heffron (heffron@falstaff.css.beckman.com), James Taylor +(james.taylor@srs.gov), Scott Anguish , Mike Jewell +(mlj3u@virginia.edu), Timothy Shimmin (tes@kbs.citri.edu.au), Joergen Haegg +(jh@axis.se), Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu), Richard +Resnick (applepi1@aol.com), Craig Bishop (csb@barwonwater.vic.gov.au), Tony +Curtis (tc@vcpc.univie.ac.at), Tim Bunce (Tim.Bunce@ig.co.uk), Tom +Christiansen (tchrist@convex.com), Andreas Koenig +(k@franz.ww.TU-Berlin.DE), Tim MacKenzie (Tim.MacKenzie@fulcrum.com.au), +Kevin B. Hendricks (kbhend@dogwood.tyler.wm.edu), Stephen Dahmen +(joyfire@inxpress.net), Ed Jordan (ed@fidalgo.net), David Alan Pisoni +(david@cnation.com), Doug MacEachern (dougm@opengroup.org), Robin Houston +(robin@oneworld.org), ...and many many more.. + +=item A COMPLETE EXAMPLE OF A SIMPLE FORM-BASED SCRIPT + +=item BUGS + +=item SEE ALSO + +=head2 CGI::Apache - Make things work with CGI.pm against Perl-Apache API + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE 1 + +=item NOTE 2 + +=item SEE ALSO + +=item AUTHOR + +=head2 CGI::Carp, B - CGI routines for writing to the HTTPD (or +other) error log + +=item SYNOPSIS + +=item DESCRIPTION + +=item REDIRECTING ERROR MESSAGES + +=item MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW + +=over + +=item Changing the default message + +=back + +=item CHANGE LOG + +=item AUTHORS + +=item SEE ALSO + +=head2 CGI::Cookie - Interface to Netscape Cookies + +=item SYNOPSIS + +=item DESCRIPTION + +=item USING CGI::Cookie + +B<1. expiration date>, B<2. domain>, B<3. path>, B<4. secure flag> + +=over + +=item Creating New Cookies + +=item Sending the Cookie to the Browser + +=item Recovering Previous Cookies + +=item Manipulating Cookies + +B, B, B, B, B + +=back + +=item AUTHOR INFORMATION + +=item BUGS + +=item SEE ALSO + +=head2 CGI::Fast - CGI Interface for Fast CGI + +=item SYNOPSIS + +=item DESCRIPTION + +=item OTHER PIECES OF THE PUZZLE + +=item WRITING FASTCGI PERL SCRIPTS + +=item INSTALLING FASTCGI SCRIPTS + +=item USING FASTCGI SCRIPTS AS CGI SCRIPTS + +=item CAVEATS + +=item AUTHOR INFORMATION + +=item BUGS + +=item SEE ALSO + +=head2 CGI::Push - Simple Interface to Server Push + +=item SYNOPSIS + +=item DESCRIPTION + +=item USING CGI::Push + +-next_page, -last_page, -type, -delay, -cookie, -target, -expires + +=over + +=item Heterogeneous Pages + +=item Changing the Page Delay on the Fly + +=back + +=item INSTALLING CGI::Push SCRIPTS + +=item CAVEATS + +=item AUTHOR INFORMATION + +=item BUGS + +=item SEE ALSO + +=head2 CGI::Switch - Try more than one constructors and return the first +object available + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=item AUTHOR + +=head2 CPAN - query, download and build perl modules from CPAN sites + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Interactive Mode + +Searching for authors, bundles, distribution files and modules, make, test, +install, clean modules or distributions, readme, look module or +distribution, Signals + +=item CPAN::Shell + +=item autobundle + +=item recompile + +=item The four C Classes: Author, Bundle, Module, Distribution + +=item ProgrammerE<39>s interface + +expand($type,@things), Programming Examples + +=item Methods in the four + +=item Cache Manager + +=item Bundles + +=item Prerequisites + +=item Finding packages and VERSION + +=item Debugging + +=item Floppy, Zip, and all that Jazz + +=back + +=item CONFIGURATION + +o conf Escalar optionE, o conf Escalar optionE +EvalueE, o conf Elist optionE, o conf Elist optionE +[shift|pop], o conf Elist optionE [unshift|push|splice] +ElistE + +=over + +=item CD-ROM support + +=back + +=item SECURITY + +=item EXPORT + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + +=head2 CPAN::FirstTime - Utility for CPAN::Config file Initialization + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 CPANox, CPAN::Nox - Wrapper around CPAN.pm without using any XS +module + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=head2 Carp, carp - warn of errors (from perspective of caller) + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Forcing a Stack Trace + +=back + +=head2 Class::Struct - declare struct-like datatypes as Perl classes + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item The C function + +=item Element Types and Accessor Methods + +Scalar (C<'$'> or C<'*$'>), Array (C<'@'> or C<'*@'>), Hash (C<'%'> or +C<'*%'>), Class (C<'Class_Name'> or C<'*Class_Name'>) + +=back + +=item EXAMPLES + +Example 1, Example 2 + +=item Author and Modification History + +=head2 Cwd, getcwd - get pathname of current working directory + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 DB_File - Perl5 access to Berkeley DB version 1.x + +=item SYNOPSIS + +=item DESCRIPTION + +B, B, B + +=over + +=item Using DB_File with Berkeley DB version 2 + +=item Interface to Berkeley DB + +=item Opening a Berkeley DB Database File + +=item Default Parameters + +=item In Memory Databases + +=back + +=item DB_HASH + +=over + +=item A Simple Example + +=back + +=item DB_BTREE + +=over + +=item Changing the BTREE sort order + +=item Handling Duplicate Keys + +=item The get_dup() Method + +=item Matching Partial Keys + +=back + +=item DB_RECNO + +=over + +=item The 'bval' Option + +=item A Simple Example + +=item Extra Methods + +B<$X-Epush(list) ;>, B<$value = $X-Epop ;>, B<$X-Eshift>, +B<$X-Eunshift(list) ;>, B<$X-Elength> + +=item Another Example + +=back + +=item THE API INTERFACE + +B<$status = $X-Eget($key, $value [, $flags]) ;>, B<$status = +$X-Eput($key, $value [, $flags]) ;>, B<$status = $X-Edel($key [, +$flags]) ;>, B<$status = $X-Efd ;>, B<$status = $X-Eseq($key, +$value, $flags) ;>, B<$status = $X-Esync([$flags]) ;> + +=item HINTS AND TIPS + +=over + +=item Locking Databases + +=item Sharing Databases With C Applications + +=item The untie() Gotcha + +=back + +=item COMMON QUESTIONS + +=over + +=item Why is there Perl source in my database? + +=item How do I store complex data structures with DB_File? + +=item What does "Invalid Argument" mean? + +=item What does "Bareword 'DB_File' not allowed" mean? + +=back + +=item HISTORY + +=item BUGS + +=item AVAILABILITY + +=item COPYRIGHT + +=item SEE ALSO + +=item AUTHOR + +=head2 Data::Dumper - stringified perl data structures, suitable for both +printing and C + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Methods + +I->new(I, I), I<$OBJ>->Dump I +I->Dump(I, I), I<$OBJ>->Dumpxs I +I->Dumpxs(I, I), +I<$OBJ>->Seen(I<[HASHREF]>), I<$OBJ>->Values(I<[ARRAYREF]>), +I<$OBJ>->Names(I<[ARRAYREF]>), I<$OBJ>->Reset + +=item Functions + +Dumper(I), DumperX(I) + +=item Configuration Variables or Methods + +$Data::Dumper::Indent I I<$OBJ>->Indent(I<[NEWVAL]>), +$Data::Dumper::Purity I I<$OBJ>->Purity(I<[NEWVAL]>), +$Data::Dumper::Pad I I<$OBJ>->Pad(I<[NEWVAL]>), +$Data::Dumper::Varname I I<$OBJ>->Varname(I<[NEWVAL]>), +$Data::Dumper::Useqq I I<$OBJ>->Useqq(I<[NEWVAL]>), +$Data::Dumper::Terse I I<$OBJ>->Terse(I<[NEWVAL]>), +$Data::Dumper::Freezer I $I->Freezer(I<[NEWVAL]>), +$Data::Dumper::Toaster I $I->Toaster(I<[NEWVAL]>), +$Data::Dumper::Deepcopy I $I->Deepcopy(I<[NEWVAL]>), +$Data::Dumper::Quotekeys I $I->Quotekeys(I<[NEWVAL]>), +$Data::Dumper::Bless I $I->Bless(I<[NEWVAL]>) + +=item Exports + +Dumper + +=back + +=item EXAMPLES + +=item BUGS + +=item AUTHOR + +=item VERSION + +=item SEE ALSO + +=head2 Devel::SelfStubber - generate stubs for a SelfLoading module + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 DirHandle - supply object methods for directory handles + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 English - use nice English (or awk) names for ugly punctuation +variables + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Env - perl module that imports environment variables + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 Exporter - Implements default import method for modules + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Selecting What To Export + +=item Specialised Import Lists + +=item Exporting without using Export's import method + +=item Module Version Checking + +=item Managing Unknown Symbols + +=item Tag Handling Utility Functions + +=back + +=head2 ExtUtils::Command - utilities to replace common UNIX commands in +Makefiles etc. + +=item SYNOPSIS + +=item DESCRIPTION + +cat, eqtime src dst, rm_f files..., rm_f files..., touch files .., mv +source... destination, cp source... destination, chmod mode files.., mkpath +directory.., test_f file + +=item BUGS + +=item SEE ALSO + +=item AUTHOR + +=head2 ExtUtils::Embed - Utilities for embedding Perl in C/C++ applications + +=item SYNOPSIS + +=item DESCRIPTION + +=item @EXPORT + +=item FUNCTIONS + +xsinit(), Examples, ldopts(), Examples, perl_inc(), ccflags(), ccdlflags(), +ccopts(), xsi_header(), xsi_protos(@modules), xsi_body(@modules) + +=item EXAMPLES + +=item SEE ALSO + +=item AUTHOR + +=head2 ExtUtils::Install - install files from here to there + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 ExtUtils::Installed - Inventory management of installed modules + +=item SYNOPSIS + +=item DESCRIPTION + +=item USAGE + +=item FUNCTIONS + +new(), modules(), files(), directories(), directory_tree(), validate(), +packlist(), version() + +=item EXAMPLE + +=item AUTHOR + +=head2 ExtUtils::Liblist - determine libraries to use and how to use them + +=item SYNOPSIS + +=item DESCRIPTION + +For static extensions, For dynamic extensions, For dynamic extensions + +=over + +=item EXTRALIBS + +=item LDLOADLIBS and LD_RUN_PATH + +=item BSLOADLIBS + +=back + +=item PORTABILITY + +=over + +=item VMS implementation + +=item Win32 implementation + +=back + +=item SEE ALSO + +=head2 ExtUtils::MM_OS2 - methods to override UN*X behaviour in +ExtUtils::MakeMaker + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker + +=item SYNOPSIS + +=item DESCRIPTION + +=item METHODS + +=over + +=item Preloaded methods + +canonpath, catdir, catfile, curdir, rootdir, updir + +=item SelfLoaded methods + +c_o (o), cflags (o), clean (o), const_cccmd (o), const_config (o), +const_loadlibs (o), constants (o), depend (o), dir_target (o), dist (o), +dist_basics (o), dist_ci (o), dist_core (o), dist_dir (o), dist_test (o), +dlsyms (o), dynamic (o), dynamic_bs (o), dynamic_lib (o), exescan, +extliblist, file_name_is_absolute, find_perl + +=item Methods to actually produce chunks of text for the Makefile + +fixin, force (o), guess_name, has_link_code, init_dirscan, init_main, +init_others, install (o), installbin (o), libscan (o), linkext (o), lsdir, +macro (o), makeaperl (o), makefile (o), manifypods (o), maybe_command, +maybe_command_in_dirs, needs_linking (o), nicetext, parse_version, +parse_abstract, pasthru (o), path, perl_script, perldepend (o), ppd, +perm_rw (o), perm_rwx (o), pm_to_blib, post_constants (o), post_initialize +(o), postamble (o), prefixify, processPL (o), realclean (o), +replace_manpage_separator, static (o), static_lib (o), staticmake (o), +subdir_x (o), subdirs (o), test (o), test_via_harness (o), test_via_script +(o), tool_autosplit (o), tools_other (o), tool_xsubpp (o), top_targets (o), +writedoc, xs_c (o), xs_o (o), perl_archive, export_list + +=back + +=item SEE ALSO + +=head2 ExtUtils::MM_VMS - methods to override UN*X behaviour in +ExtUtils::MakeMaker + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Methods always loaded + +eliminate_macros, fixpath, catdir, catfile, wraplist, curdir (override), +rootdir (override), updir (override) + +=item SelfLoaded methods + +guess_name (override), find_perl (override), path (override), maybe_command +(override), maybe_command_in_dirs (override), perl_script (override), +file_name_is_absolute (override), replace_manpage_separator, init_others +(override), constants (override), cflags (override), const_cccmd +(override), pm_to_blib (override), tool_autosplit (override), tool_sxubpp +(override), xsubpp_version (override), tools_other (override), dist +(override), c_o (override), xs_c (override), xs_o (override), top_targets +(override), dlsyms (override), dynamic_lib (override), dynamic_bs +(override), static_lib (override), manifypods (override), processPL +(override), installbin (override), subdir_x (override), clean (override), +realclean (override), dist_basics (override), dist_core (override), +dist_dir (override), dist_test (override), install (override), perldepend +(override), makefile (override), test (override), test_via_harness +(override), test_via_script (override), makeaperl (override), nicetext +(override) + +=back + +=head2 ExtUtils::MM_Win32 - methods to override UN*X behaviour in +ExtUtils::MakeMaker + +=item SYNOPSIS + +=item DESCRIPTION + +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 SYNOPSIS + +=item DESCRIPTION + +=over + +=item How To Write A Makefile.PL + +=item Default Makefile Behaviour + +=item make test + +=item make testdb + +=item make install + +=item PREFIX and LIB attribute + +=item AFS users + +=item Static Linking of a new Perl Binary + +=item Determination of Perl Library and Installation Locations + +=item Which architecture dependent directory? + +=item Using Attributes and Parameters + +C, CCFLAGS, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS, +EXCLUDE_EXT, EXE_FILES, NO_VC, FIRST_MAKEFILE, FULLPERL, H, IMPORTS, INC, +INCLUDE_EXT, INSTALLARCHLIB, INSTALLBIN, INSTALLDIRS, INSTALLMAN1DIR, +INSTALLMAN3DIR, INSTALLPRIVLIB, INSTALLSCRIPT, INSTALLSITELIB, +INSTALLSITEARCH, INST_ARCHLIB, INST_BIN, INST_EXE, INST_LIB, INST_MAN1DIR, +INST_MAN3DIR, INST_SCRIPT, LDFROM, LIBPERL_A, LIB, LIBS, LINKTYPE, +MAKEAPERL, MAKEFILE, MAN1PODS, MAN3PODS, MAP_TARGET, MYEXTLIB, NAME, +NEEDS_LINKING, NOECHO, NORECURS, OBJECT, OPTIMIZE, PERL, PERLMAINCC, +PERL_ARCHLIB, PERL_LIB, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, PM, +PMLIBDIRS, PREFIX, PREREQ_PM, SKIP, TYPEMAPS, VERSION, VERSION_FROM, XS, +XSOPT, XSPROTOARG, XS_VERSION + +=item Additional lowercase attributes + +clean, depend, dist, dynamic_lib, installpm, linkext, macro, realclean, +tool_autosplit + +=item Overriding MakeMaker Methods + +=item Hintsfile support + +=item Distribution Support + +make distcheck, make skipcheck, make distclean, make manifest, +make distdir, make tardist, make dist, make uutardist, make +shdist, make zipdist, make ci + +=item Disabling an extension + +=back + +=item SEE ALSO + +=item AUTHORS + +=head2 ExtUtils::Manifest - utilities to write and check a MANIFEST file + +=item SYNOPSIS + +=item DESCRIPTION + +=item MANIFEST.SKIP + +=item EXPORT_OK + +=item GLOBAL VARIABLES + +=item DIAGNOSTICS + +C I, C I, C I<$!>, +C I + +=item SEE ALSO + +=item AUTHOR + +=head2 ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 ExtUtils::Mksymlists - write linker options files for dynamic +extension + +=item SYNOPSIS + +=item DESCRIPTION + +NAME, DL_FUNCS, DL_VARS, FILE, FUNCLIST, DLBASE + +=item AUTHOR + +=item REVISION + +=head2 ExtUtils::Packlist - manage .packlist files + +=item SYNOPSIS + +=item DESCRIPTION + +=item USAGE + +=item FUNCTIONS + +new(), read(), write(), validate(), packlist_file() + +=item EXAMPLE + +=item AUTHOR + +=head2 ExtUtils::testlib - add blib/* directories to @INC + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Fatal - replace functions with equivalents which succeed or die + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 Fcntl - load the C Fcntl.h defines + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item EXPORTED SYMBOLS + +=head2 File::Basename, fileparse - split a pathname into pieces + +=item SYNOPSIS + +=item DESCRIPTION + +fileparse_set_fstype, fileparse + +=item EXAMPLES + +C, C + +=head2 File::CheckTree, validate - run many filetest checks on a tree + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 File::Compare - Compare files or filehandles + +=item SYNOPSIS + +=item DESCRIPTION + +=item RETURN + +=item AUTHOR + +=head2 File::Copy - Copy files or filehandles + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Special behavior if C is defined (VMS and OS/2) + +rmscopy($from,$to[,$date_flag]) + +=back + +=item RETURN + +=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 + +=item DESCRIPTION + +=item BUGS + +=head2 File::Path - create or remove a series of directories + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHORS + +=item REVISION + +=head2 File::Spec - portably perform operations on file names + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=item AUTHORS + +=head2 File::Spec::Mac - File::Spec for MacOS + +=item SYNOPSIS + +=item DESCRIPTION + +=item METHODS + +canonpath, catdir, catfile, curdir, rootdir, updir, file_name_is_absolute, +path + +=item SEE ALSO + +=head2 File::Spec::OS2 - methods for OS/2 file specs + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 File::Spec::Unix - methods used by File::Spec + +=item SYNOPSIS + +=item DESCRIPTION + +=item METHODS + +canonpath, catdir, catfile, curdir, rootdir, updir, no_upwards, +file_name_is_absolute, path, join, nativename + +=item SEE ALSO + +=head2 File::Spec::VMS - methods for VMS file specs + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Methods always loaded + +catdir, catfile, curdir (override), rootdir (override), updir (override), +path (override), file_name_is_absolute (override) + +=back + +=head2 File::Spec::Win32 - methods for Win32 file specs + +=item SYNOPSIS + +=item DESCRIPTION + +catfile, canonpath + +=head2 File::stat - by-name interface to Perl's built-in stat() functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head2 FileCache - keep more files open than the system permits + +=item SYNOPSIS + +=item DESCRIPTION + +=item BUGS + +=head2 FileHandle - supply object methods for filehandles + +=item SYNOPSIS + +=item DESCRIPTION + +$fh->print, $fh->printf, $fh->getline, $fh->getlines + +=item SEE ALSO + +=head2 FindBin - Locate directory of original perl script + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXPORTABLE VARIABLES + +=item KNOWN BUGS + +=item AUTHORS + +=item COPYRIGHT + +=item REVISION + +=head2 GDBM_File - Perl5 access to the gdbm library. + +=item SYNOPSIS + +=item DESCRIPTION + +=item AVAILABILITY + +=item BUGS + +=item SEE ALSO + +=head2 Getopt::Long, GetOptions - extended processing of command line +options + +=item SYNOPSIS + +=item DESCRIPTION + +!, +, :s, :i, :f + +=over + +=item Linkage specification + +=item Aliases and abbreviations + +=item Non-option call-back routine + +=item Option starters + +=item Return values and Errors + +=back + +=item COMPATIBILITY + +=item EXAMPLES + +=item CONFIGURATION OPTIONS + +default, auto_abbrev, getopt_compat, require_order, permute, bundling +(default: reset), bundling_override (default: reset), ignore_case +(default: set), ignore_case_always (default: reset), pass_through (default: +reset), prefix, prefix_pattern, debug (default: reset) + +=item OTHER USEFUL VARIABLES + +$Getopt::Long::VERSION, $Getopt::Long::error + +=item AUTHOR + +=item COPYRIGHT AND DISCLAIMER + +=head2 Getopt::Std, getopt - Process single-character switches with switch +clustering + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 I18N::Collate - compare 8-bit scalar data according to the current +locale + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 IO - load various IO modules + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 IO::lib::IO::File, IO::File - supply object methods for filehandles + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONSTRUCTOR + +new ([ ARGS ] ), new_tmpfile + +=item METHODS + +open( FILENAME [,MODE [,PERMS]] ) + +=item SEE ALSO + +=item HISTORY + +=head2 IO::lib::IO::Handle, IO::Handle - supply object methods for I/O +handles + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONSTRUCTOR + +new (), new_from_fd ( FD, MODE ) + +=item METHODS + +$fh->fdopen ( FD, MODE ), $fh->opened, $fh->getline, $fh->getlines, +$fh->ungetc ( ORD ), $fh->write ( BUF, LEN [, OFFSET }\] ), $fh->flush, +$fh->error, $fh->clearerr, $fh->untaint + +=item NOTE + +=item SEE ALSO + +=item BUGS + +=item HISTORY + +=head2 IO::lib::IO::Pipe, IO::pipe - supply object methods for pipes + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONSTRCUTOR + +new ( [READER, WRITER] ) + +=item METHODS + +reader ([ARGS]), writer ([ARGS]), handles () + +=item SEE ALSO + +=item AUTHOR + +=item COPYRIGHT + +=head2 IO::lib::IO::Seekable, IO::Seekable - supply seek based methods for +I/O objects + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=item HISTORY + +=head2 IO::lib::IO::Select, IO::Select - OO interface to the select system +call + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONSTRUCTOR + +new ( [ HANDLES ] ) + +=item METHODS + +add ( HANDLES ), remove ( HANDLES ), exists ( HANDLE ), handles, can_read ( +[ TIMEOUT ] ), can_write ( [ TIMEOUT ] ), has_error ( [ TIMEOUT ] ), count +(), bits(), bits(), select ( READ, WRITE, ERROR [, TIMEOUT ] ) + +=item EXAMPLE + +=item AUTHOR + +=item COPYRIGHT + +=head2 IO::lib::IO::Socket, IO::Socket - Object interface to socket +communications + +=item SYNOPSIS + +=item DESCRIPTION + +=item CONSTRUCTOR + +new ( [ARGS] ) + +=item METHODS + +accept([PKG]), timeout([VAL]), sockopt(OPT [, VAL]), sockdomain, socktype, +protocol + +=item SUB-CLASSES + +=over + +=item IO::Socket::INET + +=item METHODS + +sockaddr (), sockport (), sockhost (), peeraddr (), peerport (), peerhost +() + +=item IO::Socket::UNIX + +=item METHODS + +hostpath(), peerpath() + +=back + +=item SEE ALSO + +=item AUTHOR + +=item COPYRIGHT + +=head2 IPC::Open2, open2 - open a process for both reading and writing + +=item SYNOPSIS + +=item DESCRIPTION + +=item WARNING + +=item SEE ALSO + +=head2 IPC::Open3, open3 - open a process for reading, writing, and error +handling + +=item SYNOPSIS + +=item DESCRIPTION + +=item WARNING + +=head2 IPC::SysV - SysV IPC constants + +=item SYNOPSIS + +=item DESCRIPTION + +ftok( PATH, ID ) + +=item SEE ALSO + +=item AUTHORS + +=item COPYRIGHT + +=head2 IPC::SysV::Msg, IPC::Msg - SysV Msg IPC object class + +=item SYNOPSIS + +=item DESCRIPTION + +=item METHODS + +new ( KEY , FLAGS ), id, rcv ( BUF, LEN [, TYPE [, FLAGS ]] ), remove, set +( STAT ), set ( NAME => VALUE [, NAME => VALUE ...] ), snd ( TYPE, MSG [, +FLAGS ] ), stat + +=item SEE ALSO + +=item AUTHOR + +=item COPYRIGHT + +=head2 IPC::SysV::Semaphore, IPC::Semaphore - SysV Semaphore IPC object +class + +=item SYNOPSIS + +=item DESCRIPTION + +=item METHODS + +new ( KEY , NSEMS , FLAGS ), getall, getncnt ( SEM ), getpid ( SEM ), +getval ( SEM ), getzcnt ( SEM ), id, op ( OPLIST ), remove, set ( STAT ), +set ( NAME => VALUE [, NAME => VALUE ...] ), setall ( VALUES ), setval ( N +, VALUE ), stat + +=item SEE ALSO + +=item AUTHOR + +=item COPYRIGHT + +=head2 Math::BigFloat - Arbitrary length float math package + +=item SYNOPSIS + +=item DESCRIPTION + +number format, Error returns 'NaN', Division is computed to + +=item BUGS + +=item AUTHOR + +=head2 Math::BigInt - Arbitrary size integer math package + +=item SYNOPSIS + +=item DESCRIPTION + +Canonical notation, Input, Output + +=item EXAMPLES + +=item Autocreating constants + +=item BUGS + +=item AUTHOR + +=head2 Math::Complex - complex numbers and associated mathematical +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item OPERATIONS + +=item CREATION + +=item STRINGIFICATION + +=item USAGE + +=item ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO + +=item ERRORS DUE TO INDIGESTIBLE ARGUMENTS + +=item BUGS + +=item AUTHORS + +=head2 Math::Trig - trigonometric functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item TRIGONOMETRIC FUNCTIONS + +B + +=over + +=item ERRORS DUE TO DIVISION BY ZERO + +=item SIMPLE (REAL) ARGUMENTS, COMPLEX RESULTS + +=back + +=item PLANE ANGLE CONVERSIONS + +=item RADIAL COORDINATE CONVERSIONS + +=over + +=item COORDINATE SYSTEMS + +=item 3-D ANGLE CONVERSIONS + +cartesian_to_cylindrical, cartesian_to_spherical, cylindrical_to_cartesian, +cylindrical_to_spherical, spherical_to_cartesian, spherical_to_cylindrical + +=back + +=item GREAT CIRCLE DISTANCES + +=item EXAMPLES + +=item BUGS + +=item AUTHORS + +=head2 NDBM_File - Tied access to ndbm files + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Net::Ping - check a remote host for reachability + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Functions + +Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);, $p->ping($host [, +$timeout]);, $p->close();, pingecho($host [, $timeout]); + +=back + +=item WARNING + +=item NOTES + +=head2 Net::hostent - by-name interface to Perl's built-in gethost*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +=item NOTE + +=item AUTHOR + +=head2 Net::netent - by-name interface to Perl's built-in getnet*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +=item NOTE + +=item AUTHOR + +=head2 Net::protoent - by-name interface to Perl's built-in getproto*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head2 Net::servent - by-name interface to Perl's built-in getserv*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +=item NOTE + +=item AUTHOR + +=head2 ODBM_File - Tied access to odbm files + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Opcode - Disable named opcodes when compiling perl code + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item WARNING + +=item Operator Names and Operator Lists + +an operator name (opname), an operator tag name (optag), a negated opname +or optag, an operator set (opset) + +=item Opcode Functions + +opcodes, opset (OP, ...), opset_to_ops (OPSET), opset_to_hex (OPSET), +full_opset, empty_opset, invert_opset (OPSET), verify_opset (OPSET, ...), +define_optag (OPTAG, OPSET), opmask_add (OPSET), opmask, opdesc (OP, ...), +opdump (PAT) + +=item Manipulating Opsets + +=item TO DO (maybe) + +=item Predefined Opcode Tags + +:base_core, :base_mem, :base_loop, :base_io, :base_orig, :base_math, +:base_thread, :default, :filesys_read, :sys_db, :browse, :filesys_open, +:filesys_write, :subprocess, :ownprocess, :others, :still_to_be_decided, +:dangerous + +=item SEE ALSO + +=item AUTHORS + +=head2 Opcode::Safe, Safe - Compile and execute code in restricted +compartments + +=item SYNOPSIS + +=item DESCRIPTION + +a new namespace, an operator mask + +=item WARNING + +=over + +=item RECENT CHANGES + +=item Methods in class Safe + +permit (OP, ...), permit_only (OP, ...), deny (OP, ...), deny_only (OP, +...), trap (OP, ...), untrap (OP, ...), share (NAME, ...), share_from +(PACKAGE, ARRAYREF), varglob (VARNAME), reval (STRING), rdo (FILENAME), +root (NAMESPACE), mask (MASK) + +=item Some Safety Issues + +Memory, CPU, Snooping, Signals, State Changes + +=item AUTHOR + +=back + +=head2 Opcode::ops, ops - Perl pragma to restrict unsafe operations when +compiling + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=head2 POSIX - Perl interface to IEEE Std 1003.1 + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item CAVEATS + +=item FUNCTIONS + +_exit, abort, abs, access, acos, alarm, asctime, asin, assert, atan, atan2, +atexit, atof, atoi, atol, bsearch, calloc, ceil, chdir, chmod, chown, +clearerr, clock, close, closedir, cos, cosh, creat, ctermid, ctime, +cuserid, difftime, div, dup, dup2, errno, execl, execle, execlp, execv, +execve, execvp, exit, exp, fabs, fclose, fcntl, fdopen, feof, ferror, +fflush, fgetc, fgetpos, fgets, fileno, floor, fmod, fopen, fork, fpathconf, +fprintf, fputc, fputs, fread, free, freopen, frexp, fscanf, fseek, fsetpos, +fstat, ftell, fwrite, getc, getchar, getcwd, getegid, getenv, geteuid, +getgid, getgrgid, getgrnam, getgroups, getlogin, getpgrp, getpid, getppid, +getpwnam, getpwuid, gets, getuid, gmtime, isalnum, isalpha, isatty, +iscntrl, isdigit, isgraph, islower, isprint, ispunct, isspace, isupper, +isxdigit, kill, labs, ldexp, ldiv, link, localeconv, localtime, log, log10, +longjmp, lseek, malloc, mblen, mbstowcs, mbtowc, memchr, memcmp, memcpy, +memmove, memset, mkdir, mkfifo, mktime, modf, nice, offsetof, open, +opendir, pathconf, pause, perror, pipe, pow, printf, putc, putchar, puts, +qsort, raise, rand, read, readdir, realloc, remove, rename, rewind, +rewinddir, rmdir, scanf, setgid, setjmp, setlocale, setpgid, setsid, +setuid, sigaction, siglongjmp, sigpending, sigprocmask, sigsetjmp, +sigsuspend, sin, sinh, sleep, sprintf, sqrt, srand, sscanf, stat, strcat, +strchr, strcmp, strcoll, strcpy, strcspn, strerror, strftime, strlen, +strncat, strncmp, strncpy, stroul, strpbrk, strrchr, strspn, strstr, +strtod, strtok, strtol, strtoul, strxfrm, sysconf, system, tan, tanh, +tcdrain, tcflow, tcflush, tcgetpgrp, tcsendbreak, tcsetpgrp, time, times, +tmpfile, tmpnam, tolower, toupper, ttyname, tzname, tzset, umask, uname, +ungetc, unlink, utime, vfprintf, vprintf, vsprintf, wait, waitpid, +wcstombs, wctomb, write + +=item CLASSES + +=over + +=item POSIX::SigAction + +new + +=item POSIX::SigSet + +new, addset, delset, emptyset, fillset, ismember + +=item POSIX::Termios + +new, getattr, getcc, getcflag, getiflag, getispeed, getlflag, getoflag, +getospeed, setattr, setcc, setcflag, setiflag, setispeed, setlflag, +setoflag, setospeed, Baud rate values, Terminal interface values, c_cc +field values, c_cflag field values, c_iflag field values, c_lflag field +values, c_oflag field values + +=back + +=item PATHNAME CONSTANTS + +Constants + +=item POSIX CONSTANTS + +Constants + +=item SYSTEM CONFIGURATION + +Constants + +=item ERRNO + +Constants + +=item FCNTL + +Constants + +=item FLOAT + +Constants + +=item LIMITS + +Constants + +=item LOCALE + +Constants + +=item MATH + +Constants + +=item SIGNAL + +Constants + +=item STAT + +Constants, Macros + +=item STDLIB + +Constants + +=item STDIO + +Constants + +=item TIME + +Constants + +=item UNISTD + +Constants + +=item WAIT + +Constants, Macros + +=item CREATION + +=head2 Pod::Html - module to convert pod files to HTML + +=item SYNOPSIS + +=item DESCRIPTION + +=item ARGUMENTS + +help, htmlroot, infile, outfile, podroot, podpath, libpods, netscape, +nonetscape, index, noindex, recurse, norecurse, title, verbose + +=item EXAMPLE + +=item AUTHOR + +=item BUGS + +=item SEE ALSO + +=item COPYRIGHT + +=head2 Pod::Text - convert POD data to formatted ASCII text + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=item TODO + +=head2 SDBM_File - Tied access to sdbm files + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Search::Dict, look - search for key in dictionary file + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 SelectSaver - save and restore selected file handle + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 SelfLoader - load functions only on demand + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item The __DATA__ token + +=item SelfLoader autoloading + +=item Autoloading and package lexicals + +=item SelfLoader and AutoLoader + +=item __DATA__, __END__, and the FOOBAR::DATA filehandle. + +=item Classes and inherited methods. + +=back + +=item Multiple packages and fully qualified subroutine names + +=head2 Shell - run shell commands transparently within perl + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C +socket.h defines and structure manipulators + +=item SYNOPSIS + +=item DESCRIPTION + +inet_aton HOSTNAME, inet_ntoa IP_ADDRESS, INADDR_ANY, INADDR_BROADCAST, +INADDR_LOOPBACK, INADDR_NONE, sockaddr_in PORT, ADDRESS, sockaddr_in +SOCKADDR_IN, pack_sockaddr_in PORT, IP_ADDRESS, unpack_sockaddr_in +SOCKADDR_IN, sockaddr_un PATHNAME, sockaddr_un SOCKADDR_UN, +pack_sockaddr_un PATH, unpack_sockaddr_un SOCKADDR_UN + +=head2 Symbol - manipulate Perl symbols and their names + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Sys::Hostname - Try every conceivable way to get hostname + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 Syslog, Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl +interface to the UNIX syslog(3) calls + +=item SYNOPSIS + +=item DESCRIPTION + +openlog $ident, $logopt, $facility, syslog $priority, $format, @args, +setlogmask $mask_priority, setlogsock $sock_type (added in 5.004_02), +closelog + +=item EXAMPLES + +=item DEPENDENCIES + +=item SEE ALSO + +=item AUTHOR + +=head2 Term::Cap - Perl termcap interface + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +=head2 Term::Complete - Perl word completion module + +=item SYNOPSIS + +=item DESCRIPTION + +EtabE, ^D, ^U, EdelE, EbsE + +=item DIAGNOSTICS + +=item BUGS + +=item AUTHOR + +=head2 Term::ReadLine - Perl interface to various C packages. If +no real package is found, substitutes stubs instead of basic functions. + +=item SYNOPSIS + +=item DESCRIPTION + +=item Minimal set of supported functions + +C, C, C, C, C, $C, +C, C, Attribs, C + +=item Additional supported functions + +C, C, C + +=item EXPORTS + +=item ENVIRONMENT + +=head2 Test - provides a simple framework for writing test scripts + +=item SYNOPSIS + +=item DESCRIPTION + +=item TEST TYPES + +NORMAL TESTS, SKIPPED TESTS, TODO TESTS + +=item ONFAIL + +=item SEE ALSO + +=item AUTHOR + +=head2 Test::Harness - run perl standard test scripts with statistics + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item The test script output + +=back + +=item EXPORT + +=item DIAGNOSTICS + +C, C, C, C, C + +=item ENVIRONMENT + +=item SEE ALSO + +=item AUTHORS + +=item BUGS + +=head2 Text::Abbrev, abbrev - create an abbreviation table from a list + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLE + +=head2 Text::ParseWords - parse text into an array of tokens or array of +arrays + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +0a simple word, 1multiple spaces are skipped because of our $delim, 2use of +quotes to include a space in a word, 3use of a backslash to include a space +in a word, 4use of a backslash to remove the special meaning of a +double-quote, 5another simple word (note the lack of effect of the +backslashed double-quote) + +=item AUTHORS + +=head2 Text::Soundex - Implementation of the Soundex Algorithm as Described +by Knuth + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLES + +=item LIMITATIONS + +=item AUTHOR + +=head2 Text::Tabs -- expand and unexpand tabs per the unix expand(1) and +unexpand(1) + +=item SYNOPSIS + +=item DESCRIPTION + +=item BUGS + +=item AUTHOR + +=head2 Text::Wrap - line wrapping to form simple paragraphs + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLE + +=item BUGS + +=item AUTHOR + +=head2 Thread - multithreading + +=item SYNOPSIS + +=item DESCRIPTION + +=item FUNCTIONS + +new \&start_sub, new \&start_sub, LIST, lock VARIABLE, async BLOCK;, +Thread->self, Thread->list, cond_wait VARIABLE, cond_signal VARIABLE, +cond_broadcast VARIABLE + +=item METHODS + +join, eval, tid + +=item LIMITATIONS + +=item SEE ALSO + +=head2 Thread::Queue - thread-safe queues + +=item SYNOPSIS + +=item DESCRIPTION + +=item FUNCTIONS AND METHODS + +new, enqueue LIST, dequeue, dequeue_nb, pending + +=item SEE ALSO + +=head2 Thread::Semaphore - thread-safe semaphores + +=item SYNOPSIS + +=item DESCRIPTION + +=item FUNCTIONS AND METHODS + +new, new NUMBER, down, down NUMBER, up, up NUMBER + +=head2 Thread::Signal - Start a thread which runs signal handlers reliably + +=item SYNOPSIS + +=item DESCRIPTION + +=item BUGS + +=head2 Thread::Specific - thread-specific keys + +=item SYNOPSIS + +=head2 Tie::Array - base class for tied arrays + +=item SYNOPSIS + +=item DESCRIPTION + +TIEARRAY classname, LIST, STORE this, index, value, FETCH this, index, +FETCHSIZE this, STORESIZE this, count, EXTEND this, count, CLEAR this, +DESTROY this, PUSH this, LIST, POP this, SHIFT this, UNSHIFT this, LIST, +SPLICE this, offset, length, LIST + +=item CAVEATS + +=item AUTHOR + +=head2 Tie::Handle - base class definitions for tied handles + +=item SYNOPSIS + +=item DESCRIPTION + +TIEHANDLE classname, LIST, WRITE this, scalar, length, offset, PRINT this, +LIST, PRINTF this, format, LIST, READ this, scalar, length, offset, +READLINE this, GETC this, DESTROY this + +=item MORE INFORMATION + +=head2 Tie::Hash, Tie::StdHash - base class definitions for tied hashes + +=item SYNOPSIS + +=item DESCRIPTION + +TIEHASH classname, LIST, STORE this, key, value, FETCH this, key, FIRSTKEY +this, NEXTKEY this, lastkey, EXISTS this, key, DELETE this, key, CLEAR this + +=item CAVEATS + +=item MORE INFORMATION + +=head2 Tie::RefHash - use references as hash keys + +=item SYNOPSIS + +=item DESCRIPTION + +=item EXAMPLE + +=item AUTHOR + +=item VERSION + +=item SEE ALSO + +=head2 Tie::Scalar, Tie::StdScalar - base class definitions for tied +scalars + +=item SYNOPSIS + +=item DESCRIPTION + +TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this + +=item MORE INFORMATION + +=head2 Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing + +=item SYNOPSIS + +=item DESCRIPTION + +=item CAVEATS + +=head2 Time::Local - efficiently compute time from local and GMT time + +=item SYNOPSIS + +=item DESCRIPTION + +=head2 Time::gmtime - by-name interface to Perl's built-in gmtime() +function + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head2 Time::localtime - by-name interface to Perl's built-in localtime() +function + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head2 Time::tm - internal object used by Time::gmtime and Time::localtime + +=item SYNOPSIS + +=item DESCRIPTION + +=item AUTHOR + +=head2 UNIVERSAL - base class for ALL classes (blessed references) + +=item SYNOPSIS + +=item DESCRIPTION + +isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), UNIVERSAL::isa ( +VAL, TYPE ), UNIVERSAL::can ( VAL, METHOD ) + +=head2 User::grent - by-name interface to Perl's built-in getgr*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head2 User::pwent - by-name interface to Perl's built-in getpw*() +functions + +=item SYNOPSIS + +=item DESCRIPTION + +=item NOTE + +=item AUTHOR + +=head1 AUXILIARY DOCUMENTATION + +Here should be listed all the extra programs' documentation, but they +don't all have manual pages yet: + +=item a2p + +=item s2p + +=item find2perl + +=item h2ph + +=item c2ph + +=item h2xs + +=item xsubpp + +=item pod2man + +=item wrapsuid + +=head1 AUTHOR + +Larry Wall >, with the help of oodles +of other folks. + diff --git a/contrib/perl5/pod/perltoot.pod b/contrib/perl5/pod/perltoot.pod new file mode 100644 index 00000000000..c77a971b57f --- /dev/null +++ b/contrib/perl5/pod/perltoot.pod @@ -0,0 +1,1787 @@ +=head1 NAME + +perltoot - Tom's object-oriented tutorial for perl + +=head1 DESCRIPTION + +Object-oriented programming is a big seller these days. Some managers +would rather have objects than sliced bread. Why is that? What's so +special about an object? Just what I an object anyway? + +An object is nothing but a way of tucking away complex behaviours into +a neat little easy-to-use bundle. (This is what professors call +abstraction.) Smart people who have nothing to do but sit around for +weeks on end figuring out really hard problems make these nifty +objects that even regular people can use. (This is what professors call +software reuse.) Users (well, programmers) can play with this little +bundle all they want, but they aren't to open it up and mess with the +insides. Just like an expensive piece of hardware, the contract says +that you void the warranty if you muck with the cover. So don't do that. + +The heart of objects is the class, a protected little private namespace +full of data and functions. A class is a set of related routines that +addresses some problem area. You can think of it as a user-defined type. +The Perl package mechanism, also used for more traditional modules, +is used for class modules as well. Objects "live" in a class, meaning +that they belong to some package. + +More often than not, the class provides the user with little bundles. +These bundles are objects. They know whose class they belong to, +and how to behave. Users ask the class to do something, like "give +me an object." Or they can ask one of these objects to do something. +Asking a class to do something for you is calling a I. +Asking an object to do something for you is calling an I. +Asking either a class (usually) or an object (sometimes) to give you +back an object is calling a I, which is just a +kind of method. + +That's all well and good, but how is an object different from any other +Perl data type? Just what is an object I; that is, what's its +fundamental type? The answer to the first question is easy. An object +is different from any other data type in Perl in one and only one way: +you may dereference it using not merely string or numeric subscripts +as with simple arrays and hashes, but with named subroutine calls. +In a word, with I. + +The answer to the second question is that it's a reference, and not just +any reference, mind you, but one whose referent has been I()ed +into a particular class (read: package). What kind of reference? Well, +the answer to that one is a bit less concrete. That's because in Perl +the designer of the class can employ any sort of reference they'd like +as the underlying intrinsic data type. It could be a scalar, an array, +or a hash reference. It could even be a code reference. But because +of its inherent flexibility, an object is usually a hash reference. + +=head1 Creating a Class + +Before you create a class, you need to decide what to name it. That's +because the class (package) name governs the name of the file used to +house it, just as with regular modules. Then, that class (package) +should provide one or more ways to generate objects. Finally, it should +provide mechanisms to allow users of its objects to indirectly manipulate +these objects from a distance. + +For example, let's make a simple Person class module. It gets stored in +the file Person.pm. If it were called a Happy::Person class, it would +be stored in the file Happy/Person.pm, and its package would become +Happy::Person instead of just Person. (On a personal computer not +running Unix or Plan 9, but something like MacOS or VMS, the directory +separator may be different, but the principle is the same.) Do not assume +any formal relationship between modules based on their directory names. +This is merely a grouping convenience, and has no effect on inheritance, +variable accessibility, or anything else. + +For this module we aren't going to use Exporter, because we're +a well-behaved class module that doesn't export anything at all. +In order to manufacture objects, a class needs to have a I. A constructor gives you back not just a regular data type, +but a brand-new object in that class. This magic is taken care of by +the bless() function, whose sole purpose is to enable its referent to +be used as an object. Remember: being an object really means nothing +more than that methods may now be called against it. + +While a constructor may be named anything you'd like, most Perl +programmers seem to like to call theirs new(). However, new() is not +a reserved word, and a class is under no obligation to supply such. +Some programmers have also been known to use a function with +the same name as the class as the constructor. + +=head2 Object Representation + +By far the most common mechanism used in Perl to represent a Pascal +record, a C struct, or a C++ class 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. + +If you were just doing a simple +struct-like emulation, you would likely go about it something like this: + + $rec = { + name => "Jason", + age => 23, + peers => [ "Norbert", "Rhys", "Phineas"], + }; + +If you felt like it, you could add a bit of visual distinction +by up-casing the hash keys: + + $rec = { + NAME => "Jason", + AGE => 23, + PEERS => [ "Norbert", "Rhys", "Phineas"], + }; + +And so you could get at C<$rec-E{NAME}> to find "Jason", or +C<@{ $rec-E{PEERS} }> to get at "Norbert", "Rhys", and "Phineas". +(Have you ever noticed how many 23-year-old programmers seem to +be named "Jason" these days? :-) + +This same model is often used for classes, although it is not considered +the pinnacle of programming propriety for folks from outside the +class to come waltzing into an object, brazenly accessing its data +members directly. Generally speaking, an object should be considered +an opaque cookie that you use I to access. Visually, +methods look like you're dereffing a reference using a function name +instead of brackets or braces. + +=head2 Class Interface + +Some languages provide a formal syntactic interface to a class's methods, +but Perl does not. It relies on you to read the documentation of each +class. If you try to call an undefined method on an object, Perl won't +complain, but the program will trigger an exception while it's running. +Likewise, if you call a method expecting a prime number as its argument +with a non-prime one instead, you can't expect the compiler to catch this. +(Well, you can expect it all you like, but it's not going to happen.) + +Let's suppose you have a well-educated user of your Person class, +someone who has read the docs that explain the prescribed +interface. Here's how they might use the Person class: + + use Person; + + $him = Person->new(); + $him->name("Jason"); + $him->age(23); + $him->peers( "Norbert", "Rhys", "Phineas" ); + + push @All_Recs, $him; # save object in array for later + + printf "%s is %d years old.\n", $him->name, $him->age; + print "His peers are: ", join(", ", $him->peers), "\n"; + + printf "Last rec's name is %s\n", $All_Recs[-1]->name; + +As you can see, the user of the class doesn't know (or at least, has no +business paying attention to the fact) that the object has one particular +implementation or another. The interface to the class and its objects +is exclusively via methods, and that's all the user of the class should +ever play with. + +=head2 Constructors and Instance Methods + +Still, I has to know what's in the object. And that someone is +the class. It implements methods that the programmer uses to access +the object. Here's how to implement the Person class using the standard +hash-ref-as-an-object idiom. We'll make a class method called new() to +act as the constructor, and three object methods called name(), age(), and +peers() to get at per-object data hidden away in our anonymous hash. + + package Person; + use strict; + + ################################################## + ## the object constructor (simplistic version) ## + ################################################## + sub new { + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless($self); # but see below + return $self; + } + + ############################################## + ## methods to access per-object data ## + ## ## + ## With args, they set the value. Without ## + ## any, they only retrieve it/them. ## + ############################################## + + sub name { + my $self = shift; + if (@_) { $self->{NAME} = shift } + return $self->{NAME}; + } + + sub age { + my $self = shift; + if (@_) { $self->{AGE} = shift } + return $self->{AGE}; + } + + sub peers { + my $self = shift; + if (@_) { @{ $self->{PEERS} } = @_ } + return @{ $self->{PEERS} }; + } + + 1; # so the require or use succeeds + +We've created three methods to access an object's data, name(), age(), +and peers(). These are all substantially similar. If called with an +argument, they set the appropriate field; otherwise they return the +value held by that field, meaning the value of that hash key. + +=head2 Planning for the Future: Better Constructors + +Even though at this point you may not even know what it means, someday +you're going to worry about inheritance. (You can safely ignore this +for now and worry about it later if you'd like.) To ensure that this +all works out smoothly, you must use the double-argument form of bless(). +The second argument is the class into which the referent will be blessed. +By not assuming our own class as the default second argument and instead +using the class passed into us, we make our constructor inheritable. + +While we're at it, let's make our constructor a bit more flexible. +Rather than being uniquely a class method, we'll set it up so that +it can be called as either a class method I an object +method. That way you can say: + + $me = Person->new(); + $him = $me->new(); + +To do this, all we have to do is check whether what was passed in +was a reference or not. If so, we were invoked as an object method, +and we need to extract the package (class) using the ref() function. +If not, we just use the string passed in as the package name +for blessing our referent. + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless ($self, $class); + return $self; + } + +That's about all there is for constructors. These methods bring objects +to life, returning neat little opaque bundles to the user to be used in +subsequent method calls. + +=head2 Destructors + +Every story has a beginning and an end. The beginning of the object's +story is its constructor, explicitly called when the object comes into +existence. But the ending of its story is the I, a method +implicitly called when an object leaves this life. Any per-object +clean-up code is placed in the destructor, which must (in Perl) be called +DESTROY. + +If constructors can have arbitrary names, then why not destructors? +Because while a constructor is explicitly called, a destructor is not. +Destruction happens automatically via Perl's garbage collection (GC) +system, which is a quick but somewhat lazy reference-based GC system. +To know what to call, Perl insists that the destructor be named DESTROY. +Perl's notion of the right time to call a destructor is not well-defined +currently, which is why your destructors should not rely on when they are +called. + +Why is DESTROY in all caps? Perl on occasion uses purely uppercase +function names as a convention to indicate that the function will +be automatically called by Perl in some way. Others that are called +implicitly include BEGIN, END, AUTOLOAD, plus all methods used by +tied objects, described in L. + +In really good object-oriented programming languages, the user doesn't +care when the destructor is called. It just happens when it's supposed +to. In low-level languages without any GC at all, there's no way to +depend on this happening at the right time, so the programmer must +explicitly call the destructor to clean up memory and state, crossing +their fingers that it's the right time to do so. Unlike C++, an +object destructor is nearly never needed in Perl, and even when it is, +explicit invocation is uncalled for. In the case of our Person class, +we don't need a destructor because Perl takes care of simple matters +like memory deallocation. + +The only situation where Perl's reference-based GC won't work is +when there's a circularity in the data structure, such as: + + $this->{WHATEVER} = $this; + +In that case, you must delete the self-reference manually if you expect +your program not to leak memory. While admittedly error-prone, this is +the best we can do right now. Nonetheless, rest assured that when your +program is finished, its objects' destructors are all duly called. +So you are guaranteed that an object I gets properly +destroyed, except in the unique case of a program that never exits. +(If you're running Perl embedded in another application, this full GC +pass happens a bit more frequently--whenever a thread shuts down.) + +=head2 Other Object Methods + +The methods we've talked about so far have either been constructors or +else simple "data methods", interfaces to data stored in the object. +These are a bit like an object's data members in the C++ world, except +that strangers don't access them as data. Instead, they should only +access the object's data indirectly via its methods. This is an +important rule: in Perl, access to an object's data should I +be made through methods. + +Perl doesn't impose restrictions on who gets to use which methods. +The public-versus-private distinction is by convention, not syntax. +(Well, unless you use the Alias module described below in +L.) Occasionally you'll see method names beginning or ending +with an underscore or two. This marking is a convention indicating +that the methods are private to that class alone and sometimes to its +closest acquaintances, its immediate subclasses. But this distinction +is not enforced by Perl itself. It's up to the programmer to behave. + +There's no reason to limit methods to those that simply access data. +Methods can do anything at all. The key point is that they're invoked +against an object or a class. Let's say we'd like object methods that +do more than fetch or set one particular field. + + sub exclaim { + my $self = shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $self->{NAME}, $self->{AGE}, join(", ", $self->{PEERS}); + } + +Or maybe even one like this: + + sub happy_birthday { + my $self = shift; + return ++$self->{AGE}; + } + +Some might argue that one should go at these this way: + + sub exclaim { + my $self = shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $self->name, $self->age, join(", ", $self->peers); + } + + sub happy_birthday { + my $self = shift; + return $self->age( $self->age() + 1 ); + } + +But since these methods are all executing in the class itself, this +may not be critical. There are tradeoffs to be made. Using direct +hash access is faster (about an order of magnitude faster, in fact), and +it's more convenient when you want to interpolate in strings. But using +methods (the external interface) internally shields not just the users of +your class but even you yourself from changes in your data representation. + +=head1 Class Data + +What about "class data", data items common to each object in a class? +What would you want that for? Well, in your Person class, you might +like to keep track of the total people alive. How do you implement that? + +You I make it a global variable called $Person::Census. But about +only reason you'd do that would be if you I people to be able to +get at your class data directly. They could just say $Person::Census +and play around with it. Maybe this is ok in your design scheme. +You might even conceivably want to make it an exported variable. To be +exportable, a variable must be a (package) global. If this were a +traditional module rather than an object-oriented one, you might do that. + +While this approach is expected in most traditional modules, it's +generally considered rather poor form in most object modules. In an +object module, you should set up a protective veil to separate interface +from implementation. So provide a class method to access class data +just as you provide object methods to access object data. + +So, you I still keep $Census as a package global and rely upon +others to honor the contract of the module and therefore not play around +with its implementation. You could even be supertricky and make $Census a +tied object as described in L, thereby intercepting all accesses. + +But more often than not, you just want to make your class data a +file-scoped lexical. To do so, simply put this at the top of the file: + + my $Census = 0; + +Even though the scope of a my() normally expires when the block in which +it was declared is done (in this case the whole file being required or +used), Perl's deep binding of lexical variables guarantees that the +variable will not be deallocated, remaining accessible to functions +declared within that scope. This doesn't work with global variables +given temporary values via local(), though. + +Irrespective of whether you leave $Census a package global or make +it instead a file-scoped lexical, you should make these +changes to your Person::new() constructor: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $Census++; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + bless ($self, $class); + return $self; + } + + sub population { + return $Census; + } + +Now that we've done this, we certainly do need a destructor so that +when Person is destroyed, the $Census goes down. Here's how +this could be done: + + sub DESTROY { --$Census } + +Notice how there's no memory to deallocate in the destructor? That's +something that Perl takes care of for you all by itself. + +=head2 Accessing Class Data + +It turns out that this is not really a good way to go about handling +class data. A good scalable rule is that I. Otherwise you aren't building a +scalable, inheritable class. The object must be the rendezvous point +for all operations, especially from an object method. The globals +(class data) would in some sense be in the "wrong" package in your +derived classes. In Perl, methods execute in the context of the class +they were defined in, I that of the object that triggered them. +Therefore, namespace visibility of package globals in methods is unrelated +to inheritance. + +Got that? Maybe not. Ok, let's say that some other class "borrowed" +(well, inherited) the DESTROY method as it was defined above. When those +objects are destroyed, the original $Census variable will be altered, +not the one in the new class's package namespace. Perhaps this is what +you want, but probably it isn't. + +Here's how to fix this. We'll store a reference to the data in the +value accessed by the hash key "_CENSUS". Why the underscore? Well, +mostly because an initial underscore already conveys strong feelings +of magicalness to a C programmer. It's really just a mnemonic device +to remind ourselves that this field is special and not to be used as +a public data member in the same way that NAME, AGE, and PEERS are. +(Because we've been developing this code under the strict pragma, prior +to perl version 5.004 we'll have to quote the field name.) + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{NAME} = undef; + $self->{AGE} = undef; + $self->{PEERS} = []; + # "private" data + $self->{"_CENSUS"} = \$Census; + bless ($self, $class); + ++ ${ $self->{"_CENSUS"} }; + return $self; + } + + sub population { + my $self = shift; + if (ref $self) { + return ${ $self->{"_CENSUS"} }; + } else { + return $Census; + } + } + + sub DESTROY { + my $self = shift; + -- ${ $self->{"_CENSUS"} }; + } + +=head2 Debugging Methods + +It's common for a class to have a debugging mechanism. For example, +you might want to see when objects are created or destroyed. To do that, +add a debugging variable as a file-scoped lexical. For this, we'll pull +in the standard Carp module to emit our warnings and fatal messages. +That way messages will come out with the caller's filename and +line number instead of our own; if we wanted them to be from our own +perspective, we'd just use die() and warn() directly instead of croak() +and carp() respectively. + + use Carp; + my $Debugging = 0; + +Now add a new class method to access the variable. + + sub debug { + my $class = shift; + if (ref $class) { confess "Class method called as object method" } + unless (@_ == 1) { confess "usage: CLASSNAME->debug(level)" } + $Debugging = shift; + } + +Now fix up DESTROY to murmur a bit as the moribund object expires: + + sub DESTROY { + my $self = shift; + if ($Debugging) { carp "Destroying $self " . $self->name } + -- ${ $self->{"_CENSUS"} }; + } + +One could conceivably make a per-object debug state. That +way you could call both of these: + + Person->debug(1); # entire class + $him->debug(1); # just this object + +To do so, we need our debugging method to be a "bimodal" one, one that +works on both classes I objects. Therefore, adjust the debug() +and DESTROY methods as follows: + + sub debug { + my $self = shift; + confess "usage: thing->debug(level)" unless @_ == 1; + my $level = shift; + if (ref($self)) { + $self->{"_DEBUG"} = $level; # just myself + } else { + $Debugging = $level; # whole class + } + } + + sub DESTROY { + my $self = shift; + if ($Debugging || $self->{"_DEBUG"}) { + carp "Destroying $self " . $self->name; + } + -- ${ $self->{"_CENSUS"} }; + } + +What happens if a derived class (which we'll call Employee) inherits +methods from this Person base class? Then Cdebug()>, when called +as a class method, manipulates $Person::Debugging not $Employee::Debugging. + +=head2 Class Destructors + +The object destructor handles the death of each distinct object. But sometimes +you want a bit of cleanup when the entire class is shut down, which +currently only happens when the program exits. To make such a +I, create a function in that class's package named +END. This works just like the END function in traditional modules, +meaning that it gets called whenever your program exits unless it execs +or dies of an uncaught signal. For example, + + sub END { + if ($Debugging) { + print "All persons are going away now.\n"; + } + } + +When the program exits, all the class destructors (END functions) are +be called in the opposite order that they were loaded in (LIFO order). + +=head2 Documenting the Interface + +And there you have it: we've just shown you the I of this +Person class. Its I would be its documentation. Usually this +means putting it in pod ("plain old documentation") format right there +in the same file. In our Person example, we would place the following +docs anywhere in the Person.pm file. Even though it looks mostly like +code, it's not. It's embedded documentation such as would be used by +the pod2man, pod2html, or pod2text programs. The Perl compiler ignores +pods entirely, just as the translators ignore code. Here's an example of +some pods describing the informal interface: + + =head1 NAME + + Person - class to implement people + + =head1 SYNOPSIS + + use Person; + + ################# + # class methods # + ################# + $ob = Person->new; + $count = Person->population; + + ####################### + # object data methods # + ####################### + + ### get versions ### + $who = $ob->name; + $years = $ob->age; + @pals = $ob->peers; + + ### set versions ### + $ob->name("Jason"); + $ob->age(23); + $ob->peers( "Norbert", "Rhys", "Phineas" ); + + ######################## + # other object methods # + ######################## + + $phrase = $ob->exclaim; + $ob->happy_birthday; + + =head1 DESCRIPTION + + The Person class implements dah dee dah dee dah.... + +That's all there is to the matter of interface versus implementation. +A programmer who opens up the module and plays around with all the private +little shiny bits that were safely locked up behind the interface contract +has voided the warranty, and you shouldn't worry about their fate. + +=head1 Aggregation + +Suppose you later want to change the class to implement better names. +Perhaps you'd like to support both given names (called Christian names, +irrespective of one's religion) and family names (called surnames), plus +nicknames and titles. If users of your Person class have been properly +accessing it through its documented interface, then you can easily change +the underlying implementation. If they haven't, then they lose and +it's their fault for breaking the contract and voiding their warranty. + +To do this, we'll make another class, this one called Fullname. What's +the Fullname class look like? To answer that question, you have to +first figure out how you want to use it. How about we use it this way: + + $him = Person->new(); + $him->fullname->title("St"); + $him->fullname->christian("Thomas"); + $him->fullname->surname("Aquinas"); + $him->fullname->nickname("Tommy"); + printf "His normal name is %s\n", $him->name; + printf "But his real name is %s\n", $him->fullname->as_string; + +Ok. To do this, we'll change Person::new() so that it supports +a full name field this way: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + $self->{FULLNAME} = Fullname->new(); + $self->{AGE} = undef; + $self->{PEERS} = []; + $self->{"_CENSUS"} = \$Census; + bless ($self, $class); + ++ ${ $self->{"_CENSUS"} }; + return $self; + } + + sub fullname { + my $self = shift; + return $self->{FULLNAME}; + } + +Then to support old code, define Person::name() this way: + + sub name { + my $self = shift; + return $self->{FULLNAME}->nickname(@_) + || $self->{FULLNAME}->christian(@_); + } + +Here's the Fullname class. We'll use the same technique +of using a hash reference to hold data fields, and methods +by the appropriate name to access them: + + package Fullname; + use strict; + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + TITLE => undef, + CHRISTIAN => undef, + SURNAME => undef, + NICK => undef, + }; + bless ($self, $class); + return $self; + } + + sub christian { + my $self = shift; + if (@_) { $self->{CHRISTIAN} = shift } + return $self->{CHRISTIAN}; + } + + sub surname { + my $self = shift; + if (@_) { $self->{SURNAME} = shift } + return $self->{SURNAME}; + } + + sub nickname { + my $self = shift; + if (@_) { $self->{NICK} = shift } + return $self->{NICK}; + } + + sub title { + my $self = shift; + if (@_) { $self->{TITLE} = shift } + return $self->{TITLE}; + } + + sub as_string { + my $self = shift; + my $name = join(" ", @$self{'CHRISTIAN', 'SURNAME'}); + if ($self->{TITLE}) { + $name = $self->{TITLE} . " " . $name; + } + return $name; + } + + 1; + +Finally, here's the test program: + + #!/usr/bin/perl -w + use strict; + use Person; + sub END { show_census() } + + sub show_census () { + printf "Current population: %d\n", Person->population; + } + + Person->debug(1); + + show_census(); + + my $him = Person->new(); + + $him->fullname->christian("Thomas"); + $him->fullname->surname("Aquinas"); + $him->fullname->nickname("Tommy"); + $him->fullname->title("St"); + $him->age(1); + + printf "%s is really %s.\n", $him->name, $him->fullname; + printf "%s's age: %d.\n", $him->name, $him->age; + $him->happy_birthday; + printf "%s's age: %d.\n", $him->name, $him->age; + + show_census(); + +=head1 Inheritance + +Object-oriented programming systems all support some notion of +inheritance. Inheritance means allowing one class to piggy-back on +top of another one so you don't have to write the same code again and +again. It's about software reuse, and therefore related to Laziness, +the principal virtue of a programmer. (The import/export mechanisms in +traditional modules are also a form of code reuse, but a simpler one than +the true inheritance that you find in object modules.) + +Sometimes the syntax of inheritance is built into the core of the +language, and sometimes it's not. Perl has no special syntax for +specifying the class (or classes) to inherit from. Instead, it's all +strictly in the semantics. Each package can have a variable called @ISA, +which governs (method) inheritance. If you try to call a method on an +object or class, and that method is not found in that object's package, +Perl then looks to @ISA for other packages to go looking through in +search of the missing method. + +Like the special per-package variables recognized by Exporter (such as +@EXPORT, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, and $VERSION), the @ISA +array I be a package-scoped global and not a file-scoped lexical +created via my(). Most classes have just one item in their @ISA array. +In this case, we have what's called "single inheritance", or SI for short. + +Consider this class: + + package Employee; + use Person; + @ISA = ("Person"); + 1; + +Not a lot to it, eh? All it's doing so far is loading in another +class and stating that this one will inherit methods from that +other class if need be. We have given it none of its own methods. +We rely upon an Employee to behave just like a Person. + +Setting up an empty class like this is called the "empty subclass test"; +that is, making a derived class that does nothing but inherit from a +base class. If the original base class has been designed properly, +then the new derived class can be used as a drop-in replacement for the +old one. This means you should be able to write a program like this: + + use Employee; + my $empl = Employee->new(); + $empl->name("Jason"); + $empl->age(23); + printf "%s is age %d.\n", $empl->name, $empl->age; + +By proper design, we mean always using the two-argument form of bless(), +avoiding direct access of global data, and not exporting anything. If you +look back at the Person::new() function we defined above, we were careful +to do that. There's a bit of package data used in the constructor, +but the reference to this is stored on the object itself and all other +methods access package data via that reference, so we should be ok. + +What do we mean by the Person::new() function -- isn't that actually +a method? Well, in principle, yes. A method is just a function that +expects as its first argument a class name (package) or object +(blessed reference). Person::new() is the function that both the +Cnew()> method and the Cnew()> method end +up calling. Understand that while a method call looks a lot like a +function call, they aren't really quite the same, and if you treat them +as the same, you'll very soon be left with nothing but broken programs. +First, the actual underlying calling conventions are different: method +calls get an extra argument. Second, function calls don't do inheritance, +but methods do. + + Method Call Resulting Function Call + ----------- ------------------------ + Person->new() Person::new("Person") + Employee->new() Person::new("Employee") + +So don't use function calls when you mean to call a method. + +If an employee is just a Person, that's not all too very interesting. +So let's add some other methods. We'll give our employee +data fields to access their salary, their employee ID, and their +start date. + +If you're getting a little tired of creating all these nearly identical +methods just to get at the object's data, do not despair. Later, +we'll describe several different convenience mechanisms for shortening +this up. Meanwhile, here's the straight-forward way: + + sub salary { + my $self = shift; + if (@_) { $self->{SALARY} = shift } + return $self->{SALARY}; + } + + sub id_number { + my $self = shift; + if (@_) { $self->{ID} = shift } + return $self->{ID}; + } + + sub start_date { + my $self = shift; + if (@_) { $self->{START_DATE} = shift } + return $self->{START_DATE}; + } + +=head2 Overridden Methods + +What happens when both a derived class and its base class have the same +method defined? Well, then you get the derived class's version of that +method. For example, let's say that we want the peers() method called on +an employee to act a bit differently. Instead of just returning the list +of peer names, let's return slightly different strings. So doing this: + + $empl->peers("Peter", "Paul", "Mary"); + printf "His peers are: %s\n", join(", ", $empl->peers); + +will produce: + + His peers are: PEON=PETER, PEON=PAUL, PEON=MARY + +To do this, merely add this definition into the Employee.pm file: + + sub peers { + my $self = shift; + if (@_) { @{ $self->{PEERS} } = @_ } + return map { "PEON=\U$_" } @{ $self->{PEERS} }; + } + +There, we've just demonstrated the high-falutin' concept known in certain +circles as I. We've taken on the form and behaviour of +an existing object, and then we've altered it to suit our own purposes. +This is a form of Laziness. (Getting polymorphed is also what happens +when the wizard decides you'd look better as a frog.) + +Every now and then you'll want to have a method call trigger both its +derived class (also known as "subclass") version as well as its base class +(also known as "superclass") version. In practice, constructors and +destructors are likely to want to do this, and it probably also makes +sense in the debug() method we showed previously. + +To do this, add this to Employee.pm: + + use Carp; + my $Debugging = 0; + + sub debug { + my $self = shift; + confess "usage: thing->debug(level)" unless @_ == 1; + my $level = shift; + if (ref($self)) { + $self->{"_DEBUG"} = $level; + } else { + $Debugging = $level; # whole class + } + Person::debug($self, $Debugging); # don't really do this + } + +As you see, we turn around and call the Person package's debug() function. +But this is far too fragile for good design. What if Person doesn't +have a debug() function, but is inheriting I debug() method +from elsewhere? It would have been slightly better to say + + Person->debug($Debugging); + +But even that's got too much hard-coded. It's somewhat better to say + + $self->Person::debug($Debugging); + +Which is a funny way to say to start looking for a debug() method up +in Person. This strategy is more often seen on overridden object methods +than on overridden class methods. + +There is still something a bit off here. We've hard-coded our +superclass's name. This in particular is bad if you change which classes +you inherit from, or add others. Fortunately, the pseudoclass SUPER +comes to the rescue here. + + $self->SUPER::debug($Debugging); + +This way it starts looking in my class's @ISA. This only makes sense +from I a method call, though. Don't try to access anything +in SUPER:: from anywhere else, because it doesn't exist outside +an overridden method call. + +Things are getting a bit complicated here. Have we done anything +we shouldn't? As before, one way to test whether we're designing +a decent class is via the empty subclass test. Since we already have +an Employee class that we're trying to check, we'd better get a new +empty subclass that can derive from Employee. Here's one: + + package Boss; + use Employee; # :-) + @ISA = qw(Employee); + +And here's the test program: + + #!/usr/bin/perl -w + use strict; + use Boss; + Boss->debug(1); + + my $boss = Boss->new(); + + $boss->fullname->title("Don"); + $boss->fullname->surname("Pichon Alvarez"); + $boss->fullname->christian("Federico Jesus"); + $boss->fullname->nickname("Fred"); + + $boss->age(47); + $boss->peers("Frank", "Felipe", "Faust"); + + printf "%s is age %d.\n", $boss->fullname, $boss->age; + printf "His peers are: %s\n", join(", ", $boss->peers); + +Running it, we see that we're still ok. If you'd like to dump out your +object in a nice format, somewhat like the way the 'x' command works in +the debugger, you could use the Data::Dumper module from CPAN this way: + + use Data::Dumper; + print "Here's the boss:\n"; + print Dumper($boss); + +Which shows us something like this: + + Here's the boss: + $VAR1 = bless( { + _CENSUS => \1, + FULLNAME => bless( { + TITLE => 'Don', + SURNAME => 'Pichon Alvarez', + NICK => 'Fred', + CHRISTIAN => 'Federico Jesus' + }, 'Fullname' ), + AGE => 47, + PEERS => [ + 'Frank', + 'Felipe', + 'Faust' + ] + }, 'Boss' ); + +Hm.... something's missing there. What about the salary, start date, +and ID fields? Well, we never set them to anything, even undef, so they +don't show up in the hash's keys. The Employee class has no new() method +of its own, and the new() method in Person doesn't know about Employees. +(Nor should it: proper OO design dictates that a subclass be allowed to +know about its immediate superclass, but never vice-versa.) So let's +fix up Employee::new() this way: + + sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(); + $self->{SALARY} = undef; + $self->{ID} = undef; + $self->{START_DATE} = undef; + bless ($self, $class); # reconsecrate + return $self; + } + +Now if you dump out an Employee or Boss object, you'll find +that new fields show up there now. + +=head2 Multiple Inheritance + +Ok, at the risk of confusing beginners and annoying OO gurus, it's +time to confess that Perl's object system includes that controversial +notion known as multiple inheritance, or MI for short. All this means +is that rather than having just one parent class who in turn might +itself have a parent class, etc., that you can directly inherit from +two or more parents. It's true that some uses of MI can get you into +trouble, although hopefully not quite so much trouble with Perl as with +dubiously-OO languages like C++. + +The way it works is actually pretty simple: just put more than one package +name in your @ISA array. When it comes time for Perl to go finding +methods for your object, it looks at each of these packages in order. +Well, kinda. It's actually a fully recursive, depth-first order. +Consider a bunch of @ISA arrays like this: + + @First::ISA = qw( Alpha ); + @Second::ISA = qw( Beta ); + @Third::ISA = qw( First Second ); + +If you have an object of class Third: + + my $ob = Third->new(); + $ob->spin(); + +How do we find a spin() method (or a new() method for that matter)? +Because the search is depth-first, classes will be looked up +in the following order: Third, First, Alpha, Second, and Beta. + +In practice, few class modules have been seen that actually +make use of MI. One nearly always chooses simple containership of +one class within another over MI. That's why our Person +object I a Fullname object. That doesn't mean +it I one. + +However, there is one particular area where MI in Perl is rampant: +borrowing another class's class methods. This is rather common, +especially with some bundled "objectless" classes, +like Exporter, DynaLoader, AutoLoader, and SelfLoader. These classes +do not provide constructors; they exist only so you may inherit their +class methods. (It's not entirely clear why inheritance was done +here rather than traditional module importation.) + +For example, here is the POSIX module's @ISA: + + package POSIX; + @ISA = qw(Exporter DynaLoader); + +The POSIX module isn't really an object module, but then, +neither are Exporter or DynaLoader. They're just lending their +classes' behaviours to POSIX. + +Why don't people use MI for object methods much? One reason is that +it can have complicated side-effects. For one thing, your inheritance +graph (no longer a tree) might converge back to the same base class. +Although Perl guards against recursive inheritance, merely having parents +who are related to each other via a common ancestor, incestuous though +it sounds, is not forbidden. What if in our Third class shown above we +wanted its new() method to also call both overridden constructors in its +two parent classes? The SUPER notation would only find the first one. +Also, what about if the Alpha and Beta classes both had a common ancestor, +like Nought? If you kept climbing up the inheritance tree calling +overridden methods, you'd end up calling Nought::new() twice, +which might well be a bad idea. + +=head2 UNIVERSAL: The Root of All Objects + +Wouldn't it be convenient if all objects were rooted at some ultimate +base class? That way you could give every object common methods without +having to go and add it to each and every @ISA. Well, it turns out that +you can. You don't see it, but Perl tacitly and irrevocably assumes +that there's an extra element at the end of @ISA: the class UNIVERSAL. +In version 5.003, there were no predefined methods there, but you could put +whatever you felt like into it. + +However, as of version 5.004 (or some subversive releases, like 5.003_08), +UNIVERSAL has some methods in it already. These are builtin to your Perl +binary, so they don't take any extra time to load. Predefined methods +include isa(), can(), and VERSION(). isa() tells you whether an object or +class "is" another one without having to traverse the hierarchy yourself: + + $has_io = $fd->isa("IO::Handle"); + $itza_handle = IO::Socket->isa("IO::Handle"); + +The can() method, called against that object or class, reports back +whether its string argument is a callable method name in that class. +In fact, it gives you back a function reference to that method: + + $his_print_method = $obj->can('as_string'); + +Finally, the VERSION method checks whether the class (or the object's +class) has a package global called $VERSION that's high enough, as in: + + Some_Module->VERSION(3.0); + $his_vers = $ob->VERSION(); + +However, we don't usually call VERSION ourselves. (Remember that an all +uppercase function name is a Perl convention that indicates that the +function will be automatically used by Perl in some way.) In this case, +it happens when you say + + use Some_Module 3.0; + +If you wanted to add version checking to your Person class explained +above, just add this to Person.pm: + + use vars qw($VERSION); + $VERSION = '1.1'; + +and then in Employee.pm could you can say + + use Employee 1.1; + +And it would make sure that you have at least that version number or +higher available. This is not the same as loading in that exact version +number. No mechanism currently exists for concurrent installation of +multiple versions of a module. Lamentably. + +=head1 Alternate Object Representations + +Nothing requires objects to be implemented as hash references. An object +can be any sort of reference so long as its referent has been suitably +blessed. That means scalar, array, and code references are also fair +game. + +A scalar would work if the object has only one datum to hold. An array +would work for most cases, but makes inheritance a bit dodgy because +you have to invent new indices for the derived classes. + +=head2 Arrays as Objects + +If the user of your class honors the contract and sticks to the advertised +interface, then you can change its underlying interface if you feel +like it. Here's another implementation that conforms to the same +interface specification. This time we'll use an array reference +instead of a hash reference to represent the object. + + package Person; + use strict; + + my($NAME, $AGE, $PEERS) = ( 0 .. 2 ); + + ############################################ + ## the object constructor (array version) ## + ############################################ + sub new { + my $self = []; + $self->[$NAME] = undef; # this is unnecessary + $self->[$AGE] = undef; # as is this + $self->[$PEERS] = []; # but this isn't, really + bless($self); + return $self; + } + + sub name { + my $self = shift; + if (@_) { $self->[$NAME] = shift } + return $self->[$NAME]; + } + + sub age { + my $self = shift; + if (@_) { $self->[$AGE] = shift } + return $self->[$AGE]; + } + + sub peers { + my $self = shift; + if (@_) { @{ $self->[$PEERS] } = @_ } + return @{ $self->[$PEERS] }; + } + + 1; # so the require or use succeeds + +You might guess that the array access would be a lot faster than the +hash access, but they're actually comparable. The array is a I +bit faster, but not more than ten or fifteen percent, even when you +replace the variables above like $AGE with literal numbers, like 1. +A bigger difference between the two approaches can be found in memory use. +A hash representation takes up more memory than an array representation +because you have to allocate memory for the keys as well as for the values. +However, it really isn't that bad, especially since as of version 5.004, +memory is only allocated once for a given hash key, no matter how many +hashes have that key. It's expected that sometime in the future, even +these differences will fade into obscurity as more efficient underlying +representations are devised. + +Still, the tiny edge in speed (and somewhat larger one in memory) +is enough to make some programmers choose an array representation +for simple classes. There's still a little problem with +scalability, though, because later in life when you feel +like creating subclasses, you'll find that hashes just work +out better. + +=head2 Closures as Objects + +Using a code reference to represent an object offers some fascinating +possibilities. We can create a new anonymous function (closure) who +alone in all the world can see the object's data. This is because we +put the data into an anonymous hash that's lexically visible only to +the closure we create, bless, and return as the object. This object's +methods turn around and call the closure as a regular subroutine call, +passing it the field we want to affect. (Yes, +the double-function call is slow, but if you wanted fast, you wouldn't +be using objects at all, eh? :-) + +Use would be similar to before: + + use Person; + $him = Person->new(); + $him->name("Jason"); + $him->age(23); + $him->peers( [ "Norbert", "Rhys", "Phineas" ] ); + printf "%s is %d years old.\n", $him->name, $him->age; + print "His peers are: ", join(", ", @{$him->peers}), "\n"; + +but the implementation would be radically, perhaps even sublimely +different: + + package Person; + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + NAME => undef, + AGE => undef, + PEERS => [], + }; + my $closure = sub { + my $field = shift; + if (@_) { $self->{$field} = shift } + return $self->{$field}; + }; + bless($closure, $class); + return $closure; + } + + sub name { &{ $_[0] }("NAME", @_[ 1 .. $#_ ] ) } + sub age { &{ $_[0] }("AGE", @_[ 1 .. $#_ ] ) } + sub peers { &{ $_[0] }("PEERS", @_[ 1 .. $#_ ] ) } + + 1; + +Because this object is hidden behind a code reference, it's probably a bit +mysterious to those whose background is more firmly rooted in standard +procedural or object-based programming languages than in functional +programming languages whence closures derive. The object +created and returned by the new() method is itself not a data reference +as we've seen before. It's an anonymous code reference that has within +it access to a specific version (lexical binding and instantiation) +of the object's data, which are stored in the private variable $self. +Although this is the same function each time, it contains a different +version of $self. + +When a method like C<$him-Ename("Jason")> is called, its implicit +zeroth argument is the invoking object--just as it is with all method +calls. But in this case, it's our code reference (something like a +function pointer in C++, but with deep binding of lexical variables). +There's not a lot to be done with a code reference beyond calling it, so +that's just what we do when we say C<&{$_[0]}>. This is just a regular +function call, not a method call. The initial argument is the string +"NAME", and any remaining arguments are whatever had been passed to the +method itself. + +Once we're executing inside the closure that had been created in new(), +the $self hash reference suddenly becomes visible. The closure grabs +its first argument ("NAME" in this case because that's what the name() +method passed it), and uses that string to subscript into the private +hash hidden in its unique version of $self. + +Nothing under the sun will allow anyone outside the executing method to +be able to get at this hidden data. Well, nearly nothing. You I +single step through the program using the debugger and find out the +pieces while you're in the method, but everyone else is out of luck. + +There, if that doesn't excite the Scheme folks, then I just don't know +what will. Translation of this technique into C++, Java, or any other +braindead-static language is left as a futile exercise for aficionados +of those camps. + +You could even add a bit of nosiness via the caller() function and +make the closure refuse to operate unless called via its own package. +This would no doubt satisfy certain fastidious concerns of programming +police and related puritans. + +If you were wondering when Hubris, the third principle virtue of a +programmer, would come into play, here you have it. (More seriously, +Hubris is just the pride in craftsmanship that comes from having written +a sound bit of well-designed code.) + +=head1 AUTOLOAD: Proxy Methods + +Autoloading is a way to intercept calls to undefined methods. An autoload +routine may choose to create a new function on the fly, either loaded +from disk or perhaps just eval()ed right there. This define-on-the-fly +strategy is why it's called autoloading. + +But that's only one possible approach. Another one is to just +have the autoloaded method itself directly provide the +requested service. When used in this way, you may think +of autoloaded methods as "proxy" methods. + +When Perl tries to call an undefined function in a particular package +and that function is not defined, it looks for a function in +that same package called AUTOLOAD. If one exists, it's called +with the same arguments as the original function would have had. +The fully-qualified name of the function is stored in that package's +global variable $AUTOLOAD. Once called, the function can do anything +it would like, including defining a new function by the right name, and +then doing a really fancy kind of C right to it, erasing itself +from the call stack. + +What does this have to do with objects? After all, we keep talking about +functions, not methods. Well, since a method is just a function with +an extra argument and some fancier semantics about where it's found, +we can use autoloading for methods, too. Perl doesn't start looking +for an AUTOLOAD method until it has exhausted the recursive hunt up +through @ISA, though. Some programmers have even been known to define +a UNIVERSAL::AUTOLOAD method to trap unresolved method calls to any +kind of object. + +=head2 Autoloaded Data Methods + +You probably began to get a little suspicious about the duplicated +code way back earlier when we first showed you the Person class, and +then later the Employee class. Each method used to access the +hash fields looked virtually identical. This should have tickled +that great programming virtue, Impatience, but for the time, +we let Laziness win out, and so did nothing. Proxy methods can cure +this. + +Instead of writing a new function every time we want a new data field, +we'll use the autoload mechanism to generate (actually, mimic) methods on +the fly. To verify that we're accessing a valid member, we will check +against an C<_permitted> (pronounced "under-permitted") field, which +is a reference to a file-scoped lexical (like a C file static) hash of permitted fields in this record +called %fields. Why the underscore? For the same reason as the _CENSUS +field we once used: as a marker that means "for internal use only". + +Here's what the module initialization code and class +constructor will look like when taking this approach: + + package Person; + use Carp; + use vars qw($AUTOLOAD); # it's a package global + + my %fields = ( + name => undef, + age => undef, + peers => undef, + ); + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + _permitted => \%fields, + %fields, + }; + bless $self, $class; + return $self; + } + +If we wanted our record to have default values, we could fill those in +where current we have C in the %fields hash. + +Notice how we saved a reference to our class data on the object itself? +Remember that it's important to access class data through the object +itself instead of having any method reference %fields directly, or else +you won't have a decent inheritance. + +The real magic, though, is going to reside in our proxy method, which +will handle all calls to undefined methods for objects of class Person +(or subclasses of Person). It has to be called AUTOLOAD. Again, it's +all caps because it's called for us implicitly by Perl itself, not by +a user directly. + + sub AUTOLOAD { + my $self = shift; + my $type = ref($self) + or croak "$self is not an object"; + + my $name = $AUTOLOAD; + $name =~ s/.*://; # strip fully-qualified portion + + unless (exists $self->{_permitted}->{$name} ) { + croak "Can't access `$name' field in class $type"; + } + + if (@_) { + return $self->{$name} = shift; + } else { + return $self->{$name}; + } + } + +Pretty nifty, eh? All we have to do to add new data fields +is modify %fields. No new functions need be written. + +I could have avoided the C<_permitted> field entirely, but I +wanted to demonstrate how to store a reference to class data on the +object so you wouldn't have to access that class data +directly from an object method. + +=head2 Inherited Autoloaded Data Methods + +But what about inheritance? Can we define our Employee +class similarly? Yes, so long as we're careful enough. + +Here's how to be careful: + + package Employee; + use Person; + use strict; + use vars qw(@ISA); + @ISA = qw(Person); + + my %fields = ( + id => undef, + salary => undef, + ); + + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = bless $that->SUPER::new(), $class; + my($element); + foreach $element (keys %fields) { + $self->{_permitted}->{$element} = $fields{$element}; + } + @{$self}{keys %fields} = values %fields; + return $self; + } + +Once we've done this, we don't even need to have an +AUTOLOAD function in the Employee package, because +we'll grab Person's version of that via inheritance, +and it will all work out just fine. + +=head1 Metaclassical Tools + +Even though proxy methods can provide a more convenient approach to making +more struct-like classes than tediously coding up data methods as +functions, it still leaves a bit to be desired. For one thing, it means +you have to handle bogus calls that you don't mean to trap via your proxy. +It also means you have to be quite careful when dealing with inheritance, +as detailed above. + +Perl programmers have responded to this by creating several different +class construction classes. These metaclasses are classes +that create other classes. A couple worth looking at are +Class::Struct and Alias. These and other related metaclasses can be +found in the modules directory on CPAN. + +=head2 Class::Struct + +One of the older ones is Class::Struct. In fact, its syntax and +interface were sketched out long before perl5 even solidified into a +real thing. What it does is provide you a way to "declare" a class +as having objects whose fields are of a specific type. The function +that does this is called, not surprisingly enough, struct(). Because +structures or records are not base types in Perl, each time you want to +create a class to provide a record-like data object, you yourself have +to define a new() method, plus separate data-access methods for each of +that record's fields. You'll quickly become bored with this process. +The Class::Struct::struct() function alleviates this tedium. + +Here's a simple example of using it: + + use Class::Struct qw(struct); + use Jobbie; # user-defined; see below + + struct 'Fred' => { + one => '$', + many => '@', + profession => Jobbie, # calls Jobbie->new() + }; + + $ob = Fred->new; + $ob->one("hmmmm"); + + $ob->many(0, "here"); + $ob->many(1, "you"); + $ob->many(2, "go"); + print "Just set: ", $ob->many(2), "\n"; + + $ob->profession->salary(10_000); + +You can declare types in the struct to be basic Perl types, or +user-defined types (classes). User types will be initialized by calling +that class's new() method. + +Here's a real-world example of using struct generation. Let's say you +wanted to override Perl's idea of gethostbyname() and gethostbyaddr() so +that they would return objects that acted like C structures. We don't +care about high-falutin' OO gunk. All we want is for these objects to +act like structs in the C sense. + + use Socket; + use Net::hostent; + $h = gethostbyname("perl.com"); # object return + printf "perl.com's real name is %s, address %s\n", + $h->name, inet_ntoa($h->addr); + +Here's how to do this using the Class::Struct module. +The crux is going to be this call: + + struct 'Net::hostent' => [ # note bracket + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + ]; + +Which creates object methods of those names and types. +It even creates a new() method for us. + +We could also have implemented our object this way: + + struct 'Net::hostent' => { # note brace + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + }; + +and then Class::Struct would have used an anonymous hash as the object +type, instead of an anonymous array. The array is faster and smaller, +but the hash works out better if you eventually want to do inheritance. +Since for this struct-like object we aren't planning on inheritance, +this time we'll opt for better speed and size over better flexibility. + +Here's the whole implementation: + + package Net::hostent; + use strict; + + BEGIN { + use Exporter (); + use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS); + @EXPORT = qw(gethostbyname gethostbyaddr gethost); + @EXPORT_OK = qw( + $h_name @h_aliases + $h_addrtype $h_length + @h_addr_list $h_addr + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); + } + use vars @EXPORT_OK; + + # Class::Struct forbids use of @ISA + sub import { goto &Exporter::import } + + use Class::Struct qw(struct); + struct 'Net::hostent' => [ + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', + ]; + + sub addr { shift->addr_list->[0] } + + sub populate (@) { + return unless @_; + my $hob = new(); # Class::Struct made this! + $h_name = $hob->[0] = $_[0]; + @h_aliases = @{ $hob->[1] } = split ' ', $_[1]; + $h_addrtype = $hob->[2] = $_[2]; + $h_length = $hob->[3] = $_[3]; + $h_addr = $_[4]; + @h_addr_list = @{ $hob->[4] } = @_[ (4 .. $#_) ]; + return $hob; + } + + sub gethostbyname ($) { populate(CORE::gethostbyname(shift)) } + + sub gethostbyaddr ($;$) { + my ($addr, $addrtype); + $addr = shift; + require Socket unless @_; + $addrtype = @_ ? shift : Socket::AF_INET(); + populate(CORE::gethostbyaddr($addr, $addrtype)) + } + + sub gethost($) { + if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { + require Socket; + &gethostbyaddr(Socket::inet_aton(shift)); + } else { + &gethostbyname; + } + } + + 1; + +We've snuck in quite a fair bit of other concepts besides just dynamic +class creation, like overriding core functions, import/export bits, +function prototyping, short-cut function call via C<&whatever>, and +function replacement with C. These all mostly make +sense from the perspective of a traditional module, but as you can see, +we can also use them in an object module. + +You can look at other object-based, struct-like overrides of core +functions in the 5.004 release of Perl in File::stat, Net::hostent, +Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, +User::grent, and User::pwent. These modules have a final component +that's all lowercase, by convention reserved for compiler pragmas, +because they affect the compilation and change a builtin function. +They also have the type names that a C programmer would most expect. + +=head2 Data Members as Variables + +If you're used to C++ objects, then you're accustomed to being able to +get at an object's data members as simple variables from within a method. +The Alias module provides for this, as well as a good bit more, such +as the possibility of private methods that the object can call but folks +outside the class cannot. + +Here's an example of creating a Person using the Alias module. +When you update these magical instance variables, you automatically +update value fields in the hash. Convenient, eh? + + package Person; + + # this is the same as before... + sub new { + my $that = shift; + my $class = ref($that) || $that; + my $self = { + NAME => undef, + AGE => undef, + PEERS => [], + }; + bless($self, $class); + return $self; + } + + use Alias qw(attr); + use vars qw($NAME $AGE $PEERS); + + sub name { + my $self = attr shift; + if (@_) { $NAME = shift; } + return $NAME; + } + + sub age { + my $self = attr shift; + if (@_) { $AGE = shift; } + return $AGE; + } + + sub peers { + my $self = attr shift; + if (@_) { @PEERS = @_; } + return @PEERS; + } + + sub exclaim { + my $self = attr shift; + return sprintf "Hi, I'm %s, age %d, working with %s", + $NAME, $AGE, join(", ", @PEERS); + } + + sub happy_birthday { + my $self = attr shift; + return ++$AGE; + } + +The need for the C declaration is because what Alias does +is play with package globals with the same name as the fields. To use +globals while C is in effect, you have to predeclare them. +These package variables are localized to the block enclosing the attr() +call just as if you'd used a local() on them. However, that means that +they're still considered global variables with temporary values, just +as with any other local(). + +It would be nice to combine Alias with +something like Class::Struct or Class::MethodMaker. + +=head2 NOTES + +=head2 Object Terminology + +In the various OO literature, it seems that a lot of different words +are used to describe only a few different concepts. If you're not +already an object programmer, then you don't need to worry about all +these fancy words. But if you are, then you might like to know how to +get at the same concepts in Perl. + +For example, it's common to call an object an I of a class +and to call those objects' methods I. Data fields +peculiar to each object are often called I or I, and data fields common to all members of that class are +I, I, or I. + +Also, I, I, and I all describe +the same notion, whereas I, I, and +I describe the other related one. + +C++ programmers have I and I, +but Perl only has I and I. +Actually, Perl only has methods. Whether a method gets used +as a class or object method is by usage only. You could accidentally +call a class method (one expecting a string argument) on an +object (one expecting a reference), or vice versa. + +Z<>From the C++ perspective, all methods in Perl are virtual. +This, by the way, is why they are never checked for function +prototypes in the argument list as regular builtin and user-defined +functions can be. + +Because a class is itself something of an object, Perl's classes can be +taken as describing both a "class as meta-object" (also called I) philosophy and the "class as type definition" (I +behaviour, not I mechanism) idea. C++ supports the latter +notion, but not the former. + +=head1 SEE ALSO + +The following manpages will doubtless provide more +background for this one: +L, +L, +L, +L, +L, +and +L. + +=head1 AUTHOR AND COPYRIGHT + +Copyright (c) 1997, 1998 Tom Christiansen +All rights reserved. + +When included as part of the Standard Version of Perl, or as part of +its complete documentation whether printed or otherwise, this work +may be distributed only under the terms of Perl's Artistic License. +Any distribution of this file or derivatives thereof I +of that package require that special arrangements be made with +copyright holder. + +Irrespective of its distribution, all code examples in this file +are hereby placed into the public domain. You are permitted and +encouraged to use this code in your own programs for fun +or for profit as you see fit. A simple comment in the code giving +credit would be courteous but is not required. + +=head1 COPYRIGHT + +=head2 Acknowledgments + +Thanks to +Larry Wall, +Roderick Schertler, +Gurusamy Sarathy, +Dean Roehrich, +Raphael Manfredi, +Brent Halsey, +Greg Bacon, +Brad Appleton, +and many others for their helpful comments. diff --git a/contrib/perl5/pod/perltrap.pod b/contrib/perl5/pod/perltrap.pod new file mode 100644 index 00000000000..852d8e98263 --- /dev/null +++ b/contrib/perl5/pod/perltrap.pod @@ -0,0 +1,1505 @@ +=head1 NAME + +perltrap - Perl traps for the unwary + +=head1 DESCRIPTION + +The biggest trap of all is forgetting to use the B<-w> switch; see +L. The second biggest trap is not making your entire program +runnable under C. The third biggest trap is not reading +the list of changes in this version of Perl; see L. + +=head2 Awk Traps + +Accustomed B users should take special note of the following: + +=over 4 + +=item * + +The English module, loaded via + + use English; + +allows you to refer to special variables (like C<$/>) with names (like +C<$RS>), as though they were in B; see L for details. + +=item * + +Semicolons are required after all simple statements in Perl (except +at the end of a block). Newline is not a statement delimiter. + +=item * + +Curly brackets are required on Cs and Cs. + +=item * + +Variables begin with "$", "@" or "%" in Perl. + +=item * + +Arrays index from 0. Likewise string positions in substr() and +index(). + +=item * + +You have to decide whether your array has numeric or string indices. + +=item * + +Hash values do not spring into existence upon mere reference. + +=item * + +You have to decide whether you want to use string or numeric +comparisons. + +=item * + +Reading an input line does not split it for you. You get to split it +to an array yourself. And the split() operator has different +arguments than B's. + +=item * + +The current input line is normally in $_, not $0. It generally does +not have the newline stripped. ($0 is the name of the program +executed.) See L. + +=item * + +$EIE does not refer to fields--it refers to substrings matched +by the last match pattern. + +=item * + +The print() statement does not add field and record separators unless +you set C<$,> and C<$\>. You can set $OFS and $ORS if you're using +the English module. + +=item * + +You must open your files before you print to them. + +=item * + +The range operator is "..", not comma. The comma operator works as in +C. + +=item * + +The match operator is "=~", not "~". ("~" is the one's complement +operator, as in C.) + +=item * + +The exponentiation operator is "**", not "^". "^" is the XOR +operator, as in C. (You know, one could get the feeling that B is +basically incompatible with C.) + +=item * + +The concatenation operator is ".", not the null string. (Using the +null string would render C unparsable, because the third slash +would be interpreted as a division operator--the tokenizer is in fact +slightly context sensitive for operators like "/", "?", and "E". +And in fact, "." itself can be the beginning of a number.) + +=item * + +The C, C, and C keywords work differently. + +=item * + + +The following variables work differently: + + Awk Perl + ARGC $#ARGV or scalar @ARGV + ARGV[0] $0 + FILENAME $ARGV + FNR $. - something + FS (whatever you like) + NF $#Fld, or some such + NR $. + OFMT $# + OFS $, + ORS $\ + RLENGTH length($&) + RS $/ + RSTART length($`) + SUBSEP $; + +=item * + +You cannot set $RS to a pattern, only a string. + +=item * + +When in doubt, run the B construct through B and see what it +gives you. + +=back + +=head2 C Traps + +Cerebral C programmers should take note of the following: + +=over 4 + +=item * + +Curly brackets are required on C's and C's. + +=item * + +You must use C rather than C. + +=item * + +The C and C keywords from C become in +Perl C and C, respectively. +Unlike in C, these do I work within a C construct. + +=item * + +There's no switch statement. (But it's easy to build one on the fly.) + +=item * + +Variables begin with "$", "@" or "%" in Perl. + +=item * + +C does not implement the "*" format for interpolating +field widths, but it's trivial to use interpolation of double-quoted +strings to achieve the same effect. + +=item * + +Comments begin with "#", not "/*". + +=item * + +You can't take the address of anything, although a similar operator +in Perl is the backslash, which creates a reference. + +=item * + +C must be capitalized. C<$ARGV[0]> is C's C, and C +ends up in C<$0>. + +=item * + +System calls such as link(), unlink(), rename(), etc. return nonzero for +success, not 0. + +=item * + +Signal handlers deal with signal names, not numbers. Use C +to find their names on your system. + +=back + +=head2 Sed Traps + +Seasoned B programmers should take note of the following: + +=over 4 + +=item * + +Backreferences in substitutions use "$" rather than "\". + +=item * + +The pattern matching metacharacters "(", ")", and "|" do not have backslashes +in front. + +=item * + +The range operator is C<...>, rather than comma. + +=back + +=head2 Shell Traps + +Sharp shell programmers should take note of the following: + +=over 4 + +=item * + +The backtick operator does variable interpolation without regard to +the presence of single quotes in the command. + +=item * + +The backtick operator does no translation of the return value, unlike B. + +=item * + +Shells (especially B) do several levels of substitution on each +command line. Perl does substitution in only certain constructs +such as double quotes, backticks, angle brackets, and search patterns. + +=item * + +Shells interpret scripts a little bit at a time. Perl compiles the +entire program before executing it (except for C blocks, which +execute at compile time). + +=item * + +The arguments are available via @ARGV, not $1, $2, etc. + +=item * + +The environment is not automatically made available as separate scalar +variables. + +=back + +=head2 Perl Traps + +Practicing Perl Programmers should take note of the following: + +=over 4 + +=item * + +Remember that many operations behave differently in a list +context than they do in a scalar one. See L for details. + +=item * + +Avoid barewords if you can, especially all lowercase ones. +You can't tell by just looking at it whether a bareword is +a function or a string. By using quotes on strings and +parentheses on function calls, you won't ever get them confused. + +=item * + +You cannot discern from mere inspection which builtins +are unary operators (like chop() and chdir()) +and which are list operators (like print() and unlink()). +(User-defined subroutines can be B list operators, never +unary ones.) See L. + +=item * + +People have a hard time remembering that some functions +default to $_, or @ARGV, or whatever, but that others which +you might expect to do not. + +=item * + +The EFHE construct is not the name of the filehandle, it is a readline +operation on that handle. The data read is assigned to $_ only if the +file read is the sole condition in a while loop: + + while () { } + while (defined($_ = )) { }.. + ; # data discarded! + +=item * + +Remember not to use "C<=>" when you need "C<=~>"; +these two constructs are quite different: + + $x = /foo/; + $x =~ /foo/; + +=item * + +The C construct isn't a real loop that you can use +loop control on. + +=item * + +Use C for local variables whenever you can get away with +it (but see L for where you can't). +Using C actually gives a local value to a global +variable, which leaves you open to unforeseen side-effects +of dynamic scoping. + +=item * + +If you localize an exported variable in a module, its exported value will +not change. The local name becomes an alias to a new value but the +external name is still an alias for the original. + +=back + +=head2 Perl4 to Perl5 Traps + +Practicing Perl4 Programmers should take note of the following +Perl4-to-Perl5 specific traps. + +They're crudely ordered according to the following list: + +=over 4 + +=item Discontinuance, Deprecation, and BugFix traps + +Anything that's been fixed as a perl4 bug, removed as a perl4 feature +or deprecated as a perl4 feature with the intent to encourage usage of +some other perl5 feature. + +=item Parsing Traps + +Traps that appear to stem from the new parser. + +=item Numerical Traps + +Traps having to do with numerical or mathematical operators. + +=item General data type traps + +Traps involving perl standard data types. + +=item Context Traps - scalar, list contexts + +Traps related to context within lists, scalar statements/declarations. + +=item Precedence Traps + +Traps related to the precedence of parsing, evaluation, and execution of +code. + +=item General Regular Expression Traps using s///, etc. + +Traps related to the use of pattern matching. + +=item Subroutine, Signal, Sorting Traps + +Traps related to the use of signals and signal handlers, general subroutines, +and sorting, along with sorting subroutines. + +=item OS Traps + +OS-specific traps. + +=item DBM Traps + +Traps specific to the use of C, and specific dbm implementations. + +=item Unclassified Traps + +Everything else. + +=back + +If you find an example of a conversion trap that is not listed here, +please submit it to Bill Middleton > for inclusion. +Also note that at least some of these can be caught with B<-w>. + +=head2 Discontinuance, Deprecation, and BugFix traps + +Anything that has been discontinued, deprecated, or fixed as +a bug from perl4. + +=over 4 + +=item * Discontinuance + +Symbols starting with "_" are no longer forced into package main, except +for C<$_> itself (and C<@_>, etc.). + + package test; + $_legacy = 1; + + package main; + print "\$_legacy is ",$_legacy,"\n"; + + # perl4 prints: $_legacy is 1 + # perl5 prints: $_legacy is + +=item * Deprecation + +Double-colon is now a valid package separator in a variable name. Thus these +behave differently in perl4 vs. perl5, because the packages don't exist. + + $a=1;$b=2;$c=3;$var=4; + print "$a::$b::$c "; + print "$var::abc::xyz\n"; + + # perl4 prints: 1::2::3 4::abc::xyz + # perl5 prints: 3 + +Given that C<::> is now the preferred package delimiter, it is debatable +whether this should be classed as a bug or not. +(The older package delimiter, ' ,is used here) + + $x = 10 ; + print "x=${'x}\n" ; + + # perl4 prints: x=10 + # perl5 prints: Can't find string terminator "'" anywhere before EOF + +You can avoid this problem, and remain compatible with perl4, if you +always explicitly include the package name: + + $x = 10 ; + print "x=${main'x}\n" ; + +Also see precedence traps, for parsing C<$:>. + +=item * BugFix + +The second and third arguments of C are now evaluated in scalar +context (as the Camel says) rather than list context. + + sub sub1{return(0,2) } # return a 2-element list + sub sub2{ return(1,2,3)} # return a 3-element list + @a1 = ("a","b","c","d","e"); + @a2 = splice(@a1,&sub1,&sub2); + print join(' ',@a2),"\n"; + + # perl4 prints: a b + # perl5 prints: c d e + +=item * Discontinuance + +You can't do a C into a block that is optimized away. Darn. + + goto marker1; + + for(1){ + marker1: + print "Here I is!\n"; + } + + # perl4 prints: Here I is! + # perl5 dumps core (SEGV) + +=item * Discontinuance + +It is no longer syntactically legal to use whitespace as the name +of a variable, or as a delimiter for any kind of quote construct. +Double darn. + + $a = ("foo bar"); + $b = q baz ; + print "a is $a, b is $b\n"; + + # perl4 prints: a is foo bar, b is baz + # perl5 errors: Bareword found where operator expected + +=item * Discontinuance + +The archaic while/if BLOCK BLOCK syntax is no longer supported. + + if { 1 } { + print "True!"; + } + else { + print "False!"; + } + + # perl4 prints: True! + # perl5 errors: syntax error at test.pl line 1, near "if {" + +=item * BugFix + +The C<**> operator now binds more tightly than unary minus. +It was documented to work this way before, but didn't. + + print -4**2,"\n"; + + # perl4 prints: 16 + # perl5 prints: -16 + +=item * Discontinuance + +The meaning of C has changed slightly when it is iterating over a +list which is not an array. This used to assign the list to a +temporary array, but no longer does so (for efficiency). This means +that you'll now be iterating over the actual values, not over copies of +the values. Modifications to the loop variable can change the original +values. + + @list = ('ab','abc','bcd','def'); + foreach $var (grep(/ab/,@list)){ + $var = 1; + } + print (join(':',@list)); + + # perl4 prints: ab:abc:bcd:def + # perl5 prints: 1:1:bcd:def + +To retain Perl4 semantics you need to assign your list +explicitly to a temporary array and then iterate over that. For +example, you might need to change + + foreach $var (grep(/ab/,@list)){ + +to + + foreach $var (@tmp = grep(/ab/,@list)){ + +Otherwise changing $var will clobber the values of @list. (This most often +happens when you use C<$_> for the loop variable, and call subroutines in +the loop that don't properly localize C<$_>.) + +=item * Discontinuance + +C with no arguments now behaves like C (which doesn't +return an initial null field if $_ starts with whitespace), it used to +behave like C (which does). + + $_ = ' hi mom'; + print join(':', split); + + # perl4 prints: :hi:mom + # perl5 prints: hi:mom + +=item * BugFix + +Perl 4 would ignore any text which was attached to an B<-e> switch, +always taking the code snippet from the following arg. Additionally, it +would silently accept an B<-e> switch without a following arg. Both of +these behaviors have been fixed. + + perl -e'print "attached to -e"' 'print "separate arg"' + + # perl4 prints: separate arg + # perl5 prints: attached to -e + + perl -e + + # perl4 prints: + # perl5 dies: No code specified for -e. + +=item * Discontinuance + +In Perl 4 the return value of C was undocumented, but it was +actually the last value being pushed onto the target list. In Perl 5 +the return value of C is documented, but has changed, it is the +number of elements in the resulting list. + + @x = ('existing'); + print push(@x, 'first new', 'second new'); + + # perl4 prints: second new + # perl5 prints: 3 + +=item * Discontinuance + +In Perl 4 (and versions of Perl 5 before 5.004), C<'\r'> characters in +Perl code were silently allowed, although they could cause (mysterious!) +failures in certain constructs, particularly here documents. Now, +C<'\r'> characters cause an immediate fatal error. (Note: In this +example, the notation B<\015> represents the incorrect line +ending. Depending upon your text viewer, it will look different.) + + print "foo";\015 + print "bar"; + + # perl4 prints: foobar + # perl5.003 prints: foobar + # perl5.004 dies: Illegal character \015 (carriage return) + +See L for full details. + +=item * Deprecation + +Some error messages will be different. + +=item * Discontinuance + +Some bugs may have been inadvertently removed. :-) + +=back + +=head2 Parsing Traps + +Perl4-to-Perl5 traps from having to do with parsing. + +=over 4 + +=item * Parsing + +Note the space between . and = + + $string . = "more string"; + print $string; + + # perl4 prints: more string + # perl5 prints: syntax error at - line 1, near ". =" + +=item * Parsing + +Better parsing in perl 5 + + sub foo {} + &foo + print("hello, world\n"); + + # perl4 prints: hello, world + # perl5 prints: syntax error + +=item * Parsing + +"if it looks like a function, it is a function" rule. + + print + ($foo == 1) ? "is one\n" : "is zero\n"; + + # perl4 prints: is zero + # perl5 warns: "Useless use of a constant in void context" if using -w + +=item * Parsing + +String interpolation of the C<$#array> construct differs when braces +are to used around the name. + + @ = (1..3); + print "${#a}"; + + # perl4 prints: 2 + # perl5 fails with syntax error + + @ = (1..3); + print "$#{a}"; + + # perl4 prints: {a} + # perl5 prints: 2 + +=back + +=head2 Numerical Traps + +Perl4-to-Perl5 traps having to do with numerical operators, +operands, or output from same. + +=over 5 + +=item * Numerical + +Formatted output and significant digits + + print 7.373504 - 0, "\n"; + printf "%20.18f\n", 7.373504 - 0; + + # Perl4 prints: + 7.375039999999996141 + 7.37503999999999614 + + # Perl5 prints: + 7.373504 + 7.37503999999999614 + +=item * Numerical + +This specific item has been deleted. It demonstrated how the auto-increment +operator would not catch when a number went over the signed int limit. Fixed +in version 5.003_04. But always be wary when using large integers. +If in doubt: + + use Math::BigInt; + +=item * Numerical + +Assignment of return values from numeric equality tests +does not work in perl5 when the test evaluates to false (0). +Logical tests now return an null, instead of 0 + + $p = ($test == 1); + print $p,"\n"; + + # perl4 prints: 0 + # perl5 prints: + +Also see L<"General Regular Expression Traps using s///, etc."> +for another example of this new feature... + +=back + +=head2 General data type traps + +Perl4-to-Perl5 traps involving most data-types, and their usage +within certain expressions and/or context. + +=over 5 + +=item * (Arrays) + +Negative array subscripts now count from the end of the array. + + @a = (1, 2, 3, 4, 5); + print "The third element of the array is $a[3] also expressed as $a[-2] \n"; + + # perl4 prints: The third element of the array is 4 also expressed as + # perl5 prints: The third element of the array is 4 also expressed as 4 + +=item * (Arrays) + +Setting C<$#array> lower now discards array elements, and makes them +impossible to recover. + + @a = (a,b,c,d,e); + print "Before: ",join('',@a); + $#a =1; + print ", After: ",join('',@a); + $#a =3; + print ", Recovered: ",join('',@a),"\n"; + + # perl4 prints: Before: abcde, After: ab, Recovered: abcd + # perl5 prints: Before: abcde, After: ab, Recovered: ab + +=item * (Hashes) + +Hashes get defined before use + + local($s,@a,%h); + die "scalar \$s defined" if defined($s); + die "array \@a defined" if defined(@a); + die "hash \%h defined" if defined(%h); + + # perl4 prints: + # perl5 dies: hash %h defined + +=item * (Globs) + +glob assignment from variable to variable will fail if the assigned +variable is localized subsequent to the assignment + + @a = ("This is Perl 4"); + *b = *a; + local(@a); + print @b,"\n"; + + # perl4 prints: This is Perl 4 + # perl5 prints: + +=item * (Globs) + +Assigning C to a glob has no effect in Perl 5. In Perl 4 +it undefines the associated scalar (but may have other side effects +including SEGVs). + +=item * (Scalar String) + +Changes in unary negation (of strings) +This change effects both the return value and what it +does to auto(magic)increment. + + $x = "aaa"; + print ++$x," : "; + print -$x," : "; + print ++$x,"\n"; + + # perl4 prints: aab : -0 : 1 + # perl5 prints: aab : -aab : aac + +=item * (Constants) + +perl 4 lets you modify constants: + + $foo = "x"; + &mod($foo); + for ($x = 0; $x < 3; $x++) { + &mod("a"); + } + sub mod { + print "before: $_[0]"; + $_[0] = "m"; + print " after: $_[0]\n"; + } + + # perl4: + # before: x after: m + # before: a after: m + # before: m after: m + # before: m after: m + + # Perl5: + # before: x after: m + # Modification of a read-only value attempted at foo.pl line 12. + # before: a + +=item * (Scalars) + +The behavior is slightly different for: + + print "$x", defined $x + + # perl 4: 1 + # perl 5: + +=item * (Variable Suicide) + +Variable suicide behavior is more consistent under Perl 5. +Perl5 exhibits the same behavior for hashes and scalars, +that perl4 exhibits for only scalars. + + $aGlobal{ "aKey" } = "global value"; + print "MAIN:", $aGlobal{"aKey"}, "\n"; + $GlobalLevel = 0; + &test( *aGlobal ); + + sub test { + local( *theArgument ) = @_; + local( %aNewLocal ); # perl 4 != 5.001l,m + $aNewLocal{"aKey"} = "this should never appear"; + print "SUB: ", $theArgument{"aKey"}, "\n"; + $aNewLocal{"aKey"} = "level $GlobalLevel"; # what should print + $GlobalLevel++; + if( $GlobalLevel<4 ) { + &test( *aNewLocal ); + } + } + + # Perl4: + # MAIN:global value + # SUB: global value + # SUB: level 0 + # SUB: level 1 + # SUB: level 2 + + # Perl5: + # MAIN:global value + # SUB: global value + # SUB: this should never appear + # SUB: this should never appear + # SUB: this should never appear + +=back + +=head2 Context Traps - scalar, list contexts + +=over 5 + +=item * (list context) + +The elements of argument lists for formats are now evaluated in list +context. This means you can interpolate list values now. + + @fmt = ("foo","bar","baz"); + format STDOUT= + @<<<<< @||||| @>>>>> + @fmt; + . + write; + + # perl4 errors: Please use commas to separate fields in file + # perl5 prints: foo bar baz + +=item * (scalar context) + +The C function now returns a false value in a scalar context +if there is no caller. This lets library files determine if they're +being required. + + caller() ? (print "You rang?\n") : (print "Got a 0\n"); + + # perl4 errors: There is no caller + # perl5 prints: Got a 0 + +=item * (scalar context) + +The comma operator in a scalar context is now guaranteed to give a +scalar context to its arguments. + + @y= ('a','b','c'); + $x = (1, 2, @y); + print "x = $x\n"; + + # Perl4 prints: x = c # Thinks list context interpolates list + # Perl5 prints: x = 3 # Knows scalar uses length of list + +=item * (list, builtin) + +C funkiness (array argument converted to scalar array count) +This test could be added to t/op/sprintf.t + + @z = ('%s%s', 'foo', 'bar'); + $x = sprintf(@z); + if ($x eq 'foobar') {print "ok 2\n";} else {print "not ok 2 '$x'\n";} + + # perl4 prints: ok 2 + # perl5 prints: not ok 2 + +C works fine, though: + + printf STDOUT (@z); + print "\n"; + + # perl4 prints: foobar + # perl5 prints: foobar + +Probably a bug. + +=back + +=head2 Precedence Traps + +Perl4-to-Perl5 traps involving precedence order. + +Perl 4 has almost the same precedence rules as Perl 5 for the operators +that they both have. Perl 4 however, seems to have had some +inconsistencies that made the behavior differ from what was documented. + +=over 5 + +=item * Precedence + +LHS vs. RHS of any assignment operator. LHS is evaluated first +in perl4, second in perl5; this can affect the relationship +between side-effects in sub-expressions. + + @arr = ( 'left', 'right' ); + $a{shift @arr} = shift @arr; + print join( ' ', keys %a ); + + # perl4 prints: left + # perl5 prints: right + +=item * Precedence + +These are now semantic errors because of precedence: + + @list = (1,2,3,4,5); + %map = ("a",1,"b",2,"c",3,"d",4); + $n = shift @list + 2; # first item in list plus 2 + print "n is $n, "; + $m = keys %map + 2; # number of items in hash plus 2 + print "m is $m\n"; + + # perl4 prints: n is 3, m is 6 + # perl5 errors and fails to compile + +=item * Precedence + +The precedence of assignment operators is now the same as the precedence +of assignment. Perl 4 mistakenly gave them the precedence of the associated +operator. So you now must parenthesize them in expressions like + + /foo/ ? ($a += 2) : ($a -= 2); + +Otherwise + + /foo/ ? $a += 2 : $a -= 2 + +would be erroneously parsed as + + (/foo/ ? $a += 2 : $a) -= 2; + +On the other hand, + + $a += /foo/ ? 1 : 2; + +now works as a C programmer would expect. + +=item * Precedence + + open FOO || die; + +is now incorrect. You need parentheses around the filehandle. +Otherwise, perl5 leaves the statement as its default precedence: + + open(FOO || die); + + # perl4 opens or dies + # perl5 errors: Precedence problem: open FOO should be open(FOO) + +=item * Precedence + +perl4 gives the special variable, C<$:> precedence, where perl5 +treats C<$::> as main C + + $a = "x"; print "$::a"; + + # perl 4 prints: -:a + # perl 5 prints: x + +=item * Precedence + +perl4 had buggy precedence for the file test operators vis-a-vis +the assignment operators. Thus, although the precedence table +for perl4 leads one to believe C<-e $foo .= "q"> should parse as +C<((-e $foo) .= "q")>, it actually parses as C<(-e ($foo .= "q"))>. +In perl5, the precedence is as documented. + + -e $foo .= "q" + + # perl4 prints: no output + # perl5 prints: Can't modify -e in concatenation + +=item * Precedence + +In perl4, keys(), each() and values() were special high-precedence operators +that operated on a single hash, but in perl5, they are regular named unary +operators. As documented, named unary operators have lower precedence +than the arithmetic and concatenation operators C<+ - .>, but the perl4 +variants of these operators actually bind tighter than C<+ - .>. +Thus, for: + + %foo = 1..10; + print keys %foo - 1 + + # perl4 prints: 4 + # perl5 prints: Type of arg 1 to keys must be hash (not subtraction) + +The perl4 behavior was probably more useful, if less consistent. + +=back + +=head2 General Regular Expression Traps using s///, etc. + +All types of RE traps. + +=over 5 + +=item * Regular Expression + +C now does no interpolation on either side. It used to +interpolate C<$lhs> but not C<$rhs>. (And still does not match a literal +'$' in string) + + $a=1;$b=2; + $string = '1 2 $a $b'; + $string =~ s'$a'$b'; + print $string,"\n"; + + # perl4 prints: $b 2 $a $b + # perl5 prints: 1 2 $a $b + +=item * Regular Expression + +C now attaches its state to the searched string rather than the +regular expression. (Once the scope of a block is left for the sub, the +state of the searched string is lost) + + $_ = "ababab"; + while(m/ab/g){ + &doit("blah"); + } + sub doit{local($_) = shift; print "Got $_ "} + + # perl4 prints: blah blah blah + # perl5 prints: infinite loop blah... + +=item * Regular Expression + +Currently, if you use the C qualifier on a regular expression +within an anonymous sub, I closures generated from that anonymous +sub will use the regular expression as it was compiled when it was used +the very first time in any such closure. For instance, if you say + + sub build_match { + my($left,$right) = @_; + return sub { $_[0] =~ /$left stuff $right/o; }; + } + +build_match() will always return a sub which matches the contents of +C<$left> and C<$right> as they were the I time that build_match() +was called, not as they are in the current call. + +This is probably a bug, and may change in future versions of Perl. + +=item * Regular Expression + +If no parentheses are used in a match, Perl4 sets C<$+> to +the whole match, just like C<$&>. Perl5 does not. + + "abcdef" =~ /b.*e/; + print "\$+ = $+\n"; + + # perl4 prints: bcde + # perl5 prints: + +=item * Regular Expression + +substitution now returns the null string if it fails + + $string = "test"; + $value = ($string =~ s/foo//); + print $value, "\n"; + + # perl4 prints: 0 + # perl5 prints: + +Also see L for another example of this new feature. + +=item * Regular Expression + +C (using backticks) is now a normal substitution, with no +backtick expansion + + $string = ""; + $string =~ s`^`hostname`; + print $string, "\n"; + + # perl4 prints: + # perl5 prints: hostname + +=item * Regular Expression + +Stricter parsing of variables used in regular expressions + + s/^([^$grpc]*$grpc[$opt$plus$rep]?)//o; + + # perl4: compiles w/o error + # perl5: with Scalar found where operator expected ..., near "$opt$plus" + +an added component of this example, apparently from the same script, is +the actual value of the s'd string after the substitution. +C<[$opt]> is a character class in perl4 and an array subscript in perl5 + + $grpc = 'a'; + $opt = 'r'; + $_ = 'bar'; + s/^([^$grpc]*$grpc[$opt]?)/foo/; + print ; + + # perl4 prints: foo + # perl5 prints: foobar + +=item * Regular Expression + +Under perl5, C matches only once, like C. Under perl4, it matched +repeatedly, like C or C. + + $test = "once"; + sub match { $test =~ m?once?; } + &match(); + if( &match() ) { + # m?x? matches more then once + print "perl4\n"; + } else { + # m?x? matches only once + print "perl5\n"; + } + + # perl4 prints: perl4 + # perl5 prints: perl5 + + +=back + +=head2 Subroutine, Signal, Sorting Traps + +The general group of Perl4-to-Perl5 traps having to do with +Signals, Sorting, and their related subroutines, as well as +general subroutine traps. Includes some OS-Specific traps. + +=over 5 + +=item * (Signals) + +Barewords that used to look like strings to Perl will now look like subroutine +calls if a subroutine by that name is defined before the compiler sees them. + + sub SeeYa { warn"Hasta la vista, baby!" } + $SIG{'TERM'} = SeeYa; + print "SIGTERM is now $SIG{'TERM'}\n"; + + # perl4 prints: SIGTERM is main'SeeYa + # perl5 prints: SIGTERM is now main::1 + +Use B<-w> to catch this one + +=item * (Sort Subroutine) + +reverse is no longer allowed as the name of a sort subroutine. + + sub reverse{ print "yup "; $a <=> $b } + print sort reverse a,b,c; + + # perl4 prints: yup yup yup yup abc + # perl5 prints: abc + +=item * warn() won't let you specify a filehandle. + +Although it _always_ printed to STDERR, warn() would let you specify a +filehandle in perl4. With perl5 it does not. + + warn STDERR "Foo!"; + + # perl4 prints: Foo! + # perl5 prints: String found where operator expected + +=back + +=head2 OS Traps + +=over 5 + +=item * (SysV) + +Under HPUX, and some other SysV OSes, one had to reset any signal handler, +within the signal handler function, each time a signal was handled with +perl4. With perl5, the reset is now done correctly. Any code relying +on the handler _not_ being reset will have to be reworked. + +Since version 5.002, Perl uses sigaction() under SysV. + + sub gotit { + print "Got @_... "; + } + $SIG{'INT'} = 'gotit'; + + $| = 1; + $pid = fork; + if ($pid) { + kill('INT', $pid); + sleep(1); + kill('INT', $pid); + } else { + while (1) {sleep(10);} + } + + # perl4 (HPUX) prints: Got INT... + # perl5 (HPUX) prints: Got INT... Got INT... + +=item * (SysV) + +Under SysV OSes, C on a file opened to append CE> now does +the right thing w.r.t. the fopen() manpage. e.g., - When a file is opened +for append, it is impossible to overwrite information already in +the file. + + open(TEST,">>seek.test"); + $start = tell TEST ; + foreach(1 .. 9){ + print TEST "$_ "; + } + $end = tell TEST ; + seek(TEST,$start,0); + print TEST "18 characters here"; + + # perl4 (solaris) seek.test has: 18 characters here + # perl5 (solaris) seek.test has: 1 2 3 4 5 6 7 8 9 18 characters here + + + +=back + +=head2 Interpolation Traps + +Perl4-to-Perl5 traps having to do with how things get interpolated +within certain expressions, statements, contexts, or whatever. + +=over 5 + +=item * Interpolation + +@ now always interpolates an array in double-quotish strings. + + print "To: someone@somewhere.com\n"; + + # perl4 prints: To:someone@somewhere.com + # perl5 errors : In string, @somewhere now must be written as \@somewhere + +=item * Interpolation + +Double-quoted strings may no longer end with an unescaped $ or @. + + $foo = "foo$"; + $bar = "bar@"; + print "foo is $foo, bar is $bar\n"; + + # perl4 prints: foo is foo$, bar is bar@ + # perl5 errors: Final $ should be \$ or $name + +Note: perl5 DOES NOT error on the terminating @ in $bar + +=item * Interpolation + +Perl now sometimes evaluates arbitrary expressions inside braces that occur +within double quotes (usually when the opening brace is preceded by C<$> +or C<@>). + + @www = "buz"; + $foo = "foo"; + $bar = "bar"; + sub foo { return "bar" }; + print "|@{w.w.w}|${main'foo}|"; + + # perl4 prints: |@{w.w.w}|foo| + # perl5 prints: |buz|bar| + +Note that you can C to ward off such trappiness under perl5. + +=item * Interpolation + +The construct "this is $$x" used to interpolate the pid at that +point, but now apparently tries to dereference C<$x>. C<$$> by itself still +works fine, however. + + print "this is $$x\n"; + + # perl4 prints: this is XXXx (XXX is the current pid) + # perl5 prints: this is + +=item * Interpolation + +Creation of hashes on the fly with C now requires either both +C<$>'s to be protected in the specification of the hash name, or both curlies +to be protected. If both curlies are protected, the result will be compatible +with perl4 and perl5. This is a very common practice, and should be changed +to use the block form of C if possible. + + $hashname = "foobar"; + $key = "baz"; + $value = 1234; + eval "\$$hashname{'$key'} = q|$value|"; + (defined($foobar{'baz'})) ? (print "Yup") : (print "Nope"); + + # perl4 prints: Yup + # perl5 prints: Nope + +Changing + + eval "\$$hashname{'$key'} = q|$value|"; + +to + + eval "\$\$hashname{'$key'} = q|$value|"; + +causes the following result: + + # perl4 prints: Nope + # perl5 prints: Yup + +or, changing to + + eval "\$$hashname\{'$key'\} = q|$value|"; + +causes the following result: + + # perl4 prints: Yup + # perl5 prints: Yup + # and is compatible for both versions + + +=item * Interpolation + +perl4 programs which unconsciously rely on the bugs in earlier perl versions. + + perl -e '$bar=q/not/; print "This is $foo{$bar} perl5"' + + # perl4 prints: This is not perl5 + # perl5 prints: This is perl5 + +=item * Interpolation + +You also have to be careful about array references. + + print "$foo{" + + perl 4 prints: { + perl 5 prints: syntax error + +=item * Interpolation + +Similarly, watch out for: + + $foo = "array"; + print "\$$foo{bar}\n"; + + # perl4 prints: $array{bar} + # perl5 prints: $ + +Perl 5 is looking for C<$array{bar}> which doesn't exist, but perl 4 is +happy just to expand $foo to "array" by itself. Watch out for this +especially in C's. + +=item * Interpolation + +C string passed to C + + eval qq( + foreach \$y (keys %\$x\) { + \$count++; + } + ); + + # perl4 runs this ok + # perl5 prints: Can't find string terminator ")" + +=back + +=head2 DBM Traps + +General DBM traps. + +=over 5 + +=item * DBM + +Existing dbm databases created under perl4 (or any other dbm/ndbm tool) +may cause the same script, run under perl5, to fail. The build of perl5 +must have been linked with the same dbm/ndbm as the default for C +to function properly without C'ing to an extension dbm implementation. + + dbmopen (%dbm, "file", undef); + print "ok\n"; + + # perl4 prints: ok + # perl5 prints: ok (IFF linked with -ldbm or -lndbm) + + +=item * DBM + +Existing dbm databases created under perl4 (or any other dbm/ndbm tool) +may cause the same script, run under perl5, to fail. The error generated +when exceeding the limit on the key/value size will cause perl5 to exit +immediately. + + dbmopen(DB, "testdb",0600) || die "couldn't open db! $!"; + $DB{'trap'} = "x" x 1024; # value too large for most dbm/ndbm + print "YUP\n"; + + # perl4 prints: + dbm store returned -1, errno 28, key "trap" at - line 3. + YUP + + # perl5 prints: + dbm store returned -1, errno 28, key "trap" at - line 3. + +=back + +=head2 Unclassified Traps + +Everything else. + +=over 5 + +=item * C/C trap using returned value + +If the file doit.pl has: + + sub foo { + $rc = do "./do.pl"; + return 8; + } + print &foo, "\n"; + +And the do.pl file has the following single line: + + return 3; + +Running doit.pl gives the following: + + # perl 4 prints: 3 (aborts the subroutine early) + # perl 5 prints: 8 + +Same behavior if you replace C with C. + +=item * C on empty string with LIMIT specified + + $string = ''; + @list = split(/foo/, $string, 2) + +Perl4 returns a one element list containing the empty string but Perl5 +returns an empty list. + +=back + +As always, if any of these are ever officially declared as bugs, +they'll be fixed and removed. + diff --git a/contrib/perl5/pod/perlvar.pod b/contrib/perl5/pod/perlvar.pod new file mode 100644 index 00000000000..2ed3e97f77b --- /dev/null +++ b/contrib/perl5/pod/perlvar.pod @@ -0,0 +1,936 @@ +=head1 NAME + +perlvar - Perl predefined variables + +=head1 DESCRIPTION + +=head2 Predefined Names + +The following names have special meaning to Perl. Most +punctuation names have reasonable mnemonics, or analogues in one of +the shells. Nevertheless, if you wish to use long variable names, +you just need to say + + use English; + +at the top of your program. This will alias all the short names to the +long names in the current package. Some even have medium names, +generally borrowed from B. + +To go a step further, those variables that depend on the currently +selected filehandle may instead (and preferably) be set by calling an +object method on the FileHandle object. (Summary lines below for this +contain the word HANDLE.) First you must say + + use FileHandle; + +after which you may use either + + method HANDLE EXPR + +or more safely, + + HANDLE->method(EXPR) + +Each of the methods returns the old value of the FileHandle attribute. +The methods each take an optional EXPR, which if supplied specifies the +new value for the FileHandle attribute in question. If not supplied, +most of the methods do nothing to the current value, except for +autoflush(), which will assume a 1 for you, just to be different. + +A few of these variables are considered "read-only". This means that if +you try to assign to this variable, either directly or indirectly through +a reference, you'll raise a run-time exception. + +The following list is ordered by scalar variables first, then the +arrays, then the hashes (except $^M was added in the wrong place). +This is somewhat obscured by the fact that %ENV and %SIG are listed as +$ENV{expr} and $SIG{expr}. + + +=over 8 + +=item $ARG + +=item $_ + +The default input and pattern-searching space. The following pairs are +equivalent: + + while (<>) {...} # equivalent in only while! + while (defined($_ = <>)) {...} + + /^Subject:/ + $_ =~ /^Subject:/ + + tr/a-z/A-Z/ + $_ =~ tr/a-z/A-Z/ + + chop + chop($_) + +Here are the places where Perl will assume $_ even if you +don't use it: + +=over 3 + +=item * + +Various unary functions, including functions like ord() and int(), as well +as the all file tests (C<-f>, C<-d>) except for C<-t>, which defaults to +STDIN. + +=item * + +Various list functions like print() and unlink(). + +=item * + +The pattern matching operations C, C, and C     when used +without an C<=~> operator. + +=item * + +The default iterator variable in a C loop if no other +variable is supplied. + +=item * + +The implicit iterator variable in the grep() and map() functions. + +=item * + +The default place to put an input record when a CFHE> +operation's result is tested by itself as the sole criterion of a C +test. Note that outside of a C test, this will not happen. + +=back + +(Mnemonic: underline is understood in certain operations.) + +=back + +=over 8 + +=item $EIE + +Contains the subpattern from the corresponding set of parentheses in +the last pattern matched, not counting patterns matched in nested +blocks that have been exited already. (Mnemonic: like \digits.) +These variables are all read-only. + +=item $MATCH + +=item $& + +The string matched by the last successful pattern match (not counting +any matches hidden within a BLOCK or eval() enclosed by the current +BLOCK). (Mnemonic: like & in some editors.) This variable is read-only. + +=item $PREMATCH + +=item $` + +The string preceding whatever was matched by the last successful +pattern match (not counting any matches hidden within a BLOCK or eval +enclosed by the current BLOCK). (Mnemonic: C<`> often precedes a quoted +string.) This variable is read-only. + +=item $POSTMATCH + +=item $' + +The string following whatever was matched by the last successful +pattern match (not counting any matches hidden within a BLOCK or eval() +enclosed by the current BLOCK). (Mnemonic: C<'> often follows a quoted +string.) Example: + + $_ = 'abcdefghi'; + /def/; + print "$`:$&:$'\n"; # prints abc:def:ghi + +This variable is read-only. + +=item $LAST_PAREN_MATCH + +=item $+ + +The last bracket matched by the last search pattern. This is useful if +you don't know which of a set of alternative patterns matched. For +example: + + /Version: (.*)|Revision: (.*)/ && ($rev = $+); + +(Mnemonic: be positive and forward looking.) +This variable is read-only. + +=item $MULTILINE_MATCHING + +=item $* + +Set to 1 to do multi-line matching within a string, 0 to tell Perl +that it can assume that strings contain a single line, for the purpose +of optimizing pattern matches. Pattern matches on strings containing +multiple newlines can produce confusing results when "C<$*>" is 0. Default +is 0. (Mnemonic: * matches multiple things.) Note that this variable +influences the interpretation of only "C<^>" and "C<$>". A literal newline can +be searched for even when C<$* == 0>. + +Use of "C<$*>" is deprecated in modern Perls, supplanted by +the C and C modifiers on pattern matching. + +=item input_line_number HANDLE EXPR + +=item $INPUT_LINE_NUMBER + +=item $NR + +=item $. + +The current input line number for the last file handle from +which you read (or performed a C or C on). An +explicit close on a filehandle resets the line number. Because +"CE>" never does an explicit close, line numbers increase +across ARGV files (but see examples under eof()). Localizing C<$.> has +the effect of also localizing Perl's notion of "the last read +filehandle". (Mnemonic: many programs use "." to mean the current line +number.) + +=item input_record_separator HANDLE EXPR + +=item $INPUT_RECORD_SEPARATOR + +=item $RS + +=item $/ + +The input record separator, newline by default. Works like B's RS +variable, including treating empty lines as delimiters if set to the +null string. (Note: An empty line cannot contain any spaces or tabs.) +You may set it to a multi-character string to match a multi-character +delimiter, or to C to read to end of file. Note that setting it +to C<"\n\n"> means something slightly different than setting it to +C<"">, if the file contains consecutive empty lines. Setting it to +C<""> will treat two or more consecutive empty lines as a single empty +line. Setting it to C<"\n\n"> will blindly assume that the next input +character belongs to the next paragraph, even if it's a newline. +(Mnemonic: / is used to delimit line boundaries when quoting poetry.) + + undef $/; + $_ = ; # whole file now here + s/\n[ \t]+/ /g; + +Remember: the value of $/ is a string, not a regexp. AWK has to be +better for something :-) + +Setting $/ to a reference to an integer, scalar containing an integer, or +scalar that's convertable to an integer will attempt to read records +instead of lines, with the maximum record size being the referenced +integer. So this: + + $/ = \32768; # or \"32768", or \$var_containing_32768 + open(FILE, $myfile); + $_ = ; + +will read a record of no more than 32768 bytes from FILE. If you're not +reading from a record-oriented file (or your OS doesn't have +record-oriented files), then you'll likely get a full chunk of data with +every read. If a record is larger than the record size you've set, you'll +get the record back in pieces. + +On VMS, record reads are done with the equivalent of C, so it's +best not to mix record and non-record reads on the same file. (This is +likely not a problem, as any file you'd want to read in record mode is +proably usable in line mode) Non-VMS systems perform normal I/O, so +it's safe to mix record and non-record reads of a file. + +=item autoflush HANDLE EXPR + +=item $OUTPUT_AUTOFLUSH + +=item $| + +If set to nonzero, forces a flush right away and after every write or print on the +currently selected output channel. Default is 0 (regardless of whether +the channel is actually buffered by the system or not; C<$|> tells you +only whether you've asked Perl explicitly to flush after each write). +Note that STDOUT will typically be line buffered if output is to the +terminal and block buffered otherwise. Setting this variable is useful +primarily when you are outputting to a pipe, such as when you are running +a Perl script under rsh and want to see the output as it's happening. This +has no effect on input buffering. +(Mnemonic: when you want your pipes to be piping hot.) + +=item output_field_separator HANDLE EXPR + +=item $OUTPUT_FIELD_SEPARATOR + +=item $OFS + +=item $, + +The output field separator for the print operator. Ordinarily the +print operator simply prints out the comma-separated fields you +specify. To get behavior more like B, set this variable +as you would set B's OFS variable to specify what is printed +between fields. (Mnemonic: what is printed when there is a , in your +print statement.) + +=item output_record_separator HANDLE EXPR + +=item $OUTPUT_RECORD_SEPARATOR + +=item $ORS + +=item $\ + +The output record separator for the print operator. Ordinarily the +print operator simply prints out the comma-separated fields you +specify, with no trailing newline or record separator assumed. +To get behavior more like B, set this variable as you would +set B's ORS variable to specify what is printed at the end of the +print. (Mnemonic: you set "C<$\>" instead of adding \n at the end of the +print. Also, it's just like C<$/>, but it's what you get "back" from +Perl.) + +=item $LIST_SEPARATOR + +=item $" + +This is like "C<$,>" except that it applies to array values interpolated +into a double-quoted string (or similar interpreted string). Default +is a space. (Mnemonic: obvious, I think.) + +=item $SUBSCRIPT_SEPARATOR + +=item $SUBSEP + +=item $; + +The subscript separator for multidimensional array emulation. If you +refer to a hash element as + + $foo{$a,$b,$c} + +it really means + + $foo{join($;, $a, $b, $c)} + +But don't put + + @foo{$a,$b,$c} # a slice--note the @ + +which means + + ($foo{$a},$foo{$b},$foo{$c}) + +Default is "\034", the same as SUBSEP in B. Note that if your +keys contain binary data there might not be any safe value for "C<$;>". +(Mnemonic: comma (the syntactic subscript separator) is a +semi-semicolon. Yeah, I know, it's pretty lame, but "C<$,>" is already +taken for something more important.) + +Consider using "real" multidimensional arrays. + +=item $OFMT + +=item $# + +The output format for printed numbers. This variable is a half-hearted +attempt to emulate B's OFMT variable. There are times, however, +when B and Perl have differing notions of what is in fact +numeric. The initial value is %.Ig, where I is the value +of the macro DBL_DIG from your system's F. This is different from +B's default OFMT setting of %.6g, so you need to set "C<$#>" +explicitly to get B's value. (Mnemonic: # is the number sign.) + +Use of "C<$#>" is deprecated. + +=item format_page_number HANDLE EXPR + +=item $FORMAT_PAGE_NUMBER + +=item $% + +The current page number of the currently selected output channel. +(Mnemonic: % is page number in B.) + +=item format_lines_per_page HANDLE EXPR + +=item $FORMAT_LINES_PER_PAGE + +=item $= + +The current page length (printable lines) of the currently selected +output channel. Default is 60. (Mnemonic: = has horizontal lines.) + +=item format_lines_left HANDLE EXPR + +=item $FORMAT_LINES_LEFT + +=item $- + +The number of lines left on the page of the currently selected output +channel. (Mnemonic: lines_on_page - lines_printed.) + +=item format_name HANDLE EXPR + +=item $FORMAT_NAME + +=item $~ + +The name of the current report format for the currently selected output +channel. Default is name of the filehandle. (Mnemonic: brother to +"C<$^>".) + +=item format_top_name HANDLE EXPR + +=item $FORMAT_TOP_NAME + +=item $^ + +The name of the current top-of-page format for the currently selected +output channel. Default is name of the filehandle with _TOP +appended. (Mnemonic: points to top of page.) + +=item format_line_break_characters HANDLE EXPR + +=item $FORMAT_LINE_BREAK_CHARACTERS + +=item $: + +The current set of characters after which a string may be broken to +fill continuation fields (starting with ^) in a format. Default is +S<" \n-">, to break on whitespace or hyphens. (Mnemonic: a "colon" in +poetry is a part of a line.) + +=item format_formfeed HANDLE EXPR + +=item $FORMAT_FORMFEED + +=item $^L + +What formats output to perform a form feed. Default is \f. + +=item $ACCUMULATOR + +=item $^A + +The current value of the write() accumulator for format() lines. A format +contains formline() commands that put their result into C<$^A>. After +calling its format, write() prints out the contents of C<$^A> and empties. +So you never actually see the contents of C<$^A> unless you call +formline() yourself and then look at it. See L and +L. + +=item $CHILD_ERROR + +=item $? + +The status returned by the last pipe close, backtick (C<``>) command, +or system() operator. Note that this is the status word returned by the +wait() system call (or else is made up to look like it). Thus, the exit +value of the subprocess is actually (C<$? EE 8>), and C<$? & 127> +gives which signal, if any, the process died from, and C<$? & 128> reports +whether there was a core dump. (Mnemonic: similar to B and B.) + +Additionally, if the C variable is supported in C, its value +is returned via $? if any of the C functions fail. + +Note that if you have installed a signal handler for C, the +value of C<$?> will usually be wrong outside that handler. + +Inside an C subroutine C<$?> contains the value that is going to be +given to C. You can modify C<$?> in an C subroutine to +change the exit status of the script. + +Under VMS, the pragma C makes C<$?> reflect the +actual VMS exit status, instead of the default emulation of POSIX +status. + +Also see L. + +=item $OS_ERROR + +=item $ERRNO + +=item $! + +If used in a numeric context, yields the current value of errno, with +all the usual caveats. (This means that you shouldn't depend on the +value of C<$!> to be anything in particular unless you've gotten a +specific error return indicating a system error.) If used in a string +context, yields the corresponding system error string. You can assign +to C<$!> to set I if, for instance, you want C<"$!"> to return the +string for error I, or you want to set the exit value for the die() +operator. (Mnemonic: What just went bang?) + +Also see L. + +=item $EXTENDED_OS_ERROR + +=item $^E + +Error information specific to the current operating system. At +the moment, this differs from C<$!> under only VMS, OS/2, and Win32 +(and for MacPerl). On all other platforms, C<$^E> is always just +the same as C<$!>. + +Under VMS, C<$^E> provides the VMS status value from the last +system error. This is more specific information about the last +system error than that provided by C<$!>. This is particularly +important when C<$!> is set to B. + +Under OS/2, C<$^E> is set to the error code of the last call to +OS/2 API either via CRT, or directly from perl. + +Under Win32, C<$^E> always returns the last error information +reported by the Win32 call C which describes +the last error from within the Win32 API. Most Win32-specific +code will report errors via C<$^E>. ANSI C and UNIX-like calls +set C and so most portable Perl code will report errors +via C<$!>. + +Caveats mentioned in the description of C<$!> generally apply to +C<$^E>, also. (Mnemonic: Extra error explanation.) + +Also see L. + +=item $EVAL_ERROR + +=item $@ + +The Perl syntax error message from the last eval() command. If null, the +last eval() parsed and executed correctly (although the operations you +invoked may have failed in the normal fashion). (Mnemonic: Where was +the syntax error "at"?) + +Note that warning messages are not collected in this variable. You can, +however, set up a routine to process warnings by setting C<$SIG{__WARN__}> +as described below. + +Also see L. + +=item $PROCESS_ID + +=item $PID + +=item $$ + +The process number of the Perl running this script. (Mnemonic: same +as shells.) + +=item $REAL_USER_ID + +=item $UID + +=item $< + +The real uid of this process. (Mnemonic: it's the uid you came I, +if you're running setuid.) + +=item $EFFECTIVE_USER_ID + +=item $EUID + +=item $> + +The effective uid of this process. Example: + + $< = $>; # set real to effective uid + ($<,$>) = ($>,$<); # swap real and effective uid + +(Mnemonic: it's the uid you went I, if you're running setuid.) +Note: "C<$E>" and "C<$E>" can be swapped only on machines +supporting setreuid(). + +=item $REAL_GROUP_ID + +=item $GID + +=item $( + +The real gid of this process. If you are on a machine that supports +membership in multiple groups simultaneously, gives a space separated +list of groups you are in. The first number is the one returned by +getgid(), and the subsequent ones by getgroups(), one of which may be +the same as the first number. + +However, a value assigned to "C<$(>" must be a single number used to +set the real gid. So the value given by "C<$(>" should I be assigned +back to "C<$(>" without being forced numeric, such as by adding zero. + +(Mnemonic: parentheses are used to I things. The real gid is the +group you I, if you're running setgid.) + +=item $EFFECTIVE_GROUP_ID + +=item $EGID + +=item $) + +The effective gid of this process. If you are on a machine that +supports membership in multiple groups simultaneously, gives a space +separated list of groups you are in. The first number is the one +returned by getegid(), and the subsequent ones by getgroups(), one of +which may be the same as the first number. + +Similarly, a value assigned to "C<$)>" must also be a space-separated +list of numbers. The first number is used to set the effective gid, and +the rest (if any) are passed to setgroups(). To get the effect of an +empty list for setgroups(), just repeat the new effective gid; that is, +to force an effective gid of 5 and an effectively empty setgroups() +list, say C< $) = "5 5" >. + +(Mnemonic: parentheses are used to I things. The effective gid +is the group that's I for you, if you're running setgid.) + +Note: "C<$E>", "C<$E>", "C<$(>" and "C<$)>" can be set only on +machines that support the corresponding I routine. "C<$(>" +and "C<$)>" can be swapped only on machines supporting setregid(). + +=item $PROGRAM_NAME + +=item $0 + +Contains the name of the file containing the Perl script being +executed. On some operating systems +assigning to "C<$0>" modifies the argument area that the ps(1) +program sees. This is more useful as a way of indicating the +current program state than it is for hiding the program you're running. +(Mnemonic: same as B and B.) + +=item $[ + +The index of the first element in an array, and of the first character +in a substring. Default is 0, but you could set it to 1 to make +Perl behave more like B (or Fortran) when subscripting and when +evaluating the index() and substr() functions. (Mnemonic: [ begins +subscripts.) + +As of Perl 5, assignment to "C<$[>" is treated as a compiler directive, +and cannot influence the behavior of any other file. Its use is +discouraged. + +=item $PERL_VERSION + +=item $] + +The version + patchlevel / 1000 of the Perl interpreter. This variable +can be used to determine whether the Perl interpreter executing a +script is in the right range of versions. (Mnemonic: Is this version +of perl in the right bracket?) Example: + + warn "No checksumming!\n" if $] < 3.019; + +See also the documentation of C and C +for a convenient way to fail if the Perl interpreter is too old. + +=item $DEBUGGING + +=item $^D + +The current value of the debugging flags. (Mnemonic: value of B<-D> +switch.) + +=item $SYSTEM_FD_MAX + +=item $^F + +The maximum system file descriptor, ordinarily 2. System file +descriptors are passed to exec()ed processes, while higher file +descriptors are not. Also, during an open(), system file descriptors are +preserved even if the open() fails. (Ordinary file descriptors are +closed before the open() is attempted.) Note that the close-on-exec +status of a file descriptor will be decided according to the value of +C<$^F> at the time of the open, not the time of the exec. + +=item $^H + +The current set of syntax checks enabled by C and other block +scoped compiler hints. See the documentation of C for more details. + +=item $INPLACE_EDIT + +=item $^I + +The current value of the inplace-edit extension. Use C to disable +inplace editing. (Mnemonic: value of B<-i> switch.) + +=item $^M + +By default, running out of memory it is not trappable. However, if +compiled for this, Perl may use the contents of C<$^M> as an emergency +pool after die()ing with this message. Suppose that your Perl were +compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then + + $^M = 'a' x (1<<16); + +would allocate a 64K buffer for use when in emergency. See the F +file for information on how to enable this option. As a disincentive to +casual use of this advanced feature, there is no L long name for +this variable. + +=item $OSNAME + +=item $^O + +The name of the operating system under which this copy of Perl was +built, as determined during the configuration process. The value +is identical to C<$Config{'osname'}>. + +=item $PERLDB + +=item $^P + +The internal variable for debugging support. Different bits mean the +following (subject to change): + +=over 6 + +=item 0x01 + +Debug subroutine enter/exit. + +=item 0x02 + +Line-by-line debugging. + +=item 0x04 + +Switch off optimizations. + +=item 0x08 + +Preserve more data for future interactive inspections. + +=item 0x10 + +Keep info about source lines on which a subroutine is defined. + +=item 0x20 + +Start with single-step on. + +=back + +Note that some bits may be relevent at compile-time only, some at +run-time only. This is a new mechanism and the details may change. + +=item $^R + +The result of evaluation of the last successful L> +regular expression assertion. (Excluding those used as switches.) May +be written to. + +=item $^S + +Current state of the interpreter. Undefined if parsing of the current +module/eval is not finished (may happen in $SIG{__DIE__} and +$SIG{__WARN__} handlers). True if inside an eval, otherwise false. + +=item $BASETIME + +=item $^T + +The time at which the script began running, in seconds since the +epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, +and B<-C> filetests are +based on this value. + +=item $WARNING + +=item $^W + +The current value of the warning switch, either TRUE or FALSE. +(Mnemonic: related to the B<-w> switch.) + +=item $EXECUTABLE_NAME + +=item $^X + +The name that the Perl binary itself was executed as, from C's C. + +=item $ARGV + +contains the name of the current file when reading from EE. + +=item @ARGV + +The array @ARGV contains the command line arguments intended for the +script. Note that C<$#ARGV> is the generally number of arguments minus +one, because C<$ARGV[0]> is the first argument, I the command name. See +"C<$0>" for the command name. + +=item @INC + +The array @INC contains the list of places to look for Perl scripts to +be evaluated by the C, C, or C constructs. It +initially consists of the arguments to any B<-I> command line switches, +followed by the default Perl library, probably F, +followed by ".", to represent the current directory. If you need to +modify this at runtime, you should use the C pragma +to get the machine-dependent library properly loaded also: + + use lib '/mypath/libdir/'; + use SomeMod; + +=item @_ + +Within a subroutine the array @_ contains the parameters passed to that +subroutine. See L. + +=item %INC + +The hash %INC contains entries for each filename that has +been included via C or C. The key is the filename you +specified, and the value is the location of the file actually found. +The C command uses this array to determine whether a given file +has already been included. + +=item %ENV $ENV{expr} + +The hash %ENV contains your current environment. Setting a +value in C changes the environment for child processes. + +=item %SIG $SIG{expr} + +The hash %SIG is used to set signal handlers for various +signals. Example: + + sub handler { # 1st argument is signal name + my($sig) = @_; + print "Caught a SIG$sig--shutting down\n"; + close(LOG); + exit(0); + } + + $SIG{'INT'} = \&handler; + $SIG{'QUIT'} = \&handler; + ... + $SIG{'INT'} = 'DEFAULT'; # restore default action + $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT + +The %SIG array contains values for only the signals actually set within +the Perl script. Here are some other examples: + + $SIG{"PIPE"} = Plumber; # SCARY!! + $SIG{"PIPE"} = "Plumber"; # assumes main::Plumber (not recommended) + $SIG{"PIPE"} = \&Plumber; # just fine; assume current Plumber + $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? + +The one marked scary is problematic because it's a bareword, which means +sometimes it's a string representing the function, and sometimes it's +going to call the subroutine call right then and there! Best to be sure +and quote it or take a reference to it. *Plumber works too. See L. + +If your system has the sigaction() function then signal handlers are +installed using it. This means you get reliable signal handling. If +your system has the SA_RESTART flag it is used when signals handlers are +installed. This means that system calls for which it is supported +continue rather than returning when a signal arrives. If you want your +system calls to be interrupted by signal delivery then do something like +this: + + use POSIX ':signal_h'; + + my $alarm = 0; + sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } + or die "Error setting SIGALRM handler: $!\n"; + +See L. + +Certain internal hooks can be also set using the %SIG hash. The +routine indicated by C<$SIG{__WARN__}> is called when a warning message is +about to be printed. The warning message is passed as the first +argument. The presence of a __WARN__ hook causes the ordinary printing +of warnings to STDERR to be suppressed. You can use this to save warnings +in a variable, or turn warnings into fatal errors, like this: + + local $SIG{__WARN__} = sub { die $_[0] }; + eval $proggie; + +The routine indicated by C<$SIG{__DIE__}> is called when a fatal exception +is about to be thrown. The error message is passed as the first +argument. When a __DIE__ hook routine returns, the exception +processing continues as it would have in the absence of the hook, +unless the hook routine itself exits via a C, a loop exit, or a die(). +The C<__DIE__> handler is explicitly disabled during the call, so that you +can die from a C<__DIE__> handler. Similarly for C<__WARN__>. + +Note that the C<$SIG{__DIE__}> hook is called even inside eval()ed +blocks/strings. See L and L for how to +circumvent this. + +Note that C<__DIE__>/C<__WARN__> handlers are very special in one +respect: they may be called to report (probable) errors found by the +parser. In such a case the parser may be in inconsistent state, so +any attempt to evaluate Perl code from such a handler will probably +result in a segfault. This means that calls which result/may-result +in parsing Perl should be used with extreme causion, like this: + + require Carp if defined $^S; + Carp::confess("Something wrong") if defined &Carp::confess; + die "Something wrong, but could not load Carp to give backtrace... + To see backtrace try starting Perl with -MCarp switch"; + +Here the first line will load Carp I it is the parser who +called the handler. The second line will print backtrace and die if +Carp was available. The third line will be executed only if Carp was +not available. + +See L, L and L for +additional info. + +=back + +=head2 Error Indicators + +The variables L<$@>, L<$!>, L<$^E>, and L<$?> contain information about +different types of error conditions that may appear during execution of +Perl script. The variables are shown ordered by the "distance" between +the subsystem which reported the error and the Perl process, and +correspond to errors detected by the Perl interpreter, C library, +operating system, or an external program, respectively. + +To illustrate the differences between these variables, consider the +following Perl expression: + + eval ' + open PIPE, "/cdrom/install |"; + @res = ; + close PIPE or die "bad pipe: $?, $!"; + '; + +After execution of this statement all 4 variables may have been set. + +$@ is set if the string to be C-ed did not compile (this may happen if +C or C were imported with bad prototypes), or if Perl +code executed during evaluation die()d (either implicitly, say, +if C was imported from module L, or the C after +C was triggered). In these cases the value of $@ is the compile +error, or C error (which will interpolate C<$!>!), or the argument +to C (which will interpolate C<$!> and C<$?>!). + +When the above expression is executed, open(), C<>, and C +are translated to C run-time library calls. $! is set if one of these +calls fails. The value is a symbolic indicator chosen by the C run-time +library, say C. + +On some systems the above C library calls are further translated +to calls to the kernel. The kernel may have set more verbose error +indicator that one of the handful of standard C errors. In such cases $^E +contains this verbose error indicator, which may be, say, C. On systems where C library calls are identical to system calls +$^E is a duplicate of $!. + +Finally, $? may be set to non-C<0> value if the external program +C fails. Upper bits of the particular value may reflect +specific error conditions encountered by this program (this is +program-dependent), lower-bits reflect mode of failure (segfault, completion, +etc.). Note that in contrast to $@, $!, and $^E, which are set only +if error condition is detected, the variable $? is set on each C or +pipe C, overwriting the old value. + +For more details, see the individual descriptions at L<$@>, L<$!>, L<$^E>, +and L<$?>. diff --git a/contrib/perl5/pod/perlxs.pod b/contrib/perl5/pod/perlxs.pod new file mode 100644 index 00000000000..c578a2ec591 --- /dev/null +++ b/contrib/perl5/pod/perlxs.pod @@ -0,0 +1,1348 @@ +=head1 NAME + +perlxs - XS language reference manual + +=head1 DESCRIPTION + +=head2 Introduction + +XS is a language used to create an extension interface +between Perl and some C library which one wishes to use with +Perl. The XS interface is combined with the library to +create a new library which can be linked to Perl. An B +is a function in the XS language and is the core component +of the Perl application interface. + +The XS compiler is called B. This compiler will embed +the constructs necessary to let an XSUB, which is really a C +function in disguise, manipulate Perl values and creates the +glue necessary to let Perl access the XSUB. The compiler +uses B to determine how to map C function parameters +and variables to Perl values. The default typemap handles +many common C types. A supplement typemap must be created +to handle special structures and types for the library being +linked. + +See L for a tutorial on the whole extension creation process. + +Note: For many extensions, Dave Beazley's SWIG system provides a +significantly more convenient mechanism for creating the XS glue +code. See L for more +information. + +=head2 On The Road + +Many of the examples which follow will concentrate on creating an interface +between Perl and the ONC+ RPC bind library functions. The rpcb_gettime() +function is used to demonstrate many features of the XS language. This +function has two parameters; the first is an input parameter and the second +is an output parameter. The function also returns a status value. + + bool_t rpcb_gettime(const char *host, time_t *timep); + +From C this function will be called with the following +statements. + + #include + bool_t status; + time_t timep; + status = rpcb_gettime( "localhost", &timep ); + +If an XSUB is created to offer a direct translation between this function +and Perl, then this XSUB will be used from Perl with the following code. +The $status and $timep variables will contain the output of the function. + + use RPC; + $status = rpcb_gettime( "localhost", $timep ); + +The following XS file shows an XS subroutine, or XSUB, which +demonstrates one possible interface to the rpcb_gettime() +function. This XSUB represents a direct translation between +C and Perl and so preserves the interface even from Perl. +This XSUB will be invoked from Perl with the usage shown +above. Note that the first three #include statements, for +C, C, and C, will always be present at the +beginning of an XS file. This approach and others will be +expanded later in this document. + + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + #include + + MODULE = RPC PACKAGE = RPC + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + +Any extension to Perl, including those containing XSUBs, +should have a Perl module to serve as the bootstrap which +pulls the extension into Perl. This module will export the +extension's functions and variables to the Perl program and +will cause the extension's XSUBs to be linked into Perl. +The following module will be used for most of the examples +in this document and should be used from Perl with the C +command as shown earlier. Perl modules are explained in +more detail later in this document. + + package RPC; + + require Exporter; + require DynaLoader; + @ISA = qw(Exporter DynaLoader); + @EXPORT = qw( rpcb_gettime ); + + bootstrap RPC; + 1; + +Throughout this document a variety of interfaces to the rpcb_gettime() +XSUB will be explored. The XSUBs will take their parameters in different +orders or will take different numbers of parameters. In each case the +XSUB is an abstraction between Perl and the real C rpcb_gettime() +function, and the XSUB must always ensure that the real rpcb_gettime() +function is called with the correct parameters. This abstraction will +allow the programmer to create a more Perl-like interface to the C +function. + +=head2 The Anatomy of an XSUB + +The following XSUB allows a Perl program to access a C library function +called sin(). The XSUB will imitate the C function which takes a single +argument and returns a single value. + + double + sin(x) + double x + +When using C pointers the indirection operator C<*> should be considered +part of the type and the address operator C<&> should be considered part of +the variable, as is demonstrated in the rpcb_gettime() function above. See +the section on typemaps for more about handling qualifiers and unary +operators in C types. + +The function name and the return type must be placed on +separate lines. + + INCORRECT CORRECT + + double sin(x) double + double x sin(x) + double x + +The function body may be indented or left-adjusted. The following example +shows a function with its body left-adjusted. Most examples in this +document will indent the body. + + CORRECT + + double + sin(x) + double x + +=head2 The Argument Stack + +The argument stack is used to store the values which are +sent as parameters to the XSUB and to store the XSUB's +return value. In reality all Perl functions keep their +values on this stack at the same time, each limited to its +own range of positions on the stack. In this document the +first position on that stack which belongs to the active +function will be referred to as position 0 for that function. + +XSUBs refer to their stack arguments with the macro B, where I +refers to a position in this XSUB's part of the stack. Position 0 for that +function would be known to the XSUB as ST(0). The XSUB's incoming +parameters and outgoing return values always begin at ST(0). For many +simple cases the B compiler will generate the code necessary to +handle the argument stack by embedding code fragments found in the +typemaps. In more complex cases the programmer must supply the code. + +=head2 The RETVAL Variable + +The RETVAL variable is a magic variable which always matches +the return type of the C library function. The B compiler will +supply this variable in each XSUB and by default will use it to hold the +return value of the C library function being called. In simple cases the +value of RETVAL will be placed in ST(0) of the argument stack where it can +be received by Perl as the return value of the XSUB. + +If the XSUB has a return type of C then the compiler will +not supply a RETVAL variable for that function. When using +the PPCODE: directive the RETVAL variable is not needed, unless used +explicitly. + +If PPCODE: directive is not used, C return value should be used +only for subroutines which do not return a value, I CODE: +directive is used which sets ST(0) explicitly. + +Older versions of this document recommended to use C return +value in such cases. It was discovered that this could lead to +segfaults in cases when XSUB was I C. This practice is +now deprecated, and may be not supported at some future version. Use +the return value C in such cases. (Currently C contains +some heuristic code which tries to disambiguate between "truely-void" +and "old-practice-declared-as-void" functions. Hence your code is at +mercy of this heuristics unless you use C as return value.) + +=head2 The MODULE Keyword + +The MODULE keyword is used to start the XS code and to +specify the package of the functions which are being +defined. All text preceding the first MODULE keyword is +considered C code and is passed through to the output +untouched. Every XS module will have a bootstrap function +which is used to hook the XSUBs into Perl. The package name +of this bootstrap function will match the value of the last +MODULE statement in the XS source files. The value of +MODULE should always remain constant within the same XS +file, though this is not required. + +The following example will start the XS code and will place +all functions in a package named RPC. + + MODULE = RPC + +=head2 The PACKAGE Keyword + +When functions within an XS source file must be separated into packages +the PACKAGE keyword should be used. This keyword is used with the MODULE +keyword and must follow immediately after it when used. + + MODULE = RPC PACKAGE = RPC + + [ XS code in package RPC ] + + MODULE = RPC PACKAGE = RPCB + + [ XS code in package RPCB ] + + MODULE = RPC PACKAGE = RPC + + [ XS code in package RPC ] + +Although this keyword is optional and in some cases provides redundant +information it should always be used. This keyword will ensure that the +XSUBs appear in the desired package. + +=head2 The PREFIX Keyword + +The PREFIX keyword designates prefixes which should be +removed from the Perl function names. If the C function is +C and the PREFIX value is C then Perl will +see this function as C. + +This keyword should follow the PACKAGE keyword when used. +If PACKAGE is not used then PREFIX should follow the MODULE +keyword. + + MODULE = RPC PREFIX = rpc_ + + MODULE = RPC PACKAGE = RPCB PREFIX = rpcb_ + +=head2 The OUTPUT: Keyword + +The OUTPUT: keyword indicates that certain function parameters should be +updated (new values made visible to Perl) when the XSUB terminates or that +certain values should be returned to the calling Perl function. For +simple functions, such as the sin() function above, the RETVAL variable is +automatically designated as an output value. In more complex functions +the B compiler will need help to determine which variables are output +variables. + +This keyword will normally be used to complement the CODE: keyword. +The RETVAL variable is not recognized as an output variable when the +CODE: keyword is present. The OUTPUT: keyword is used in this +situation to tell the compiler that RETVAL really is an output +variable. + +The OUTPUT: keyword can also be used to indicate that function parameters +are output variables. This may be necessary when a parameter has been +modified within the function and the programmer would like the update to +be seen by Perl. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + +The OUTPUT: keyword will also allow an output parameter to +be mapped to a matching piece of code rather than to a +typemap. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep sv_setnv(ST(1), (double)timep); + +B emits an automatic C for all parameters in the +OUTPUT section of the XSUB, except RETVAL. This is the usually desired +behavior, as it takes care of properly invoking 'set' magic on output +parameters (needed for hash or array element parameters that must be +created if they didn't exist). If for some reason, this behavior is +not desired, the OUTPUT section may contain a C line +to disable it for the remainder of the parameters in the OUTPUT section. +Likewise, C can be used to reenable it for the +remainder of the OUTPUT section. See L for more details +about 'set' magic. + +=head2 The CODE: Keyword + +This keyword is used in more complicated XSUBs which require +special handling for the C function. The RETVAL variable is +available but will not be returned unless it is specified +under the OUTPUT: keyword. + +The following XSUB is for a C function which requires special handling of +its parameters. The Perl usage is given first. + + $status = rpcb_gettime( "localhost", $timep ); + +The XSUB follows. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t timep + CODE: + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The INIT: Keyword + +The INIT: keyword allows initialization to be inserted into the XSUB before +the compiler generates the call to the C function. Unlike the CODE: keyword +above, this keyword does not affect the way the compiler handles RETVAL. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + INIT: + printf("# Host is %s\n", host ); + OUTPUT: + timep + +=head2 The NO_INIT Keyword + +The NO_INIT keyword is used to indicate that a function +parameter is being used only as an output value. The B +compiler will normally generate code to read the values of +all function parameters from the argument stack and assign +them to C variables upon entry to the function. NO_INIT +will tell the compiler that some parameters will be used for +output rather than for input and that they will be handled +before the function terminates. + +The following example shows a variation of the rpcb_gettime() function. +This function uses the timep variable only as an output variable and does +not care about its initial contents. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep = NO_INIT + OUTPUT: + timep + +=head2 Initializing Function Parameters + +Function parameters are normally initialized with their +values from the argument stack. The typemaps contain the +code segments which are used to transfer the Perl values to +the C parameters. The programmer, however, is allowed to +override the typemaps and supply alternate (or additional) +initialization code. + +The following code demonstrates how to supply initialization code for +function parameters. The initialization code is eval'd within double +quotes by the compiler before it is added to the output so anything +which should be interpreted literally [mainly C<$>, C<@>, or C<\\>] +must be protected with backslashes. The variables C<$var>, C<$arg>, +and C<$type> can be used as in typemaps. + + bool_t + rpcb_gettime(host,timep) + char *host = (char *)SvPV($arg,PL_na); + time_t &timep = 0; + OUTPUT: + timep + +This should not be used to supply default values for parameters. One +would normally use this when a function parameter must be processed by +another library function before it can be used. Default parameters are +covered in the next section. + +If the initialization begins with C<=>, then it is output on +the same line where the input variable is declared. If the +initialization begins with C<;> or C<+>, then it is output after +all of the input variables have been declared. The C<=> and C<;> +cases replace the initialization normally supplied from the typemap. +For the C<+> case, the initialization from the typemap will preceed +the initialization code included after the C<+>. A global +variable, C<%v>, is available for the truely rare case where +information from one initialization is needed in another +initialization. + + bool_t + rpcb_gettime(host,timep) + time_t &timep ; /*\$v{time}=@{[$v{time}=$arg]}*/ + char *host + SvOK($v{time}) ? SvPV($arg,PL_na) : NULL; + OUTPUT: + timep + +=head2 Default Parameter Values + +Default values can be specified for function parameters by +placing an assignment statement in the parameter list. The +default value may be a number or a string. Defaults should +always be used on the right-most parameters only. + +To allow the XSUB for rpcb_gettime() to have a default host +value the parameters to the XSUB could be rearranged. The +XSUB will then call the real rpcb_gettime() function with +the parameters in the correct order. Perl will call this +XSUB with either of the following statements. + + $status = rpcb_gettime( $timep, $host ); + + $status = rpcb_gettime( $timep ); + +The XSUB will look like the code which follows. A CODE: +block is used to call the real rpcb_gettime() function with +the parameters in the correct order for that function. + + bool_t + rpcb_gettime(timep,host="localhost") + char *host + time_t timep = NO_INIT + CODE: + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The PREINIT: Keyword + +The PREINIT: keyword allows extra variables to be declared before the +typemaps are expanded. If a variable is declared in a CODE: block then that +variable will follow any typemap code. This may result in a C syntax +error. To force the variable to be declared before the typemap code, place +it into a PREINIT: block. The PREINIT: keyword may be used one or more +times within an XSUB. + +The following examples are equivalent, but if the code is using complex +typemaps then the first example is safer. + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + PREINIT: + char *host = "localhost"; + CODE: + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +A correct, but error-prone example. + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + CODE: + char *host = "localhost"; + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The SCOPE: Keyword + +The SCOPE: keyword allows scoping to be enabled for a particular XSUB. If +enabled, the XSUB will invoke ENTER and LEAVE automatically. + +To support potentially complex type mappings, if a typemap entry used +by this XSUB contains a comment like C then scoping will +automatically be enabled for that XSUB. + +To enable scoping: + + SCOPE: ENABLE + +To disable scoping: + + SCOPE: DISABLE + +=head2 The INPUT: Keyword + +The XSUB's parameters are usually evaluated immediately after entering the +XSUB. The INPUT: keyword can be used to force those parameters to be +evaluated a little later. The INPUT: keyword can be used multiple times +within an XSUB and can be used to list one or more input variables. This +keyword is used with the PREINIT: keyword. + +The following example shows how the input parameter C can be +evaluated late, after a PREINIT. + + bool_t + rpcb_gettime(host,timep) + char *host + PREINIT: + time_t tt; + INPUT: + time_t timep + CODE: + RETVAL = rpcb_gettime( host, &tt ); + timep = tt; + OUTPUT: + timep + RETVAL + +The next example shows each input parameter evaluated late. + + bool_t + rpcb_gettime(host,timep) + PREINIT: + time_t tt; + INPUT: + char *host + PREINIT: + char *h; + INPUT: + time_t timep + CODE: + h = host; + RETVAL = rpcb_gettime( h, &tt ); + timep = tt; + OUTPUT: + timep + RETVAL + +=head2 Variable-length Parameter Lists + +XSUBs can have variable-length parameter lists by specifying an ellipsis +C<(...)> in the parameter list. This use of the ellipsis is similar to that +found in ANSI C. The programmer is able to determine the number of +arguments passed to the XSUB by examining the C variable which the +B compiler supplies for all XSUBs. By using this mechanism one can +create an XSUB which accepts a list of parameters of unknown length. + +The I parameter for the rpcb_gettime() XSUB can be +optional so the ellipsis can be used to indicate that the +XSUB will take a variable number of parameters. Perl should +be able to call this XSUB with either of the following statements. + + $status = rpcb_gettime( $timep, $host ); + + $status = rpcb_gettime( $timep ); + +The XS code, with ellipsis, follows. + + bool_t + rpcb_gettime(timep, ...) + time_t timep = NO_INIT + PREINIT: + char *host = "localhost"; + CODE: + if( items > 1 ) + host = (char *)SvPV(ST(1), PL_na); + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The C_ARGS: Keyword + +The C_ARGS: keyword allows creating of XSUBS which have different +calling sequence from Perl than from C, without a need to write +CODE: or CPPCODE: section. The contents of the C_ARGS: paragraph is +put as the argument to the called C function without any change. + +For example, suppose that C function is declared as + + symbolic nth_derivative(int n, symbolic function, int flags); + +and that the default flags are kept in a global C variable +C. Suppose that you want to create an interface which +is called as + + $second_deriv = $function->nth_derivative(2); + +To do this, declare the XSUB as + + symbolic + nth_derivative(function, n) + symbolic function + int n + C_ARGS: + n, function, default_flags + +=head2 The PPCODE: Keyword + +The PPCODE: keyword is an alternate form of the CODE: keyword and is used +to tell the B compiler that the programmer is supplying the code to +control the argument stack for the XSUBs return values. Occasionally one +will want an XSUB to return a list of values rather than a single value. +In these cases one must use PPCODE: and then explicitly push the list of +values on the stack. The PPCODE: and CODE: keywords are not used +together within the same XSUB. + +The following XSUB will call the C rpcb_gettime() function +and will return its two output values, timep and status, to +Perl as a single list. + + void + rpcb_gettime(host) + char *host + PREINIT: + time_t timep; + bool_t status; + PPCODE: + status = rpcb_gettime( host, &timep ); + EXTEND(SP, 2); + PUSHs(sv_2mortal(newSViv(status))); + PUSHs(sv_2mortal(newSViv(timep))); + +Notice that the programmer must supply the C code necessary +to have the real rpcb_gettime() function called and to have +the return values properly placed on the argument stack. + +The C return type for this function tells the B compiler that +the RETVAL variable is not needed or used and that it should not be created. +In most scenarios the void return type should be used with the PPCODE: +directive. + +The EXTEND() macro is used to make room on the argument +stack for 2 return values. The PPCODE: directive causes the +B compiler to create a stack pointer available as C, and it +is this pointer which is being used in the EXTEND() macro. +The values are then pushed onto the stack with the PUSHs() +macro. + +Now the rpcb_gettime() function can be used from Perl with +the following statement. + + ($status, $timep) = rpcb_gettime("localhost"); + +When handling output parameters with a PPCODE section, be sure to handle +'set' magic properly. See L for details about 'set' magic. + +=head2 Returning Undef And Empty Lists + +Occasionally the programmer will want to return simply +C or an empty list if a function fails rather than a +separate status value. The rpcb_gettime() function offers +just this situation. If the function succeeds we would like +to have it return the time and if it fails we would like to +have undef returned. In the following Perl code the value +of $timep will either be undef or it will be a valid time. + + $timep = rpcb_gettime( "localhost" ); + +The following XSUB uses the C return type as a mnemonic only, +and uses a CODE: block to indicate to the compiler +that the programmer has supplied all the necessary code. The +sv_newmortal() call will initialize the return value to undef, making that +the default return value. + + SV * + rpcb_gettime(host) + char * host + PREINIT: + time_t timep; + bool_t x; + CODE: + ST(0) = sv_newmortal(); + if( rpcb_gettime( host, &timep ) ) + sv_setnv( ST(0), (double)timep); + +The next example demonstrates how one would place an explicit undef in the +return value, should the need arise. + + SV * + rpcb_gettime(host) + char * host + PREINIT: + time_t timep; + bool_t x; + CODE: + ST(0) = sv_newmortal(); + if( rpcb_gettime( host, &timep ) ){ + sv_setnv( ST(0), (double)timep); + } + else{ + ST(0) = &PL_sv_undef; + } + +To return an empty list one must use a PPCODE: block and +then not push return values on the stack. + + void + rpcb_gettime(host) + char *host + PREINIT: + time_t timep; + PPCODE: + if( rpcb_gettime( host, &timep ) ) + PUSHs(sv_2mortal(newSViv(timep))); + else{ + /* Nothing pushed on stack, so an empty */ + /* list is implicitly returned. */ + } + +Some people may be inclined to include an explicit C in the above +XSUB, rather than letting control fall through to the end. In those +situations C should be used, instead. This will ensure that +the XSUB stack is properly adjusted. Consult L for +other C macros. + +=head2 The REQUIRE: Keyword + +The REQUIRE: keyword is used to indicate the minimum version of the +B compiler needed to compile the XS module. An XS module which +contains the following statement will compile with only B version +1.922 or greater: + + REQUIRE: 1.922 + +=head2 The CLEANUP: Keyword + +This keyword can be used when an XSUB requires special cleanup procedures +before it terminates. When the CLEANUP: keyword is used it must follow +any CODE:, PPCODE:, or OUTPUT: blocks which are present in the XSUB. The +code specified for the cleanup block will be added as the last statements +in the XSUB. + +=head2 The BOOT: Keyword + +The BOOT: keyword is used to add code to the extension's bootstrap +function. The bootstrap function is generated by the B compiler and +normally holds the statements necessary to register any XSUBs with Perl. +With the BOOT: keyword the programmer can tell the compiler to add extra +statements to the bootstrap function. + +This keyword may be used any time after the first MODULE keyword and should +appear on a line by itself. The first blank line after the keyword will +terminate the code block. + + BOOT: + # The following message will be printed when the + # bootstrap function executes. + printf("Hello from the bootstrap!\n"); + +=head2 The VERSIONCHECK: Keyword + +The VERSIONCHECK: keyword corresponds to B's C<-versioncheck> and +C<-noversioncheck> options. This keyword overrides the command line +options. Version checking is enabled by default. When version checking is +enabled the XS module will attempt to verify that its version matches the +version of the PM module. + +To enable version checking: + + VERSIONCHECK: ENABLE + +To disable version checking: + + VERSIONCHECK: DISABLE + +=head2 The PROTOTYPES: Keyword + +The PROTOTYPES: keyword corresponds to B's C<-prototypes> and +C<-noprototypes> options. This keyword overrides the command line options. +Prototypes are enabled by default. When prototypes are enabled XSUBs will +be given Perl prototypes. This keyword may be used multiple times in an XS +module to enable and disable prototypes for different parts of the module. + +To enable prototypes: + + PROTOTYPES: ENABLE + +To disable prototypes: + + PROTOTYPES: DISABLE + +=head2 The PROTOTYPE: Keyword + +This keyword is similar to the PROTOTYPES: keyword above but can be used to +force B to use a specific prototype for the XSUB. This keyword +overrides all other prototype options and keywords but affects only the +current XSUB. Consult L for information about Perl +prototypes. + + bool_t + rpcb_gettime(timep, ...) + time_t timep = NO_INIT + PROTOTYPE: $;$ + PREINIT: + char *host = "localhost"; + CODE: + if( items > 1 ) + host = (char *)SvPV(ST(1), PL_na); + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: + timep + RETVAL + +=head2 The ALIAS: Keyword + +The ALIAS: keyword allows an XSUB to have two or more unique Perl names +and to know which of those names was used when it was invoked. The Perl +names may be fully-qualified with package names. Each alias is given an +index. The compiler will setup a variable called C which contain the +index of the alias which was used. When the XSUB is called with its +declared name C will be 0. + +The following example will create aliases C and +C for this function. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + ALIAS: + FOO::gettime = 1 + BAR::getit = 2 + INIT: + printf("# ix = %d\n", ix ); + OUTPUT: + timep + +=head2 The INTERFACE: Keyword + +This keyword declares the current XSUB as a keeper of the given +calling signature. If some text follows this keyword, it is +considered as a list of functions which have this signature, and +should be attached to XSUBs. + +Say, if you have 4 functions multiply(), divide(), add(), subtract() all +having the signature + + symbolic f(symbolic, symbolic); + +you code them all by using XSUB + + symbolic + interface_s_ss(arg1, arg2) + symbolic arg1 + symbolic arg2 + INTERFACE: + multiply divide + add subtract + +The advantage of this approach comparing to ALIAS: keyword is that one +can attach an extra function remainder() at runtime by using + + CV *mycv = newXSproto("Symbolic::remainder", + XS_Symbolic_interface_s_ss, __FILE__, "$$"); + XSINTERFACE_FUNC_SET(mycv, remainder); + +(This example supposes that there was no INTERFACE_MACRO: section, +otherwise one needs to use something else instead of +C.) + +=head2 The INTERFACE_MACRO: Keyword + +This keyword allows one to define an INTERFACE using a different way +to extract a function pointer from an XSUB. The text which follows +this keyword should give the name of macros which would extract/set a +function pointer. The extractor macro is given return type, C, +and C for this C. The setter macro is given cv, +and the function pointer. + +The default value is C and C. +An INTERFACE keyword with an empty list of functions can be omitted if +INTERFACE_MACRO keyword is used. + +Suppose that in the previous example functions pointers for +multiply(), divide(), add(), subtract() are kept in a global C array +C with offsets being C, C, C, +C. Then one can use + + #define XSINTERFACE_FUNC_BYOFFSET(ret,cv,f) \ + ((XSINTERFACE_CVT(ret,))fp[CvXSUBANY(cv).any_i32]) + #define XSINTERFACE_FUNC_BYOFFSET_set(cv,f) \ + CvXSUBANY(cv).any_i32 = CAT2( f, _off ) + +in C section, + + symbolic + interface_s_ss(arg1, arg2) + symbolic arg1 + symbolic arg2 + INTERFACE_MACRO: + XSINTERFACE_FUNC_BYOFFSET + XSINTERFACE_FUNC_BYOFFSET_set + INTERFACE: + multiply divide + add subtract + +in XSUB section. + +=head2 The INCLUDE: Keyword + +This keyword can be used to pull other files into the XS module. The other +files may have XS code. INCLUDE: can also be used to run a command to +generate the XS code to be pulled into the module. + +The file F contains our C function: + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + +The XS module can use INCLUDE: to pull that file into it. + + INCLUDE: Rpcb1.xsh + +If the parameters to the INCLUDE: keyword are followed by a pipe (C<|>) then +the compiler will interpret the parameters as a command. + + INCLUDE: cat Rpcb1.xsh | + +=head2 The CASE: Keyword + +The CASE: keyword allows an XSUB to have multiple distinct parts with each +part acting as a virtual XSUB. CASE: is greedy and if it is used then all +other XS keywords must be contained within a CASE:. This means nothing may +precede the first CASE: in the XSUB and anything following the last CASE: is +included in that case. + +A CASE: might switch via a parameter of the XSUB, via the C ALIAS: +variable (see L<"The ALIAS: Keyword">), or maybe via the C variable +(see L<"Variable-length Parameter Lists">). The last CASE: becomes the +B case if it is not associated with a conditional. The following +example shows CASE switched via C with a function C +having an alias C. When the function is called as +C its parameters are the usual C<(char *host, time_t *timep)>, +but when the function is called as C its parameters are +reversed, C<(time_t *timep, char *host)>. + + long + rpcb_gettime(a,b) + CASE: ix == 1 + ALIAS: + x_gettime = 1 + INPUT: + # 'a' is timep, 'b' is host + char *b + time_t a = NO_INIT + CODE: + RETVAL = rpcb_gettime( b, &a ); + OUTPUT: + a + RETVAL + CASE: + # 'a' is host, 'b' is timep + char *a + time_t &b = NO_INIT + OUTPUT: + b + RETVAL + +That function can be called with either of the following statements. Note +the different argument lists. + + $status = rpcb_gettime( $host, $timep ); + + $status = x_gettime( $timep, $host ); + +=head2 The & Unary Operator + +The & unary operator is used to tell the compiler that it should dereference +the object when it calls the C function. This is used when a CODE: block is +not used and the object is a not a pointer type (the object is an C or +C but not a C or C). + +The following XSUB will generate incorrect C code. The xsubpp compiler will +turn this into code which calls C with parameters C<(char +*host, time_t timep)>, but the real C wants the C +parameter to be of type C rather than C. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t timep + OUTPUT: + timep + +That problem is corrected by using the C<&> operator. The xsubpp compiler +will now turn this into code which calls C correctly with +parameters C<(char *host, time_t *timep)>. It does this by carrying the +C<&> through, so the function call looks like C. + + bool_t + rpcb_gettime(host,timep) + char *host + time_t &timep + OUTPUT: + timep + +=head2 Inserting Comments and C Preprocessor Directives + +C preprocessor directives are allowed within BOOT:, PREINIT: INIT:, +CODE:, PPCODE:, and CLEANUP: blocks, as well as outside the functions. +Comments are allowed anywhere after the MODULE keyword. The compiler +will pass the preprocessor directives through untouched and will remove +the commented lines. + +Comments can be added to XSUBs by placing a C<#> as the first +non-whitespace of a line. Care should be taken to avoid making the +comment look like a C preprocessor directive, lest it be interpreted as +such. The simplest way to prevent this is to put whitespace in front of +the C<#>. + +If you use preprocessor directives to choose one of two +versions of a function, use + + #if ... version1 + #else /* ... version2 */ + #endif + +and not + + #if ... version1 + #endif + #if ... version2 + #endif + +because otherwise xsubpp will believe that you made a duplicate +definition of the function. Also, put a blank line before the +#else/#endif so it will not be seen as part of the function body. + +=head2 Using XS With C++ + +If a function is defined as a C++ method then it will assume +its first argument is an object pointer. The object pointer +will be stored in a variable called THIS. The object should +have been created by C++ with the new() function and should +be blessed by Perl with the sv_setref_pv() macro. The +blessing of the object by Perl can be handled by a typemap. An example +typemap is shown at the end of this section. + +If the method is defined as static it will call the C++ +function using the class::method() syntax. If the method is not static +the function will be called using the THIS-Emethod() syntax. + +The next examples will use the following C++ class. + + class color { + public: + color(); + ~color(); + int blue(); + void set_blue( int ); + + private: + int c_blue; + }; + +The XSUBs for the blue() and set_blue() methods are defined with the class +name but the parameter for the object (THIS, or "self") is implicit and is +not listed. + + int + color::blue() + + void + color::set_blue( val ) + int val + +Both functions will expect an object as the first parameter. The xsubpp +compiler will call that object C and will use it to call the specified +method. So in the C++ code the blue() and set_blue() methods will be called +in the following manner. + + RETVAL = THIS->blue(); + + THIS->set_blue( val ); + +If the function's name is B then the C++ C function will be +called and C will be given as its parameter. + + void + color::DESTROY() + +The C++ code will call C. + + delete THIS; + +If the function's name is B then the C++ C function will be called +to create a dynamic C++ object. The XSUB will expect the class name, which +will be kept in a variable called C, to be given as the first +argument. + + color * + color::new() + +The C++ code will call C. + + RETVAL = new color(); + +The following is an example of a typemap that could be used for this C++ +example. + + TYPEMAP + color * O_OBJECT + + OUTPUT + # The Perl object is blessed into 'CLASS', which should be a + # char* having the name of the package for the blessing. + O_OBJECT + sv_setref_pv( $arg, CLASS, (void*)$var ); + + INPUT + O_OBJECT + if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) + $var = ($type)SvIV((SV*)SvRV( $arg )); + else{ + warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" ); + XSRETURN_UNDEF; + } + +=head2 Interface Strategy + +When designing an interface between Perl and a C library a straight +translation from C to XS is often sufficient. The interface will often be +very C-like and occasionally nonintuitive, especially when the C function +modifies one of its parameters. In cases where the programmer wishes to +create a more Perl-like interface the following strategy may help to +identify the more critical parts of the interface. + +Identify the C functions which modify their parameters. The XSUBs for +these functions may be able to return lists to Perl, or may be +candidates to return undef or an empty list in case of failure. + +Identify which values are used by only the C and XSUB functions +themselves. If Perl does not need to access the contents of the value +then it may not be necessary to provide a translation for that value +from C to Perl. + +Identify the pointers in the C function parameter lists and return +values. Some pointers can be handled in XS with the & unary operator on +the variable name while others will require the use of the * operator on +the type name. In general it is easier to work with the & operator. + +Identify the structures used by the C functions. In many +cases it may be helpful to use the T_PTROBJ typemap for +these structures so they can be manipulated by Perl as +blessed objects. + +=head2 Perl Objects And C Structures + +When dealing with C structures one should select either +B or B for the XS type. Both types are +designed to handle pointers to complex objects. The +T_PTRREF type will allow the Perl object to be unblessed +while the T_PTROBJ type requires that the object be blessed. +By using T_PTROBJ one can achieve a form of type-checking +because the XSUB will attempt to verify that the Perl object +is of the expected type. + +The following XS code shows the getnetconfigent() function which is used +with ONC+ TIRPC. The getnetconfigent() function will return a pointer to a +C structure and has the C prototype shown below. The example will +demonstrate how the C pointer will become a Perl reference. Perl will +consider this reference to be a pointer to a blessed object and will +attempt to call a destructor for the object. A destructor will be +provided in the XS source to free the memory used by getnetconfigent(). +Destructors in XS can be created by specifying an XSUB function whose name +ends with the word B. XS destructors can be used to free memory +which may have been malloc'd by another XSUB. + + struct netconfig *getnetconfigent(const char *netid); + +A C will be created for C. The Perl +object will be blessed in a class matching the name of the C +type, with the tag C appended, and the name should not +have embedded spaces if it will be a Perl package name. The +destructor will be placed in a class corresponding to the +class of the object and the PREFIX keyword will be used to +trim the name to the word DESTROY as Perl will expect. + + typedef struct netconfig Netconfig; + + MODULE = RPC PACKAGE = RPC + + Netconfig * + getnetconfigent(netid) + char *netid + + MODULE = RPC PACKAGE = NetconfigPtr PREFIX = rpcb_ + + void + rpcb_DESTROY(netconf) + Netconfig *netconf + CODE: + printf("Now in NetconfigPtr::DESTROY\n"); + free( netconf ); + +This example requires the following typemap entry. Consult the typemap +section for more information about adding new typemaps for an extension. + + TYPEMAP + Netconfig * T_PTROBJ + +This example will be used with the following Perl statements. + + use RPC; + $netconf = getnetconfigent("udp"); + +When Perl destroys the object referenced by $netconf it will send the +object to the supplied XSUB DESTROY function. Perl cannot determine, and +does not care, that this object is a C struct and not a Perl object. In +this sense, there is no difference between the object created by the +getnetconfigent() XSUB and an object created by a normal Perl subroutine. + +=head2 The Typemap + +The typemap is a collection of code fragments which are used by the B +compiler to map C function parameters and values to Perl values. The +typemap file may consist of three sections labeled C, C, and +C. The INPUT section tells the compiler how to translate Perl values +into variables of certain C types. The OUTPUT section tells the compiler +how to translate the values from certain C types into values Perl can +understand. The TYPEMAP section tells the compiler which of the INPUT and +OUTPUT code fragments should be used to map a given C type to a Perl value. +Each of the sections of the typemap must be preceded by one of the TYPEMAP, +INPUT, or OUTPUT keywords. + +The default typemap in the C directory of the Perl source contains many +useful types which can be used by Perl extensions. Some extensions define +additional typemaps which they keep in their own directory. These +additional typemaps may reference INPUT and OUTPUT maps in the main +typemap. The B compiler will allow the extension's own typemap to +override any mappings which are in the default typemap. + +Most extensions which require a custom typemap will need only the TYPEMAP +section of the typemap file. The custom typemap used in the +getnetconfigent() example shown earlier demonstrates what may be the typical +use of extension typemaps. That typemap is used to equate a C structure +with the T_PTROBJ typemap. The typemap used by getnetconfigent() is shown +here. Note that the C type is separated from the XS type with a tab and +that the C unary operator C<*> is considered to be a part of the C type name. + + TYPEMAP + Netconfig *T_PTROBJ + +Here's a more complicated example: suppose that you wanted C to be blessed into the class C. One way to do +this is to use underscores (_) to separate package names, as follows: + + typedef struct netconfig * Net_Config; + +And then provide a typemap entry C that maps underscores to +double-colons (::), and declare C to be of that type: + + + TYPEMAP + Net_Config T_PTROBJ_SPECIAL + + INPUT + T_PTROBJ_SPECIAL + if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not of type ${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\") + + OUTPUT + T_PTROBJ_SPECIAL + sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\", + (void*)$var); + +The INPUT and OUTPUT sections substitute underscores for double-colons +on the fly, giving the desired effect. This example demonstrates some +of the power and versatility of the typemap facility. + +=head1 EXAMPLES + +File C: Interface to some ONC+ RPC bind library functions. + + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + + #include + + typedef struct netconfig Netconfig; + + MODULE = RPC PACKAGE = RPC + + SV * + rpcb_gettime(host="localhost") + char *host + PREINIT: + time_t timep; + CODE: + ST(0) = sv_newmortal(); + if( rpcb_gettime( host, &timep ) ) + sv_setnv( ST(0), (double)timep ); + + Netconfig * + getnetconfigent(netid="udp") + char *netid + + MODULE = RPC PACKAGE = NetconfigPtr PREFIX = rpcb_ + + void + rpcb_DESTROY(netconf) + Netconfig *netconf + CODE: + printf("NetconfigPtr::DESTROY\n"); + free( netconf ); + +File C: Custom typemap for RPC.xs. + + TYPEMAP + Netconfig * T_PTROBJ + +File C: Perl module for the RPC extension. + + package RPC; + + require Exporter; + require DynaLoader; + @ISA = qw(Exporter DynaLoader); + @EXPORT = qw(rpcb_gettime getnetconfigent); + + bootstrap RPC; + 1; + +File C: Perl test program for the RPC extension. + + use RPC; + + $netconf = getnetconfigent(); + $a = rpcb_gettime(); + print "time = $a\n"; + print "netconf = $netconf\n"; + + $netconf = getnetconfigent("tcp"); + $a = rpcb_gettime("poplar"); + print "time = $a\n"; + print "netconf = $netconf\n"; + + +=head1 XS VERSION + +This document covers features supported by C 1.935. + +=head1 AUTHOR + +Dean Roehrich > +Jul 8, 1996 diff --git a/contrib/perl5/pod/perlxstut.pod b/contrib/perl5/pod/perlxstut.pod new file mode 100644 index 00000000000..867d42a8c24 --- /dev/null +++ b/contrib/perl5/pod/perlxstut.pod @@ -0,0 +1,739 @@ +=head1 NAME + +perlXStut - Tutorial for XSUBs + +=head1 DESCRIPTION + +This tutorial will educate the reader on the steps involved in creating +a Perl extension. The reader is assumed to have access to L and +L. + +This tutorial starts with very simple examples and becomes more complex, +with each new example adding new features. Certain concepts may not be +completely explained until later in the tutorial to ease the +reader slowly into building extensions. + +=head2 VERSION CAVEAT + +This tutorial tries hard to keep up with the latest development versions +of Perl. This often means that it is sometimes in advance of the latest +released version of Perl, and that certain features described here might +not work on earlier versions. This section will keep track of when various +features were added to Perl 5. + +=over 4 + +=item * + +In versions of Perl 5.002 prior to the gamma version, the test script +in Example 1 will not function properly. You need to change the "use +lib" line to read: + + use lib './blib'; + +=item * + +In versions of Perl 5.002 prior to version beta 3, the line in the .xs file +about "PROTOTYPES: DISABLE" will cause a compiler error. Simply remove that +line from the file. + +=item * + +In versions of Perl 5.002 prior to version 5.002b1h, the test.pl file was not +automatically created by h2xs. This means that you cannot say "make test" +to run the test script. You will need to add the following line before the +"use extension" statement: + + use lib './blib'; + +=item * + +In versions 5.000 and 5.001, instead of using the above line, you will need +to use the following line: + + BEGIN { unshift(@INC, "./blib") } + +=item * + +This document assumes that the executable named "perl" is Perl version 5. +Some systems may have installed Perl version 5 as "perl5". + +=back + +=head2 DYNAMIC VERSUS STATIC + +It is commonly thought that if a system does not have the capability to +load a library dynamically, you cannot build XSUBs. This is incorrect. +You I build them, but you must link the XSUB's subroutines with the +rest of Perl, creating a new executable. This situation is similar to +Perl 4. + +This tutorial can still be used on such a system. The XSUB build mechanism +will check the system and build a dynamically-loadable library if possible, +or else a static library and then, optionally, a new statically-linked +executable with that static library linked in. + +Should you wish to build a statically-linked executable on a system which +can dynamically load libraries, you may, in all the following examples, +where the command "make" with no arguments is executed, run the command +"make perl" instead. + +If you have generated such a statically-linked executable by choice, then +instead of saying "make test", you should say "make test_static". On systems +that cannot build dynamically-loadable libraries at all, simply saying "make +test" is sufficient. + +=head2 EXAMPLE 1 + +Our first extension will be very simple. When we call the routine in the +extension, it will print out a well-known message and return. + +Run C. This creates a directory named Mytest, possibly under +ext/ if that directory exists in the current working directory. Several files +will be created in the Mytest dir, including MANIFEST, Makefile.PL, Mytest.pm, +Mytest.xs, test.pl, and Changes. + +The MANIFEST file contains the names of all the files created. + +The file Makefile.PL should look something like this: + + use ExtUtils::MakeMaker; + # See lib/ExtUtils/MakeMaker.pm for details of how to influence + # the contents of the Makefile that is written. + WriteMakefile( + 'NAME' => 'Mytest', + 'VERSION_FROM' => 'Mytest.pm', # finds $VERSION + 'LIBS' => [''], # e.g., '-lm' + 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' + 'INC' => '', # e.g., '-I/usr/include/other' + ); + +The file Mytest.pm should start with something like this: + + package Mytest; + + require Exporter; + require DynaLoader; + + @ISA = qw(Exporter DynaLoader); + # Items to export into callers namespace by default. Note: do not export + # names by default without a very good reason. Use EXPORT_OK instead. + # Do not simply export all your public functions/methods/constants. + @EXPORT = qw( + + ); + $VERSION = '0.01'; + + bootstrap Mytest $VERSION; + + # Preloaded methods go here. + + # Autoload methods go after __END__, and are processed by the autosplit program. + + 1; + __END__ + # Below is the stub of documentation for your module. You better edit it! + +And the Mytest.xs file should look something like this: + + #ifdef __cplusplus + extern "C" { + #endif + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" + #ifdef __cplusplus + } + #endif + + PROTOTYPES: DISABLE + + MODULE = Mytest PACKAGE = Mytest + +Let's edit the .xs file by adding this to the end of the file: + + void + hello() + CODE: + printf("Hello, world!\n"); + +Now we'll run "perl Makefile.PL". This will create a real Makefile, +which make needs. Its output looks something like: + + % perl Makefile.PL + Checking if your kit is complete... + Looks good + Writing Makefile for Mytest + % + +Now, running make will produce output that looks something like this +(some long lines shortened for clarity): + + % make + umask 0 && cp Mytest.pm ./blib/Mytest.pm + perl xsubpp -typemap typemap Mytest.xs >Mytest.tc && mv Mytest.tc Mytest.c + cc -c Mytest.c + Running Mkbootstrap for Mytest () + chmod 644 Mytest.bs + LD_RUN_PATH="" ld -o ./blib/PA-RISC1.1/auto/Mytest/Mytest.sl -b Mytest.o + chmod 755 ./blib/PA-RISC1.1/auto/Mytest/Mytest.sl + cp Mytest.bs ./blib/PA-RISC1.1/auto/Mytest/Mytest.bs + chmod 644 ./blib/PA-RISC1.1/auto/Mytest/Mytest.bs + +Now, although there is already a test.pl template ready for us, for this +example only, we'll create a special test script. Create a file called hello +that looks like this: + + #! /opt/perl5/bin/perl + + use ExtUtils::testlib; + + use Mytest; + + Mytest::hello(); + +Now we run the script and we should see the following output: + + % perl hello + Hello, world! + % + +=head2 EXAMPLE 2 + +Now let's add to our extension a subroutine that will take a single argument +and return 1 if the argument is even, 0 if the argument is odd. + +Add the following to the end of Mytest.xs: + + int + is_even(input) + int input + CODE: + RETVAL = (input % 2 == 0); + OUTPUT: + RETVAL + +There does not need to be white space at the start of the "int input" line, +but it is useful for improving readability. The semi-colon at the end of +that line is also optional. + +Any white space may be between the "int" and "input". It is also okay for +the four lines starting at the "CODE:" line to not be indented. However, +for readability purposes, it is suggested that you indent them 8 spaces +(or one normal tab stop). + +Now rerun make to rebuild our new shared library. + +Now perform the same steps as before, generating a Makefile from the +Makefile.PL file, and running make. + +To test that our extension works, we now need to look at the +file test.pl. This file is set up to imitate the same kind of testing +structure that Perl itself has. Within the test script, you perform a +number of tests to confirm the behavior of the extension, printing "ok" +when the test is correct, "not ok" when it is not. Change the print +statement in the BEGIN block to print "1..4", and add the following code +to the end of the file: + + print &Mytest::is_even(0) == 1 ? "ok 2" : "not ok 2", "\n"; + print &Mytest::is_even(1) == 0 ? "ok 3" : "not ok 3", "\n"; + print &Mytest::is_even(2) == 1 ? "ok 4" : "not ok 4", "\n"; + +We will be calling the test script through the command "make test". You +should see output that looks something like this: + + % make test + PERL_DL_NONLAZY=1 /opt/perl5.002b2/bin/perl (lots of -I arguments) test.pl + 1..4 + ok 1 + ok 2 + ok 3 + ok 4 + % + +=head2 WHAT HAS GONE ON? + +The program h2xs is the starting point for creating extensions. In later +examples we'll see how we can use h2xs to read header files and generate +templates to connect to C routines. + +h2xs creates a number of files in the extension directory. The file +Makefile.PL is a perl script which will generate a true Makefile to build +the extension. We'll take a closer look at it later. + +The files EextensionE.pm and EextensionE.xs contain the meat +of the extension. +The .xs file holds the C routines that make up the extension. The .pm file +contains routines that tell Perl how to load your extension. + +Generating and invoking the Makefile created a directory blib (which stands +for "build library") in the current working directory. This directory will +contain the shared library that we will build. Once we have tested it, we +can install it into its final location. + +Invoking the test script via "make test" did something very important. It +invoked perl with all those C<-I> arguments so that it could find the various +files that are part of the extension. + +It is I important that while you are still testing extensions that +you use "make test". If you try to run the test script all by itself, you +will get a fatal error. + +Another reason it is important to use "make test" to run your test script +is that if you are testing an upgrade to an already-existing version, using +"make test" insures that you use your new extension, not the already-existing +version. + +When Perl sees a C, it searches for a file with the same name +as the use'd extension that has a .pm suffix. If that file cannot be found, +Perl dies with a fatal error. The default search path is contained in the +@INC array. + +In our case, Mytest.pm tells perl that it will need the Exporter and Dynamic +Loader extensions. It then sets the @ISA and @EXPORT arrays and the $VERSION +scalar; finally it tells perl to bootstrap the module. Perl will call its +dynamic loader routine (if there is one) and load the shared library. + +The two arrays that are set in the .pm file are very important. The @ISA +array contains a list of other packages in which to search for methods (or +subroutines) that do not exist in the current package. The @EXPORT array +tells Perl which of the extension's routines should be placed into the +calling package's namespace. + +It's important to select what to export carefully. Do NOT export method names +and do NOT export anything else I without a good reason. + +As a general rule, if the module is trying to be object-oriented then don't +export anything. If it's just a collection of functions then you can export +any of the functions via another array, called @EXPORT_OK. + +See L for more information. + +The $VERSION variable is used to ensure that the .pm file and the shared +library are "in sync" with each other. Any time you make changes to +the .pm or .xs files, you should increment the value of this variable. + +=head2 WRITING GOOD TEST SCRIPTS + +The importance of writing good test scripts cannot be overemphasized. You +should closely follow the "ok/not ok" style that Perl itself uses, so that +it is very easy and unambiguous to determine the outcome of each test case. +When you find and fix a bug, make sure you add a test case for it. + +By running "make test", you ensure that your test.pl script runs and uses +the correct version of your extension. If you have many test cases, you +might want to copy Perl's test style. Create a directory named "t", and +ensure all your test files end with the suffix ".t". The Makefile will +properly run all these test files. + + +=head2 EXAMPLE 3 + +Our third extension will take one argument as its input, round off that +value, and set the I to the rounded value. + +Add the following to the end of Mytest.xs: + + void + round(arg) + double arg + CODE: + if (arg > 0.0) { + arg = floor(arg + 0.5); + } else if (arg < 0.0) { + arg = ceil(arg - 0.5); + } else { + arg = 0.0; + } + OUTPUT: + arg + +Edit the Makefile.PL file so that the corresponding line looks like this: + + 'LIBS' => ['-lm'], # e.g., '-lm' + +Generate the Makefile and run make. Change the BEGIN block to print out +"1..9" and add the following to test.pl: + + $i = -1.5; &Mytest::round($i); print $i == -2.0 ? "ok 5" : "not ok 5", "\n"; + $i = -1.1; &Mytest::round($i); print $i == -1.0 ? "ok 6" : "not ok 6", "\n"; + $i = 0.0; &Mytest::round($i); print $i == 0.0 ? "ok 7" : "not ok 7", "\n"; + $i = 0.5; &Mytest::round($i); print $i == 1.0 ? "ok 8" : "not ok 8", "\n"; + $i = 1.2; &Mytest::round($i); print $i == 1.0 ? "ok 9" : "not ok 9", "\n"; + +Running "make test" should now print out that all nine tests are okay. + +You might be wondering if you can round a constant. To see what happens, add +the following line to test.pl temporarily: + + &Mytest::round(3); + +Run "make test" and notice that Perl dies with a fatal error. Perl won't let +you change the value of constants! + +=head2 WHAT'S NEW HERE? + +Two things are new here. First, we've made some changes to Makefile.PL. +In this case, we've specified an extra library to link in, the math library +libm. We'll talk later about how to write XSUBs that can call every routine +in a library. + +Second, the value of the function is being passed back not as the function's +return value, but through the same variable that was passed into the function. + +=head2 INPUT AND OUTPUT PARAMETERS + +You specify the parameters that will be passed into the XSUB just after you +declare the function return value and name. Each parameter line starts with +optional white space, and may have an optional terminating semicolon. + +The list of output parameters occurs after the OUTPUT: directive. The use +of RETVAL tells Perl that you wish to send this value back as the return +value of the XSUB function. In Example 3, the value we wanted returned was +contained in the same variable we passed in, so we listed it (and not RETVAL) +in the OUTPUT: section. + +=head2 THE XSUBPP COMPILER + +The compiler xsubpp takes the XS code in the .xs file and converts it into +C code, placing it in a file whose suffix is .c. The C code created makes +heavy use of the C functions within Perl. + +=head2 THE TYPEMAP FILE + +The xsubpp compiler uses rules to convert from Perl's data types (scalar, +array, etc.) to C's data types (int, char *, etc.). These rules are stored +in the typemap file ($PERLLIB/ExtUtils/typemap). This file is split into +three parts. + +The first part attempts to map various C data types to a coded flag, which +has some correspondence with the various Perl types. The second part contains +C code which xsubpp uses for input parameters. The third part contains C +code which xsubpp uses for output parameters. We'll talk more about the +C code later. + +Let's now take a look at a portion of the .c file created for our extension. + + XS(XS_Mytest_round) + { + dXSARGS; + if (items != 1) + croak("Usage: Mytest::round(arg)"); + { + double arg = (double)SvNV(ST(0)); /* XXXXX */ + if (arg > 0.0) { + arg = floor(arg + 0.5); + } else if (arg < 0.0) { + arg = ceil(arg - 0.5); + } else { + arg = 0.0; + } + sv_setnv(ST(0), (double)arg); /* XXXXX */ + } + XSRETURN(1); + } + +Notice the two lines marked with "XXXXX". If you check the first section of +the typemap file, you'll see that doubles are of type T_DOUBLE. In the +INPUT section, an argument that is T_DOUBLE is assigned to the variable +arg by calling the routine SvNV on something, then casting it to double, +then assigned to the variable arg. Similarly, in the OUTPUT section, +once arg has its final value, it is passed to the sv_setnv function to +be passed back to the calling subroutine. These two functions are explained +in L; we'll talk more later about what that "ST(0)" means in the +section on the argument stack. + +=head2 WARNING + +In general, it's not a good idea to write extensions that modify their input +parameters, as in Example 3. However, to accommodate better calling +pre-existing C routines, which often do modify their input parameters, +this behavior is tolerated. The next example will show how to do this. + +=head2 EXAMPLE 4 + +In this example, we'll now begin to write XSUBs that will interact with +predefined C libraries. To begin with, we will build a small library of +our own, then let h2xs write our .pm and .xs files for us. + +Create a new directory called Mytest2 at the same level as the directory +Mytest. In the Mytest2 directory, create another directory called mylib, +and cd into that directory. + +Here we'll create some files that will generate a test library. These will +include a C source file and a header file. We'll also create a Makefile.PL +in this directory. Then we'll make sure that running make at the Mytest2 +level will automatically run this Makefile.PL file and the resulting Makefile. + +In the testlib directory, create a file mylib.h that looks like this: + + #define TESTVAL 4 + + extern double foo(int, long, const char*); + +Also create a file mylib.c that looks like this: + + #include + #include "./mylib.h" + + double + foo(a, b, c) + int a; + long b; + const char * c; + { + return (a + b + atof(c) + TESTVAL); + } + +And finally create a file Makefile.PL that looks like this: + + use ExtUtils::MakeMaker; + $Verbose = 1; + WriteMakefile( + NAME => 'Mytest2::mylib', + SKIP => [qw(all static static_lib dynamic dynamic_lib)], + clean => {'FILES' => 'libmylib$(LIB_EXT)'}, + ); + + + sub MY::top_targets { + ' + all :: static + + static :: libmylib$(LIB_EXT) + + libmylib$(LIB_EXT): $(O_FILES) + $(AR) cr libmylib$(LIB_EXT) $(O_FILES) + $(RANLIB) libmylib$(LIB_EXT) + + '; + } + +We will now create the main top-level Mytest2 files. Change to the directory +above Mytest2 and run the following command: + + % h2xs -O -n Mytest2 ./Mytest2/mylib/mylib.h + +This will print out a warning about overwriting Mytest2, but that's okay. +Our files are stored in Mytest2/mylib, and will be untouched. + +The normal Makefile.PL that h2xs generates doesn't know about the mylib +directory. We need to tell it that there is a subdirectory and that we +will be generating a library in it. Let's add the following key-value +pair to the WriteMakefile call: + + 'MYEXTLIB' => 'mylib/libmylib$(LIB_EXT)', + +and a new replacement subroutine too: + + sub MY::postamble { + ' + $(MYEXTLIB): mylib/Makefile + cd mylib && $(MAKE) $(PASTHRU) + '; + } + +(Note: Most makes will require that there be a tab character that indents +the line C, similarly for the Makefile in the +subdirectory.) + +Let's also fix the MANIFEST file so that it accurately reflects the contents +of our extension. The single line that says "mylib" should be replaced by +the following three lines: + + mylib/Makefile.PL + mylib/mylib.c + mylib/mylib.h + +To keep our namespace nice and unpolluted, edit the .pm file and change +the lines setting @EXPORT to @EXPORT_OK (there are two: one in the line +beginning "use vars" and one setting the array itself). Finally, in the +.xs file, edit the #include line to read: + + #include "mylib/mylib.h" + +And also add the following function definition to the end of the .xs file: + + double + foo(a,b,c) + int a + long b + const char * c + OUTPUT: + RETVAL + +Now we also need to create a typemap file because the default Perl doesn't +currently support the const char * type. Create a file called typemap and +place the following in it: + + const char * T_PV + +Now run perl on the top-level Makefile.PL. Notice that it also created a +Makefile in the mylib directory. Run make and see that it does cd into +the mylib directory and run make in there as well. + +Now edit the test.pl script and change the BEGIN block to print "1..4", +and add the following lines to the end of the script: + + print &Mytest2::foo(1, 2, "Hello, world!") == 7 ? "ok 2\n" : "not ok 2\n"; + print &Mytest2::foo(1, 2, "0.0") == 7 ? "ok 3\n" : "not ok 3\n"; + print abs(&Mytest2::foo(0, 0, "-3.4") - 0.6) <= 0.01 ? "ok 4\n" : "not ok 4\n"; + +(When dealing with floating-point comparisons, it is often useful not to check +for equality, but rather the difference being below a certain epsilon factor, +0.01 in this case) + +Run "make test" and all should be well. + +=head2 WHAT HAS HAPPENED HERE? + +Unlike previous examples, we've now run h2xs on a real include file. This +has caused some extra goodies to appear in both the .pm and .xs files. + +=over 4 + +=item * + +In the .xs file, there's now a #include declaration with the full path to +the mylib.h header file. + +=item * + +There's now some new C code that's been added to the .xs file. The purpose +of the C routine is to make the values that are #define'd in the +header file available to the Perl script (in this case, by calling +C<&main::TESTVAL>). There's also some XS code to allow calls to the +C routine. + +=item * + +The .pm file has exported the name TESTVAL in the @EXPORT array. This +could lead to name clashes. A good rule of thumb is that if the #define +is going to be used by only the C routines themselves, and not by the user, +they should be removed from the @EXPORT array. Alternately, if you don't +mind using the "fully qualified name" of a variable, you could remove most +or all of the items in the @EXPORT array. + +=item * + +If our include file contained #include directives, these would not be +processed at all by h2xs. There is no good solution to this right now. + +=back + +We've also told Perl about the library that we built in the mylib +subdirectory. That required the addition of only the MYEXTLIB variable +to the WriteMakefile call and the replacement of the postamble subroutine +to cd into the subdirectory and run make. The Makefile.PL for the +library is a bit more complicated, but not excessively so. Again we +replaced the postamble subroutine to insert our own code. This code +specified simply that the library to be created here was a static +archive (as opposed to a dynamically loadable library) and provided the +commands to build it. + +=head2 SPECIFYING ARGUMENTS TO XSUBPP + +With the completion of Example 4, we now have an easy way to simulate some +real-life libraries whose interfaces may not be the cleanest in the world. +We shall now continue with a discussion of the arguments passed to the +xsubpp compiler. + +When you specify arguments in the .xs file, you are really passing three +pieces of information for each one listed. The first piece is the order +of that argument relative to the others (first, second, etc). The second +is the type of argument, and consists of the type declaration of the +argument (e.g., int, char*, etc). The third piece is the exact way in +which the argument should be used in the call to the library function +from this XSUB. This would mean whether or not to place a "&" before +the argument or not, meaning the argument expects to be passed the address +of the specified data type. + +There is a difference between the two arguments in this hypothetical function: + + int + foo(a,b) + char &a + char * b + +The first argument to this function would be treated as a char and assigned +to the variable a, and its address would be passed into the function foo. +The second argument would be treated as a string pointer and assigned to the +variable b. The I of b would be passed into the function foo. The +actual call to the function foo that xsubpp generates would look like this: + + foo(&a, b); + +Xsubpp will identically parse the following function argument lists: + + char &a + char&a + char & a + +However, to help ease understanding, it is suggested that you place a "&" +next to the variable name and away from the variable type), and place a +"*" near the variable type, but away from the variable name (as in the +complete example above). By doing so, it is easy to understand exactly +what will be passed to the C function -- it will be whatever is in the +"last column". + +You should take great pains to try to pass the function the type of variable +it wants, when possible. It will save you a lot of trouble in the long run. + +=head2 THE ARGUMENT STACK + +If we look at any of the C code generated by any of the examples except +example 1, you will notice a number of references to ST(n), where n is +usually 0. The "ST" is actually a macro that points to the n'th argument +on the argument stack. ST(0) is thus the first argument passed to the +XSUB, ST(1) is the second argument, and so on. + +When you list the arguments to the XSUB in the .xs file, that tells xsubpp +which argument corresponds to which of the argument stack (i.e., the first +one listed is the first argument, and so on). You invite disaster if you +do not list them in the same order as the function expects them. + +=head2 EXTENDING YOUR EXTENSION + +Sometimes you might want to provide some extra methods or subroutines +to assist in making the interface between Perl and your extension simpler +or easier to understand. These routines should live in the .pm file. +Whether they are automatically loaded when the extension itself is loaded +or loaded only when called depends on where in the .pm file the subroutine +definition is placed. + +=head2 DOCUMENTING YOUR EXTENSION + +There is absolutely no excuse for not documenting your extension. +Documentation belongs in the .pm file. This file will be fed to pod2man, +and the embedded documentation will be converted to the manpage format, +then placed in the blib directory. It will be copied to Perl's man +page directory when the extension is installed. + +You may intersperse documentation and Perl code within the .pm file. +In fact, if you want to use method autoloading, you must do this, +as the comment inside the .pm file explains. + +See L for more information about the pod format. + +=head2 INSTALLING YOUR EXTENSION + +Once your extension is complete and passes all its tests, installing it +is quite simple: you simply run "make install". You will either need +to have write permission into the directories where Perl is installed, +or ask your system administrator to run the make for you. + +=head2 SEE ALSO + +For more information, consult L, L, L, +and L. + +=head2 Author + +Jeff Okamoto > + +Reviewed and assisted by Dean Roehrich, Ilya Zakharevich, Andreas Koenig, +and Tim Bunce. + +=head2 Last Changed + +1996/7/10 diff --git a/contrib/perl5/pod/pod2html.PL b/contrib/perl5/pod/pod2html.PL new file mode 100644 index 00000000000..4eec29c26bd --- /dev/null +++ b/contrib/perl5/pod/pod2html.PL @@ -0,0 +1,183 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; +=pod + +=head1 NAME + +pod2html - convert .pod files to .html files + +=head1 SYNOPSIS + + pod2html --help --htmlroot= --infile= --outfile= + --podpath=:...: --podroot= + --libpods=:...: --recurse --norecurse --verbose + --index --noindex --title= + +=head1 DESCRIPTION + +Converts files from pod format (see L) to HTML format. + +=head1 ARGUMENTS + +pod2html takes the following arguments: + +=over 4 + +=item help + + --help + +Displays the usage message. + +=item htmlroot + + --htmlroot=name + +Sets the base URL for the HTML files. When cross-references are made, +the HTML root is prepended to the URL. + +=item infile + + --infile=name + +Specify the pod file to convert. Input is taken from STDIN if no +infile is specified. + +=item outfile + + --outfile=name + +Specify the HTML file to create. Output goes to STDOUT if no outfile +is specified. + +=item podroot + + --podroot=name + +Specify the base directory for finding library pods. + +=item podpath + + --podpath=name:...:name + +Specify which subdirectories of the podroot contain pod files whose +HTML converted forms can be linked-to in cross-references. + +=item libpods + + --libpods=name:...:name + +List of page names (eg, "perlfunc") which contain linkable C<=item>s. + +=item netscape + + --netscape + +Use Netscape HTML directives when applicable. + +=item nonetscape + + --nonetscape + +Do not use Netscape HTML directives (default). + +=item index + + --index + +Generate an index at the top of the HTML file (default behaviour). + +=item noindex + + --noindex + +Do not generate an index at the top of the HTML file. + + +=item recurse + + --recurse + +Recurse into subdirectories specified in podpath (default behaviour). + +=item norecurse + + --norecurse + +Do not recurse into subdirectories specified in podpath. + +=item title + + --title=title + +Specify the title of the resulting HTML file. + +=item verbose + + --verbose + +Display progress messages. + +=back + +=head1 AUTHOR + +Tom Christiansen, Etchrist@perl.comE. + +=head1 BUGS + +See L for a list of known bugs in the translator. + +=head1 SEE ALSO + +L, L + +=head1 COPYRIGHT + +This program is distributed under the Artistic License. + +=cut + +use Pod::Html; + +pod2html @ARGV; +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/contrib/perl5/pod/pod2latex.PL b/contrib/perl5/pod/pod2latex.PL new file mode 100644 index 00000000000..feed98e923d --- /dev/null +++ b/contrib/perl5/pod/pod2latex.PL @@ -0,0 +1,708 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; +# +# pod2latex, version 1.1 +# by Taro Kawagish (kawagish@imslab.co.jp), Jan 11, 1995. +# +# pod2latex filters Perl pod documents to LaTeX documents. +# +# What pod2latex does: +# 1. Pod file 'perl_doc_entry.pod' is filtered to 'perl_doc_entry.tex'. +# 2. Indented paragraphs are translated into +# '\begin{verbatim} ... \end{verbatim}'. +# 3. '=head1 heading' command is translated into '\section{heading}' +# 4. '=head2 heading' command is translated into '\subsection*{heading}' +# 5. '=over N' command is translated into +# '\begin{itemize}' if following =item starts with *, +# '\begin{enumerate}' if following =item starts with 1., +# '\begin{description}' if else. +# (indentation level N is ignored.) +# 6. '=item * heading' command is translated into '\item heading', +# '=item 1. heading' command is translated into '\item heading', +# '=item heading' command(other) is translated into '\item[heading]'. +# 7. '=back' command is translated into +# '\end{itemize}' if started with '\begin{itemize}', +# '\end{enumerate}' if started with '\begin{enumerate}', +# '\end{description}' if started with '\begin{description}'. +# 8. other paragraphs are translated into strings with TeX special characters +# escaped. +# 9. In heading text, and other paragraphs, the following translation of pod +# quotes are done, and then TeX special characters are escaped after that. +# I to {\em text\/}, +# B to {\bf text}, +# S to text1, +# where text1 is a string with blank characters replaced with ~, +# C to {\tt text2}, +# where text2 is a string with TeX special characters escaped to +# obtain a literal printout, +# E (HTML escape) to TeX escaped string, +# L to referencing string as is done by pod2man, +# F to {\em file\/}, +# Z<> to a null string, +# 10. those headings are indexed: +# '=head1 heading' => \section{heading}\index{heading} +# '=head2 heading' => \subsection*{heading}\index{heading} +# only when heading does not match frequent patterns such as +# DESCRIPTION, DIAGNOSTICS,... +# '=item heading' => \item{heading}\index{heading} +# +# Usage: +# pod2latex perl_doc_entry.pod +# this will write to a file 'perl_doc_entry.tex'. +# +# To LaTeX: +# The following commands need to be defined in the preamble of the LaTeX +# document: +# \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}} +# \def\underscore{\leavevmode\kern.04em\vbox{\hrule width 0.4em height 0.3pt}} +# and \parindent should be set zero: +# \setlength{\parindent}{0pt} +# +# Note: +# This script was written modifing pod2man. +# +# Bug: +# If HTML escapes E other than E,E,E,E are used +# in C<>, translation will produce wrong character strings. +# Translation of HTML escapes of various European accents might be wrong. + + +$/ = ""; # record separator is blank lines +# TeX special characters. +##$tt_ables = "!@*()-=+|;:'\"`,./?<>"; +$backslash_escapables = "#\$%&{}_"; +$backslash_escapables2 = "#\$%&{}"; # except _ +##$nonverbables = "^\\~"; +##$bracketesc = "[]"; +##@tex_verb_fences = unpack("aaaaaaaaa","|#@!*+?:;"); + +@head1_freq_patterns # =head1 patterns which need not be index'ed + = ("AUTHOR","Author","BUGS","DATE","DESCRIPTION","DIAGNOSTICS", + "ENVIRONMENT","EXAMPLES","FILES","INTRODUCTION","NAME","NOTE", + "SEE ALSO","SYNOPSIS","WARNING"); + +$indent = 0; + +# parse the pods, produce LaTeX. + +open(POD,"<$ARGV[0]") || die "cant open $ARGV[0]"; +($pod=$ARGV[0]) =~ s/\.pod$//; +open(LATEX,">$pod.tex"); +&do_hdr(); + +$cutting = 1; +$begun = ""; +while () { + if ($cutting) { + next unless /^=/; + $cutting = 0; + } + if ($begun) { + if (/^=end\s+$begun/) { + $begun = ""; + } + elsif ($begun =~ /^(tex|latex)$/) { + print LATEX $_; + } + next; + } + chop; + length || (print LATEX "\n") && next; + + # translate indented lines as a verabatim paragraph + if (/^\s/) { + @lines = split(/\n/); + print LATEX "\\begin{verbatim}\n"; + for (@lines) { + 1 while s + {^( [^\t]* ) \t ( \t* ) } + { $1 . ' ' x (8 - (length($1)%8) + 8*(length($2))) }ex; + print LATEX $_,"\n"; + } + print LATEX "\\end{verbatim}\n"; + next; + } + + if (/^=for\s+(\S+)\s*/s) { + if ($1 eq "tex" or $1 eq "latex") { + print LATEX $',"\n"; + } else { + # ignore unknown for + } + next; + } + elsif (/^=begin\s+(\S+)\s*/s) { + $begun = $1; + if ($1 eq "tex" or $1 eq "latex") { + print LATEX $'."\n"; + } + next; + } + + # preserve '=item' line with pod quotes as they are. + if (/^=item/) { + ($bareitem = $_) =~ s/^=item\s*//; + } + + # check for things that'll hosed our noremap scheme; affects $_ + &init_noremap(); + + # expand strings "func()" as pod quotes. + if (!/^=item/) { + # first hide pod escapes. + # escaped strings are mapped into the ones with the MSB's on. + s/([A-Z]<[^<>]*>)/noremap($1)/ge; + + # func() is a reference to a perl function + s{\b([:\w]+\(\))}{I<$1>}g; + # func(n) is a reference to a man page + s{(\w+)(\([^\s,\051]+\))}{I<$1>$2}g; + # convert simple variable references +# s/([\$\@%][\w:]+)/C<$1>/g; +# s/\$[\w:]+\[[0-9]+\]/C<$&>/g; + + if (m{ ([\-\w]+\([^\051]*?[\@\$,][^\051]*?\)) + }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) + { + warn "``$1'' should be a [LCI]<$1> ref"; + } + while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { + warn "``$1'' should be [CB]<$1> ref"; + } + + # put back pod quotes so we get the inside of <> processed; + $_ = &clear_noremap($_); + } + + + # process TeX special characters + + # First hide HTML quotes E<> since they can be included in C<>. + s/(E<[^<>]+>)/noremap($1)/ge; + + # Then hide C<> type literal quotes. + # String inside of C<> will later be expanded into {\tt ..} strings + # with TeX special characters escaped as needed. + s/(C<[^<>]*>)/&noremap($1)/ge; + + # Next escape TeX special characters including other pod quotes B< >,... + # + # NOTE: s/re/&func($str)/e evaluates $str just once in perl5. + # (in perl4 evaluation takes place twice before getting passed to func().) + + # - hyphen => --- + s/(\S+)(\s+)-+(\s+)(\S+)/"$1".&noremap(" --- ")."$4"/ge; + # '-', '--', "-" => '{\tt -}', '{\tt --}', "{\tt -}" +## s/("|')(\s*)(-+)(\s*)\1/&noremap("$1$2\{\\tt $3\}$4$1")/ge; +## changed Wed Jan 25 15:26:39 JST 1995 + # '-', '--', "-" => '$-$', '$--$', "$-$" + s/(\s+)(['"])(-+)([^'"\-]*)\2(\s+|[,.])/"$1$2".&noremap("\$$3\$")."$4$2$5"/ge; + s/(\s+)(['"])([^'"\-]*)(-+)(\s*)\2(\s+|[,.])/"$1$2$3".&noremap("\$$4\$")."$5$2$6"/ge; + # (--|-) => ($--$|$-$) + s/(\s+)\((-+)([=@%\$\+\\\|\w]*)(-*)([=@%\$\+\\\|\w]*)\)(\s+|[,.])/"$1\(".&noremap("\$$2\$")."$3".&noremap("\$$4\$")."$5\)$6"/ge; + # numeral - => $-$ + s/(\(|[0-9]+|\s+)-(\s*\(?\s*[0-9]+)/&noremap("$1\$-\$$2")/ge; + # -- in quotes => two separate - + s/B<([^<>]*)--([^<>]*)>/&noremap("B<$1\{\\tt --\}$2>")/ge; + + # backslash escapable characters except _. + s/([$backslash_escapables2])/&noremap("\\$1")/ge; + s/_/&noremap("\\underscore{}")/ge; # a litle thicker than \_. + # quote TeX special characters |, ^, ~, \. + s/\|/&noremap("\$|\$")/ge; + s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge; + s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge; + s/\\/&noremap("\$\\backslash{}\$")/ge; + # quote [ and ] to be used in \item[] + s/([\[\]])/&noremap("{\\tt $1}")/ge; + # characters need to be treated differently in TeX + # keep * if an item heading + s/^(=item[ \t]+)[*]((.|\n)*)/"$1" . &noremap("*") . "$2"/ge; + s/[*]/&noremap("\$\\ast\$")/ge; # other * + + # hide other pod quotes. + s/([ABD-Z]<[^<>]*>)/&noremap($1)/ge; + + # escape < and > as math strings, + # now that we are done with hiding pod <> quotes. + s//&noremap("\$>\$")/ge; + + # put it back so we get the <> processed again; + $_ = &clear_noremap($_); + + + # Expand pod quotes recursively: + # (1) type face directives [BIFS]<[^<>]*> to appropriate TeX commands, + # (2) L<[^<>]*> to reference strings, + # (3) C<[^<>]*> to TeX literal quotes, + # (4) HTML quotes E<> inside of C<> quotes. + + # Hide E<> again since they can be included in C<>. + s/(E<[^<>]+>)/noremap($1)/ge; + + $maxnest = 10; + while ($maxnest-- && /[A-Z]]*)>/"{\\bf $1}"/eg; + s#I<([^<>]*)>#"{\\em $1\\/}"#eg; + + # files and filelike refs in italics + s#F<([^<>]*)>#"{\\em $1\\/}"#eg; + + # no break quote -- usually we want C<> for this + s/S<([^<>]*)>/&nobreak($1)/eg; + + # LREF: a manpage(3f) + s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the {\\em $1\\/}$2 manpage:g; + + # LREF: an =item on another manpage + s{ + L<([^/]+)/([:\w]+(\(\))?)> + } {the C<$2> entry in the I<$1> manpage}gx; + + # LREF: an =item on this manpage + s{ + ((?:L + (,?\s+(and\s+)?)?)+) + } { &internal_lrefs($1) }gex; + + # LREF: a =head2 (head1?), maybe on a manpage, maybe right here + # the "func" can disambiguate + s{ + L<(?:([a-zA-Z]\S+?) /)?"?(.*?)"?> + }{ + do { + $1 # if no $1, assume it means on this page. + ? "the section on I<$2> in the I<$1> manpage" + : "the section on I<$2>" + } + }gex; + + s/Z<>/\\&/g; # the "don't format me" thing + + # comes last because not subject to reprocessing + s{ + C<([^<>]*)> + }{ + do { + ($str = $1) =~ tr/\200-\377/\000-\177/; #normalize hidden stuff + # expand HTML escapes if any; + # WARNING: if HTML escapes other than E,E,E, + # E are in C<>, they will not be printed correctly. + $str = &expand_HTML_escapes($str); + $strverb = &alltt($str); # Tex verbatim escape of a string. + &noremap("$strverb"); + } + }gex; + +# if ( /C<([^<>]*)/ ) { +# $str = $1; +# if ($str !~ /\|/) { # if includes | +# s/C<([^<>]*)>/&noremap("\\verb|$str|")/eg; +# } else { +# print STDERR "found \| in C<.*> at paragraph $.\n"; +# # find a character not contained in $str to use it as a +# # separator of the \verb +# ($chars = $str) =~ s/(\W)/\\$1/g; +# ## ($chars = $str) =~ s/([\$<>,\|"'\-^{}()*+?\\])/\\$1/g; +# @fence = grep(!/[ $chars]/,@tex_verb_fences); +# s/C<([^<>]*)>/&noremap("\\verb$fence[0]$str$fence[0]")/eg; +# } +# } + } + + + # process each pod command + if (s/^=//) { # if a command + s/\n/ /g; + ($cmd, $rest) = split(' ', $_, 2); + $rest =~ s/^\s*//; + $rest =~ s/\s*$//; + + if (defined $rest) { + &escapes; + } + + $rest = &clear_noremap($rest); + $rest = &expand_HTML_escapes($rest); + + if ($cmd eq 'cut') { + $cutting = 1; + $lastcmd = 'cut'; + } + elsif ($cmd eq 'head1') { # heading type 1 + $rest =~ s/^\s*//; $rest =~ s/\s*$//; + print LATEX "\n\\subsection*{$rest}"; + # put index entry + ($index = $rest) =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' + # index only those heads not matching the frequent patterns. + foreach $pat (@head1_freq_patterns) { + if ($index =~ /^$pat/) { + goto freqpatt; + } + } + print LATEX "%\n\\index{$index}\n" if ($index); + freqpatt: + $lastcmd = 'head1'; + } + elsif ($cmd eq 'head2') { # heading type 2 + $rest =~ s/^\s*//; $rest =~ s/\s*$//; + print LATEX "\n\\subsubsection*{$rest}"; + # put index entry + ($index = $rest) =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' + $index =~ s/^Example\s*[1-9][0-9]*\s*:\s*//; # remove 'Example :' + print LATEX "%\n\\index{$index}\n" if ($index); + $lastcmd = 'head2'; + } + elsif ($cmd eq 'over') { # 1 level within a listing environment + push(@indent,$indent); + $indent = $rest + 0; + $lastcmd = 'over'; + } + elsif ($cmd eq 'back') { # 1 level out of a listing environment + $indent = pop(@indent); + warn "Unmatched =back\n" unless defined $indent; + $listingcmd = pop(@listingcmd); + print LATEX "\n\\end{$listingcmd}\n" if ($listingcmd); + $lastcmd = 'back'; + } + elsif ($cmd eq 'item') { # an item paragraph starts + if ($lastcmd eq 'over') { # if we have just entered listing env + # see what type of list environment we are in. + if ($rest =~ /^[0-9]\.?/) { # if numeral heading + $listingcmd = 'enumerate'; + } elsif ($rest =~ /^\*\s*/) { # if * heading + $listingcmd = 'itemize'; + } elsif ($rest =~ /^[^*]/) { # if other headings + $listingcmd = 'description'; + } else { + warn "unknown list type for item $rest"; + } + print LATEX "\n\\begin{$listingcmd}\n"; + push(@listingcmd,$listingcmd); + } elsif ($lastcmd ne 'item') { + warn "Illegal '=item' command without preceding 'over':"; + warn "=item $bareitem"; + } + + if ($listingcmd eq 'enumerate') { + $rest =~ s/^[0-9]+\.?\s*//; # remove numeral heading + print LATEX "\n\\item"; + print LATEX "{\\bf $rest}" if $rest; + } elsif ($listingcmd eq 'itemize') { + $rest =~ s/^\*\s*//; # remove * heading + print LATEX "\n\\item"; + print LATEX "{\\bf $rest}" if $rest; + } else { # description item + print LATEX "\n\\item[$rest]"; + } + $lastcmd = 'item'; + $rightafter_item = 'yes'; + + # check if the item heading is short or long. + ($itemhead = $rest) =~ s/{\\bf (\S*)}/$1/g; + if (length($itemhead) < 4) { + $itemshort = "yes"; + } else { + $itemshort = "no"; + } + # write index entry + if ($pod =~ "perldiag") { # skip 'perldiag.pod' + goto noindex; + } + # strip out the item of pod quotes and get a plain text entry + $bareitem =~ s/\n/ /g; # remove newlines + $bareitem =~ s/\s*$//; # remove trailing space + $bareitem =~ s/[A-Z]<([^<>]*)>/$1/g; # remove <> quotes + ($index = $bareitem) =~ s/^\*\s+//; # remove leading '*' + $index =~ s/^(An?\s+|The\s+)//i; # remove 'A' and 'The' + $index =~ s/^\s*[1-9][0-9]*\s*[.]\s*$//; # remove numeral only + $index =~ s/^\s*\w\s*$//; # remove 1 char only's + # quote ", @ and ! with " to be used in makeindex. + $index =~ s/"/""/g; # quote " + $index =~ s/@/"@/g; # quote @ + $index =~ s/!/"!/g; # quote ! + ($rest2=$rest) =~ s/^\*\s+//; # remove * + $rest2 =~ s/"/""/g; # quote " + $rest2 =~ s/@/"@/g; # quote @ + $rest2 =~ s/!/"!/g; # quote ! + if ($pod =~ "(perlfunc|perlvar)") { # when doc is perlfunc,perlvar + # take only the 1st word of item heading + $index =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/; + $rest2 =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/; + } + if ($index =~ /[A-Za-z\$@%]/) { + # write \index{plain_text_entry@TeX_string_entry} + print LATEX "%\n\\index{$index\@$rest2}%\n"; + } + noindex: + ; + } + elsif ($cmd eq 'pod') { + ; # recognise the pod directive, as no op (hs) + } + elsif ($cmd eq 'pod') { + ; # recognise the pod directive, as no op (hs) + } + else { + warn "Unrecognized directive: $cmd\n"; + } + } + else { # if not command + &escapes; + $_ = &clear_noremap($_); + $_ = &expand_HTML_escapes($_); + + # if the present paragraphs follows an =item declaration, + # put a line break. + if ($lastcmd eq 'item' && + $rightafter_item eq 'yes' && $itemshort eq "no") { + print LATEX "\\hfil\\\\"; + $rightafter_item = 'no'; + } + print LATEX "\n",$_; + } +} + +print LATEX "\n"; +close(POD); +close(LATEX); + + +######################################################################### + +sub do_hdr { + print LATEX "% LaTeX document produced by pod2latex from \"$pod.pod\".\n"; + print LATEX "% The followings need be defined in the preamble of this document:\n"; + print LATEX "%\\def\\C++{{\\rm C\\kern-.05em\\raise.3ex\\hbox{\\footnotesize ++}}}\n"; + print LATEX "%\\def\\underscore{\\leavevmode\\kern.04em\\vbox{\\hrule width 0.4em height 0.3pt}}\n"; + print LATEX "%\\setlength{\\parindent}{0pt}\n"; + print LATEX "\n"; + $podq = &escape_tex_specials("\U$pod\E"); + print LATEX "\\section{$podq}%\n"; + print LATEX "\\index{$podq}"; + print LATEX "\n"; +} + +sub nobreak { + my $string = shift; + $string =~ s/ +/~/g; # TeX no line break + $string; +} + +sub noremap { + local($thing_to_hide) = shift; + $thing_to_hide =~ tr/\000-\177/\200-\377/; + return $thing_to_hide; +} + +sub init_noremap { + # escape high bit characters in input stream + s/([\200-\377])/"E<".ord($1).">"/ge; +} + +sub clear_noremap { + local($tmp) = shift; + $tmp =~ tr/\200-\377/\000-\177/; + return $tmp; +} + +sub expand_HTML_escapes { + local($s) = $_[0]; + $s =~ s { E<((\d+)|([A-Za-z]+))> } + { + do { + defined($2) + ? do { chr($2) } + : + exists $HTML_Escapes{$3} + ? do { $HTML_Escapes{$3} } + : do { + warn "Unknown escape: $& in $_"; + "E<$1>"; + } + } + }egx; + return $s; +} + +sub escapes { + # make C++ into \C++, which is to be defined as + # \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}} + s/\bC\+\+/\\C++{}/g; +} + +# Translate a string into a TeX \tt string to obtain a verbatim print out. +# TeX special characters are escaped by \. +# This can be used inside of LaTeX command arguments. +# We don't use LaTeX \verb since it doesn't work inside of command arguments. +sub alltt { + local($str) = shift; + # other chars than #,\,$,%,&,{,},_,\,^,~ ([ and ] included). + $str =~ s/([^${backslash_escapables}\\\^\~]+)/&noremap("$&")/eg; + # chars #,\,$,%,&,{,} => \# , ... + $str =~ s/([$backslash_escapables2])/&noremap("\\$&")/eg; + # chars _,\,^,~ => \char`\_ , ... + $str =~ s/_/&noremap("\\char`\\_")/eg; + $str =~ s/\\/&noremap("\\char`\\\\")/ge; + $str =~ s/\^/\\char`\\^/g; + $str =~ s/\~/\\char`\\~/g; + + $str =~ tr/\200-\377/\000-\177/; # put back + $str = "{\\tt ".$str."}"; # make it a \tt string + return $str; +} + +sub escape_tex_specials { + local($str) = shift; + # other chars than #,\,$,%,&,{,}, _,\,^,~ ([ and ] included). + # backslash escapable characters #,\,$,%,&,{,} except _. + $str =~ s/([$backslash_escapables2])/&noremap("\\$1")/ge; + $str =~ s/_/&noremap("\\underscore{}")/ge; # \_ is too thin. + # quote TeX special characters |, ^, ~, \. + $str =~ s/\|/&noremap("\$|\$")/ge; + $str =~ s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge; + $str =~ s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge; + $str =~ s/\\/&noremap("\$\\backslash{}\$")/ge; + # characters need to be treated differently in TeX + # * + $str =~ s/[*]/&noremap("\$\\ast\$")/ge; + # escape < and > as math string, + $str =~ s//&noremap("\$>\$")/ge; + $str =~ tr/\200-\377/\000-\177/; # put back + return $str; +} + +sub internal_lrefs { + local($_) = shift; + + s{L]+)>}{$1}g; + my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); + my $retstr = "the "; + my $i; + for ($i = 0; $i <= $#items; $i++) { + $retstr .= "C<$items[$i]>"; + $retstr .= ", " if @items > 2 && $i != $#items; + $retstr .= " and " if $i+2 == @items; + } + $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) + . " elsewhere in this document"; + + return $retstr; +} + +# map of HTML escapes to TeX escapes. +BEGIN { +%HTML_Escapes = ( + 'amp' => '&', # ampersand + 'lt' => '<', # left chevron, less-than + 'gt' => '>', # right chevron, greater-than + 'quot' => '"', # double quote + + "Aacute" => "\\'{A}", # capital A, acute accent + "aacute" => "\\'{a}", # small a, acute accent + "Acirc" => "\\^{A}", # capital A, circumflex accent + "acirc" => "\\^{a}", # small a, circumflex accent + "AElig" => '\\AE', # capital AE diphthong (ligature) + "aelig" => '\\ae', # small ae diphthong (ligature) + "Agrave" => "\\`{A}", # capital A, grave accent + "agrave" => "\\`{a}", # small a, grave accent + "Aring" => '\\u{A}', # capital A, ring + "aring" => '\\u{a}', # small a, ring + "Atilde" => '\\~{A}', # capital A, tilde + "atilde" => '\\~{a}', # small a, tilde + "Auml" => '\\"{A}', # capital A, dieresis or umlaut mark + "auml" => '\\"{a}', # small a, dieresis or umlaut mark + "Ccedil" => '\\c{C}', # capital C, cedilla + "ccedil" => '\\c{c}', # small c, cedilla + "Eacute" => "\\'{E}", # capital E, acute accent + "eacute" => "\\'{e}", # small e, acute accent + "Ecirc" => "\\^{E}", # capital E, circumflex accent + "ecirc" => "\\^{e}", # small e, circumflex accent + "Egrave" => "\\`{E}", # capital E, grave accent + "egrave" => "\\`{e}", # small e, grave accent + "ETH" => '\\OE', # capital Eth, Icelandic + "eth" => '\\oe', # small eth, Icelandic + "Euml" => '\\"{E}', # capital E, dieresis or umlaut mark + "euml" => '\\"{e}', # small e, dieresis or umlaut mark + "Iacute" => "\\'{I}", # capital I, acute accent + "iacute" => "\\'{i}", # small i, acute accent + "Icirc" => "\\^{I}", # capital I, circumflex accent + "icirc" => "\\^{i}", # small i, circumflex accent + "Igrave" => "\\`{I}", # capital I, grave accent + "igrave" => "\\`{i}", # small i, grave accent + "Iuml" => '\\"{I}', # capital I, dieresis or umlaut mark + "iuml" => '\\"{i}', # small i, dieresis or umlaut mark + "Ntilde" => '\\~{N}', # capital N, tilde + "ntilde" => '\\~{n}', # small n, tilde + "Oacute" => "\\'{O}", # capital O, acute accent + "oacute" => "\\'{o}", # small o, acute accent + "Ocirc" => "\\^{O}", # capital O, circumflex accent + "ocirc" => "\\^{o}", # small o, circumflex accent + "Ograve" => "\\`{O}", # capital O, grave accent + "ograve" => "\\`{o}", # small o, grave accent + "Oslash" => "\\O", # capital O, slash + "oslash" => "\\o", # small o, slash + "Otilde" => "\\~{O}", # capital O, tilde + "otilde" => "\\~{o}", # small o, tilde + "Ouml" => '\\"{O}', # capital O, dieresis or umlaut mark + "ouml" => '\\"{o}', # small o, dieresis or umlaut mark + "szlig" => '\\ss{}', # small sharp s, German (sz ligature) + "THORN" => '\\L', # capital THORN, Icelandic + "thorn" => '\\l',, # small thorn, Icelandic + "Uacute" => "\\'{U}", # capital U, acute accent + "uacute" => "\\'{u}", # small u, acute accent + "Ucirc" => "\\^{U}", # capital U, circumflex accent + "ucirc" => "\\^{u}", # small u, circumflex accent + "Ugrave" => "\\`{U}", # capital U, grave accent + "ugrave" => "\\`{u}", # small u, grave accent + "Uuml" => '\\"{U}', # capital U, dieresis or umlaut mark + "uuml" => '\\"{u}', # small u, dieresis or umlaut mark + "Yacute" => "\\'{Y}", # capital Y, acute accent + "yacute" => "\\'{y}", # small y, acute accent + "yuml" => '\\"{y}', # small y, dieresis or umlaut mark +); +} +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/contrib/perl5/pod/pod2man.PL b/contrib/perl5/pod/pod2man.PL new file mode 100644 index 00000000000..8040bf5d63e --- /dev/null +++ b/contrib/perl5/pod/pod2man.PL @@ -0,0 +1,1216 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# $man3ext +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; + +\$DEF_PM_SECTION = '$Config{man3ext}' || '3'; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; + +=head1 NAME + +pod2man - translate embedded Perl pod directives into man pages + +=head1 SYNOPSIS + +B +[ B<--section=>I ] +[ B<--release=>I ] +[ B<--center=>I ] +[ B<--date=>I ] +[ B<--fixed=>I ] +[ B<--official> ] +[ B<--lax> ] +I + +=head1 DESCRIPTION + +B converts its input file containing embedded pod directives (see +L) into nroff source suitable for viewing with nroff(1) or +troff(1) using the man(7) macro set. + +Besides the obvious pod conversions, B also takes care of +func(), func(n), and simple variable references like $foo or @bar so +you don't have to use code escapes for them; complex expressions like +C<$fred{'stuff'}> will still need to be escaped, though. Other nagging +little roffish things that it catches include translating the minus in +something like foo-bar, making a long dash--like this--into a real em +dash, fixing up "paired quotes", putting a little space after the +parens in something like func(), making C++ and PI look right, making +double underbars have a little tiny space between them, making ALLCAPS +a teeny bit smaller in troff(1), and escaping backslashes so you don't +have to. + +=head1 OPTIONS + +=over 8 + +=item center + +Set the centered header to a specific string. The default is +"User Contributed Perl Documentation", unless the C<--official> flag is +given, in which case the default is "Perl Programmers Reference Guide". + +=item date + +Set the left-hand footer string to this value. By default, +the modification date of the input file will be used. + +=item fixed + +The fixed font to use for code refs. Defaults to CW. + +=item official + +Set the default header to indicate that this page is of +the standard release in case C<--center> is not given. + +=item release + +Set the centered footer. By default, this is the current +perl release. + +=item section + +Set the section for the C<.TH> macro. The standard conventions on +sections are to use 1 for user commands, 2 for system calls, 3 for +functions, 4 for devices, 5 for file formats, 6 for games, 7 for +miscellaneous information, and 8 for administrator commands. This works +best if you put your Perl man pages in a separate tree, like +F. By default, section 1 will be used +unless the file ends in F<.pm> in which case section 3 will be selected. + +=item lax + +Don't complain when required sections aren't present. + +=back + +=head1 Anatomy of a Proper Man Page + +For those not sure of the proper layout of a man page, here's +an example of the skeleton of a proper man page. Head of the +major headers should be setout as a C<=head1> directive, and +are historically written in the rather startling ALL UPPER CASE +format, although this is not mandatory. +Minor headers may be included using C<=head2>, and are +typically in mixed case. + +=over 10 + +=item NAME + +Mandatory section; should be a comma-separated list of programs or +functions documented by this podpage, such as: + + foo, bar - programs to do something + +=item SYNOPSIS + +A short usage summary for programs and functions, which +may someday be deemed mandatory. + +=item DESCRIPTION + +Long drawn out discussion of the program. It's a good idea to break this +up into subsections using the C<=head2> directives, like + + =head2 A Sample Subection + + =head2 Yet Another Sample Subection + +=item OPTIONS + +Some people make this separate from the description. + +=item RETURN VALUE + +What the program or function returns if successful. + +=item ERRORS + +Exceptions, return codes, exit stati, and errno settings. + +=item EXAMPLES + +Give some example uses of the program. + +=item ENVIRONMENT + +Envariables this program might care about. + +=item FILES + +All files used by the program. You should probably use the FEE +for these. + +=item SEE ALSO + +Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8). + +=item NOTES + +Miscellaneous commentary. + +=item CAVEATS + +Things to take special care with; sometimes called WARNINGS. + +=item DIAGNOSTICS + +All possible messages the program can print out--and +what they mean. + +=item BUGS + +Things that are broken or just don't work quite right. + +=item RESTRICTIONS + +Bugs you don't plan to fix :-) + +=item AUTHOR + +Who wrote it (or AUTHORS if multiple). + +=item HISTORY + +Programs derived from other sources sometimes have this, or +you might keep a modification log here. + +=back + +=head1 EXAMPLES + + pod2man program > program.1 + pod2man some_module.pm > /usr/perl/man/man3/some_module.3 + pod2man --section=7 note.pod > note.7 + +=head1 DIAGNOSTICS + +The following diagnostics are generated by B. Items +marked "(W)" are non-fatal, whereas the "(F)" errors will cause +B to immediately exit with a non-zero status. + +=over 4 + +=item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s> + +(W) If you start include an option, you should set it off +as bold, italic, or code. + +=item can't open %s: %s + +(F) The input file wasn't available for the given reason. + +=item Improper man page - no dash in NAME header in paragraph %d of %s + +(W) The NAME header did not have an isolated dash in it. This is +considered important. + +=item Invalid man page - no NAME line in %s + +(F) You did not include a NAME header, which is essential. + +=item roff font should be 1 or 2 chars, not `%s' (F) + +(F) The font specified with the C<--fixed> option was not +a one- or two-digit roff font. + +=item %s is missing required section: %s + +(W) Required sections include NAME, DESCRIPTION, and if you're +using a section starting with a 3, also a SYNOPSIS. Actually, +not having a NAME is a fatal. + +=item Unknown escape: %s in %s + +(W) An unknown HTML entity (probably for an 8-bit character) was given via +a CE> directive. Besides amp, lt, gt, and quot, recognized +entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave, +Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute, +Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc, +icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc, +ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig, +THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml, +Yacute, yacute, and yuml. + +=item Unmatched =back + +(W) You have a C<=back> without a corresponding C<=over>. + +=item Unrecognized pod directive: %s + +(W) You specified a pod directive that isn't in the known list of +C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>. + + +=back + +=head1 NOTES + +If you would like to print out a lot of man page continuously, you +probably want to set the C and D registers to set contiguous page +numbering and even/odd paging, at least on some versions of man(7). +Settting the F register will get you some additional experimental +indexing: + + troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ... + +The indexing merely outputs messages via C<.tm> for each +major page, section, subsection, item, and any CE> +directives. + + +=head1 RESTRICTIONS + +None at this time. + +=head1 BUGS + +The =over and =back directives don't really work right. They +take absolute positions instead of offsets, don't nest well, and +making people count is suboptimal in any event. + +=head1 AUTHORS + +Original prototype by Larry Wall, but so massively hacked over by +Tom Christiansen such that Larry probably doesn't recognize it anymore. + +=cut + +$/ = ""; +$cutting = 1; +@Indices = (); + +# We try first to get the version number from a local binary, in case we're +# running an installed version of Perl to produce documentation from an +# uninstalled newer version's pod files. +if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { + ($version,$patch) = + `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/; +} +# No luck; we'll just go with the running Perl's version +($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version; +$DEF_RELEASE = "perl $version"; +$DEF_RELEASE .= ", patch $patch" if $patch; + + +sub makedate { + my $secs = shift; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); + my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon]; + return "$mday/$mname/$year"; +} + +use Getopt::Long; + +$DEF_SECTION = 1; +$DEF_CENTER = "User Contributed Perl Documentation"; +$STD_CENTER = "Perl Programmers Reference Guide"; +$DEF_FIXED = 'CW'; +$DEF_LAX = 0; + +sub usage { + warn "$0: @_\n" if @_; + die <"; +$Filename = $name; +if ($section =~ /^1/) { + require File::Basename; + $name = uc File::Basename::basename($name); +} +$name =~ s/\.(pod|p[lm])$//i; + +# Lose everything up to the first of +# */lib/*perl* standard or site_perl module +# */*perl*/lib from -D prefix=/opt/perl +# */*perl*/ random module hierarchy +# which works. +$name =~ s-//+-/-g; +if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i + or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i + or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { + # Lose ^site(_perl)?/. + $name =~ s-^site(_perl)?/--; + # Lose ^arch/. (XXX should we use Config? Just for archname?) + $name =~ s~^(.*-$^O|$^O-.*)/~~o; + # Lose ^version/. + $name =~ s-^\d+\.\d+/--; +} + +# Translate Getopt/Long to Getopt::Long, etc. +$name =~ s(/)(::)g; + +if ($name ne 'something') { + FCHECK: { + open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!"; + while () { + next unless /^=\b/; + if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes + $_ = ; + unless (/\s*-+\s+/) { + $oops++; + warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n" + } else { + my @n = split /\s+-+\s+/; + if (@n != 2) { + $oops++; + warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n" + } + else { + %namedesc = @n; + } + } + last FCHECK; + } + next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME + next if /^=pod\b/; # It is OK to have =pod before NAME + die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax; + } + die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax; + } + close F; +} + +print <<"END"; +.rn '' }` +''' \$RCSfile\$\$Revision\$\$Date\$ +''' +''' \$Log\$ +''' +.de Sh +.br +.if t .Sp +.ne 5 +.PP +\\fB\\\\\$1\\fR +.PP +.. +.de Sp +.if t .sp .5v +.if n .sp +.. +.de Ip +.br +.ie \\\\n(.\$>=3 .ne \\\\\$3 +.el .ne 3 +.IP "\\\\\$1" \\\\\$2 +.. +.de Vb +.ft $CFont +.nf +.ne \\\\\$1 +.. +.de Ve +.ft R + +.fi +.. +''' +''' +''' Set up \\*(-- to give an unbreakable dash; +''' string Tr holds user defined translation string. +''' Bell System Logo is used as a dummy character. +''' +.tr \\(*W-|\\(bv\\*(Tr +.ie n \\{\\ +.ds -- \\(*W- +.ds PI pi +.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch +.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 + +print <<'END'; +.\" If the F register is turned on, we'll generate +.\" index entries out stderr for the following things: +.\" TH Title +.\" SH Header +.\" Sh Subsection +.\" Ip Item +.\" X<> Xref (embedded +.\" Of course, you have to process the output yourself +.\" in some meaninful fashion. +.if \nF \{ +.de IX +.tm Index:\\$1\t\\n%\t"\\$2" +.. +.nr % 0 +.rr F +.\} +END + +print <<"END"; +.TH $name $section "$RP" "$date" "$center" +.UC +END + +push(@Indices, qq{.IX Title "$name $section"}); + +while (($name, $desc) = each %namedesc) { + for ($name, $desc) { s/^\s+//; s/\s+$//; } + push(@Indices, qq(.IX Name "$name - $desc"\n)); +} + +print <<'END'; +.if n .hy 0 +.if n .na +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.de CQ \" put $1 in typewriter font +END +print ".ft $CFont\n"; +print <<'END'; +'if n "\c +'if t \\&\\$1\c +'if n \\&\\$1\c +'if n \&" +\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 +'.ft R +.. +.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 +. \" AM - accent mark definitions +.bd B 3 +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds ? ? +. ds ! ! +. ds / +. ds q +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' +. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +. ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] +.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' +.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' +.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +.ds oe o\h'-(\w'o'u*4/10)'e +.ds Oe O\h'-(\w'O'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds v \h'-1'\o'\(aa\(ga' +. ds _ \h'-1'^ +. ds . \h'-1'. +. ds 3 3 +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +. ds oe oe +. ds Oe OE +.\} +.rm #[ #] #H #V #F C +END + +$indent = 0; + +$begun = ""; + +# Unrolling [^A-Z>]|[A-Z](?!<) gives: // MRE pp 165. +my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)'; + +while (<>) { + if ($cutting) { + next unless /^=/; + $cutting = 0; + } + if ($begun) { + if (/^=end\s+$begun/) { + $begun = ""; + } + elsif ($begun =~ /^(roff|man)$/) { + print STDOUT $_; + } + next; + } + chomp; + + # Translate verbatim paragraph + + if (/^\s/) { + @lines = split(/\n/); + for (@lines) { + 1 while s + {^( [^\t]* ) \t ( \t* ) } + { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex; + s/\\/\\e/g; + s/\A/\\&/s; + } + $lines = @lines; + makespace() unless $verbatim++; + print ".Vb $lines\n"; + print join("\n", @lines), "\n"; + print ".Ve\n"; + $needspace = 0; + next; + } + + $verbatim = 0; + + if (/^=for\s+(\S+)\s*/s) { + if ($1 eq "man" or $1 eq "roff") { + print STDOUT $',"\n\n"; + } else { + # ignore unknown for + } + next; + } + elsif (/^=begin\s+(\S+)\s*/s) { + $begun = $1; + if ($1 eq "man" or $1 eq "roff") { + print STDOUT $'."\n\n"; + } + next; + } + + # check for things that'll hosed our noremap scheme; affects $_ + init_noremap(); + + if (!/^=item/) { + + # trofficate backslashes; must do it before what happens below + s/\\/noremap('\\e')/ge; + + # protect leading periods and quotes against *roff + # mistaking them for directives + s/^(?:[A-Z]<)?[.']/\\&$&/gm; + + # first hide the escapes in case we need to + # intuit something and get it wrong due to fmting + + 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; + + # func() is a reference to a perl function + s{ + \b + ( + [:\w]+ \(\) + ) + } {I<$1>}gx; + + # func(n) is a reference to a perl function or a man page + s{ + ([:\w]+) + ( + \( [^\051]+ \) + ) + } {I<$1>\\|$2}gx; + + # convert simple variable references + s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g; + + if (m{ ( + [\-\w]+ + \( + [^\051]*? + [\@\$,] + [^\051]*? + \) + ) + }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) + { + warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n"; + $oops++; + } + + while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { + warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n"; + $oops++; + } + + # put it back so we get the <> processed again; + clear_noremap(0); # 0 means leave the E's + + } else { + # trofficate backslashes + s/\\/noremap('\\e')/ge; + + } + + # need to hide E<> first; they're processed in clear_noremap + s/(E<[^<>]+>)/noremap($1)/ge; + + + $maxnest = 10; + while ($maxnest-- && /[A-Z]/font($1) . $2 . font('R')/eg; + + # files and filelike refs in italics + s/F<($nonest)>/I<$1>/g; + + # no break -- usually we want C<> for this + s/S<($nonest)>/nobreak($1)/eg; + + # LREF: a la HREF L + s:L<([^|>]+)\|[^>]+>:$1:g; + + # LREF: a manpage(3f) + s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g; + + # LREF: an =item on another manpage + s{ + L< + ([^/]+) + / + ( + [:\w]+ + (\(\))? + ) + > + } {the C<$2> entry in the I<$1> manpage}gx; + + # LREF: an =item on this manpage + s{ + ((?: + L< + / + ( + [:\w]+ + (\(\))? + ) + > + (,?\s+(and\s+)?)? + )+) + } { internal_lrefs($1) }gex; + + # LREF: a =head2 (head1?), maybe on a manpage, maybe right here + # the "func" can disambiguate + s{ + L< + (?: + ([a-zA-Z]\S+?) / + )? + "?(.*?)"? + > + }{ + do { + $1 # if no $1, assume it means on this page. + ? "the section on I<$2> in the I<$1> manpage" + : "the section on I<$2>" + } + }gesx; # s in case it goes over multiple lines, so . matches \n + + s/Z<>/\\&/g; + + # comes last because not subject to reprocessing + s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; + } + + if (s/^=//) { + $needspace = 0; # Assume this. + + s/\n/ /g; + + ($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($dotlevel); + s/"/""/g; + } + + clear_noremap(1); + + if ($Cmd eq 'cut') { + $cutting = 1; + } + elsif ($Cmd eq 'head1') { + s/\s+$//; + delete $wanna_see{$_} if exists $wanna_see{$_}; + print qq{.SH "$_"\n}; + push(@Indices, qq{.IX Header "$_"\n}); + } + elsif ($Cmd eq 'head2') { + print qq{.Sh "$_"\n}; + push(@Indices, qq{.IX Subsection "$_"\n}); + } + elsif ($Cmd eq 'over') { + push(@indent,$indent); + $indent += ($_ + 0) || 5; + } + elsif ($Cmd eq 'back') { + $indent = pop(@indent); + warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent; + $needspace = 1; + } + elsif ($Cmd eq 'item') { + s/^\*( |$)/\\(bu$1/g; + # if you know how to get ":s please do + s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g; + s/\\\*\(L"([^"]+?)""/'$1'/g; + s/[^"]""([^"]+?)""[^"]/'$1'/g; + # here do something about the $" in perlvar? + print STDOUT qq{.Ip "$_" $indent\n}; + push(@Indices, qq{.IX Item "$_"\n}); + } + elsif ($Cmd eq 'pod') { + # this is just a comment + } + else { + warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n"; + } + } + else { + if ($needspace) { + &makespace; + } + &escapes(0); + clear_noremap(1); + print $_, "\n"; + $needspace = 1; + } +} + +print <<"END"; + +.rn }` '' +END + +if (%wanna_see && !$lax) { + @missing = keys %wanna_see; + warn "$0: $Filename is missing required section" + . (@missing > 1 && "s") + . ": @missing\n"; + $oops++; +} + +foreach (@Indices) { print "$_\n"; } + +exit; +#exit ($oops != 0); + +######################################################################### + +sub nobreak { + my $string = shift; + $string =~ s/ /\\ /g; + $string; +} + +sub escapes { + my $indot = shift; + + s/X<(.*?)>/mkindex($1)/ge; + + # translate the minus in foo-bar into foo\-bar for roff + s/([^0-9a-z-])-([^-])/$1\\-$2/g; + + # make -- into the string version \*(-- (defined above) + s/\b--\b/\\*(--/g; + s/"--([^"])/"\\*(--$1/g; # should be a better way + 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\\*($dotmacroL$2")/ge; + s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; + } + + #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; + #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g; + + + # make sure that func() keeps a bit a space tween the parens + ### s/\b\(\)/\\|()/g; + ### s/\b\(\)/(\\|)/g; + + # make C++ into \*C+, which is a squinched version (defined above) + s/\bC\+\+/\\*(C+/g; + + # make double underbars have a little tiny space between them + s/__/_\\|_/g; + + # PI goes to \*(PI (defined above) + s/\bPI\b/noremap('\\*(PI')/ge; + + # make all caps a teeny bit smaller, but don't muck with embedded code literals + my $hidCFont = font('C'); + if ($Cmd !~ /^head1/) { # SH already makes smaller + # /g isn't enough; 1 while or we'll be off + +# 1 while s{ +# (?!$hidCFont)(..|^.|^) +# \b +# ( +# [A-Z][\/A-Z+:\-\d_$.]+ +# ) +# (s?) +# \b +# } {$1\\s-1$2\\s0}gmox; + + 1 while s{ + (?!$hidCFont)(..|^.|^) + ( + \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b + ) + } { + $1 . noremap( '\\s-1' . $2 . '\\s0' ) + }egmox; + + } +} + +# make troff just be normal, but make small nroff get quoted +# decided to just put the quotes in the text; sigh; +sub ccvt { + local($_,$prev) = @_; + noremap(qq{.CQ "$_" \n\\&}); +} + +sub makespace { + if ($indent) { + print ".Sp\n"; + } + else { + print ".PP\n"; + } +} + +sub mkindex { + my ($entry) = @_; + my @entries = split m:\s*/\s*:, $entry; + push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; + return ''; +} + +sub font { + local($font) = shift; + return '\\f' . noremap($font); +} + +sub noremap { + local($thing_to_hide) = shift; + $thing_to_hide =~ tr/\000-\177/\200-\377/; + return $thing_to_hide; +} + +sub init_noremap { + # escape high bit characters in input stream + s/([\200-\377])/"E<".ord($1).">"/ge; +} + +sub clear_noremap { + my $ready_to_print = $_[0]; + + tr/\200-\377/\000-\177/; + + # trofficate backslashes + # s/(?!\\e)(?:..|^.|^)\\/\\e/g; + + # now for the E<>s, which have been hidden until now + # otherwise the interative \w<> processing would have + # been hosed by the E + s { + E< + ( + ( \d + ) + | ( [A-Za-z]+ ) + ) + > + } { + do { + defined $2 + ? chr($2) + : + exists $HTML_Escapes{$3} + ? do { $HTML_Escapes{$3} } + : do { + warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n"; + "E<$1>"; + } + } + }egx if $ready_to_print; +} + +sub internal_lrefs { + local($_) = shift; + local $trailing_and = s/and\s+$// ? "and " : ""; + + s{L]+)>}{$1}g; + my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); + my $retstr = "the "; + my $i; + for ($i = 0; $i <= $#items; $i++) { + $retstr .= "C<$items[$i]>"; + $retstr .= ", " if @items > 2 && $i != $#items; + $retstr .= " and " if $i+2 == @items; + } + + $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) + . " elsewhere in this document"; + # terminal space to avoid words running together (pattern used + # strips terminal spaces) + $retstr .= " " if length $trailing_and; + $retstr .= $trailing_and; + + return $retstr; + +} + +BEGIN { +%HTML_Escapes = ( + 'amp' => '&', # ampersand + 'lt' => '<', # left chevron, less-than + 'gt' => '>', # right chevron, greater-than + 'quot' => '"', # double quote + + "Aacute" => "A\\*'", # capital A, acute accent + "aacute" => "a\\*'", # small a, acute accent + "Acirc" => "A\\*^", # capital A, circumflex accent + "acirc" => "a\\*^", # small a, circumflex accent + "AElig" => '\*(AE', # capital AE diphthong (ligature) + "aelig" => '\*(ae', # small ae diphthong (ligature) + "Agrave" => "A\\*`", # capital A, grave accent + "agrave" => "A\\*`", # small a, grave accent + "Aring" => 'A\\*o', # capital A, ring + "aring" => 'a\\*o', # small a, ring + "Atilde" => 'A\\*~', # capital A, tilde + "atilde" => 'a\\*~', # small a, tilde + "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark + "auml" => 'a\\*:', # small a, dieresis or umlaut mark + "Ccedil" => 'C\\*,', # capital C, cedilla + "ccedil" => 'c\\*,', # small c, cedilla + "Eacute" => "E\\*'", # capital E, acute accent + "eacute" => "e\\*'", # small e, acute accent + "Ecirc" => "E\\*^", # capital E, circumflex accent + "ecirc" => "e\\*^", # small e, circumflex accent + "Egrave" => "E\\*`", # capital E, grave accent + "egrave" => "e\\*`", # small e, grave accent + "ETH" => '\\*(D-', # capital Eth, Icelandic + "eth" => '\\*(d-', # small eth, Icelandic + "Euml" => "E\\*:", # capital E, dieresis or umlaut mark + "euml" => "e\\*:", # small e, dieresis or umlaut mark + "Iacute" => "I\\*'", # capital I, acute accent + "iacute" => "i\\*'", # small i, acute accent + "Icirc" => "I\\*^", # capital I, circumflex accent + "icirc" => "i\\*^", # small i, circumflex accent + "Igrave" => "I\\*`", # capital I, grave accent + "igrave" => "i\\*`", # small i, grave accent + "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark + "iuml" => "i\\*:", # small i, dieresis or umlaut mark + "Ntilde" => 'N\*~', # capital N, tilde + "ntilde" => 'n\*~', # small n, tilde + "Oacute" => "O\\*'", # capital O, acute accent + "oacute" => "o\\*'", # small o, acute accent + "Ocirc" => "O\\*^", # capital O, circumflex accent + "ocirc" => "o\\*^", # small o, circumflex accent + "Ograve" => "O\\*`", # capital O, grave accent + "ograve" => "o\\*`", # small o, grave accent + "Oslash" => "O\\*/", # capital O, slash + "oslash" => "o\\*/", # small o, slash + "Otilde" => "O\\*~", # capital O, tilde + "otilde" => "o\\*~", # small o, tilde + "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark + "ouml" => "o\\*:", # small o, dieresis or umlaut mark + "szlig" => '\*8', # small sharp s, German (sz ligature) + "THORN" => '\\*(Th', # capital THORN, Icelandic + "thorn" => '\\*(th',, # small thorn, Icelandic + "Uacute" => "U\\*'", # capital U, acute accent + "uacute" => "u\\*'", # small u, acute accent + "Ucirc" => "U\\*^", # capital U, circumflex accent + "ucirc" => "u\\*^", # small u, circumflex accent + "Ugrave" => "U\\*`", # capital U, grave accent + "ugrave" => "u\\*`", # small u, grave accent + "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark + "uuml" => "u\\*:", # small u, dieresis or umlaut mark + "Yacute" => "Y\\*'", # capital Y, acute accent + "yacute" => "y\\*'", # small y, acute accent + "yuml" => "y\\*:", # small y, dieresis or umlaut mark +); +} + +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/contrib/perl5/pod/pod2text.PL b/contrib/perl5/pod/pod2text.PL new file mode 100644 index 00000000000..94516c39978 --- /dev/null +++ b/contrib/perl5/pod/pod2text.PL @@ -0,0 +1,51 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir dirname($0); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; + +use Pod::Text; + +if(@ARGV) { + pod2text($ARGV[0]); +} else { + pod2text("<&STDIN"); +} + +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/contrib/perl5/pod/roffitall b/contrib/perl5/pod/roffitall new file mode 100644 index 00000000000..918fe0270ab --- /dev/null +++ b/contrib/perl5/pod/roffitall @@ -0,0 +1,284 @@ +#!/bin/sh +# +# Usage: roffitall [-nroff|-psroff|-groff] +# +# Authors: Tom Christiansen, Raphael Manfredi + +me=roffitall +tmp=. + +if test -f ../config.sh; then + . ../config.sh +fi + +mandir=$installman1dir +libdir=$installman3dir + +test -d $mandir || mandir=/usr/new/man/man1 +test -d $libdir || libdir=/usr/new/man/man3 + +case "$1" in +-nroff) cmd="nroff -man"; ext='txt';; +-psroff) cmd="psroff -t"; ext='ps';; +-groff) cmd="groff -man"; ext='ps';; +*) + echo "Usage: roffitall [-nroff|-psroff|-groff]" >&2 + exit 1 + ;; +esac + +toroff=` + echo \ + $mandir/perl.1 \ + $mandir/perldata.1 \ + $mandir/perlsyn.1 \ + $mandir/perlop.1 \ + $mandir/perlre.1 \ + $mandir/perlrun.1 \ + $mandir/perlfunc.1 \ + $mandir/perlvar.1 \ + $mandir/perlsub.1 \ + $mandir/perlmod.1 \ + $mandir/perlmodlib.1 \ + $mandir/perlmodinstall.1 \ + $mandir/perlform.1 \ + $mandir/perllocale.1 \ + $mandir/perlref.1 \ + $mandir/perldsc.1 \ + $mandir/perllol.1 \ + $mandir/perltoot.1 \ + $mandir/perlobj.1 \ + $mandir/perltie.1 \ + $mandir/perlbot.1 \ + $mandir/perlipc.1 \ + $mandir/perldebug.1 \ + $mandir/perldiag.1 \ + $mandir/perlsec.1 \ + $mandir/perltrap.1 \ + $mandir/perlport.1 \ + $mandir/perlstyle.1 \ + $mandir/perlpod.1 \ + $mandir/perlbook.1 \ + $mandir/perlembed.1 \ + $mandir/perlapio.1 \ + $mandir/perlxs.1 \ + $mandir/perlxstut.1 \ + $mandir/perlguts.1 \ + $mandir/perlcall.1 \ + $mandir/perlhist.1 \ + $mandir/perldelta.1 \ + $mandir/perl5004delta.1 \ + $mandir/perlfaq.1 \ + $mandir/perlfaq1.1 \ + $mandir/perlfaq2.1 \ + $mandir/perlfaq3.1 \ + $mandir/perlfaq4.1 \ + $mandir/perlfaq5.1 \ + $mandir/perlfaq6.1 \ + $mandir/perlfaq7.1 \ + $mandir/perlfaq8.1 \ + $mandir/perlfaq9.1 \ + \ + $mandir/a2p.1 \ + $mandir/c2ph.1 \ + $mandir/h2ph.1 \ + $mandir/h2xs.1 \ + $mandir/perlbug.1 \ + $mandir/perldoc.1 \ + $mandir/pl2pm.1 \ + $mandir/pod2html.1 \ + $mandir/pod2man.1 \ + $mandir/s2p.1 \ + $mandir/splain.1 \ + $mandir/xsubpp.1 \ + \ + $libdir/attrs.3 \ + $libdir/autouse.3 \ + $libdir/base.3 \ + $libdir/blib.3 \ + $libdir/constant.3 \ + $libdir/diagnostics.3 \ + $libdir/fields.3 \ + $libdir/integer.3 \ + $libdir/less.3 \ + $libdir/lib.3 \ + $libdir/locale.3 \ + $libdir/ops.3 \ + $libdir/overload.3 \ + $libdir/re.3 \ + $libdir/sigtrap.3 \ + $libdir/strict.3 \ + $libdir/subs.3 \ + $libdir/vars.3 \ + \ + $libdir/AnyDBM_File.3 \ + $libdir/AutoLoader.3 \ + $libdir/AutoSplit.3 \ + $libdir/B.3 \ + $libdir/B::Asmdata.3 \ + $libdir/B::Assembler.3 \ + $libdir/B::Bblock.3 \ + $libdir/B::Bytecode.3 \ + $libdir/B::C.3 \ + $libdir/B::CC.3 \ + $libdir/B::Debug.3 \ + $libdir/B::Deparse.3 \ + $libdir/B::Disassembler.3 \ + $libdir/B::Lint.3 \ + $libdir/B::Showlex.3 \ + $libdir/B::Stackobj.3 \ + $libdir/B::Terse.3 \ + $libdir/B::Xref.3 \ + $libdir/Benchmark.3 \ + $libdir/Carp.3 \ + $libdir/CGI.3 \ + $libdir/CGI::Apache.3 \ + $libdir/CGI::Carp.3 \ + $libdir/CGI::Cookie.3 \ + $libdir/CGI::Fast.3 \ + $libdir/CGI::Push.3 \ + $libdir/CGI::Switch.3 \ + $libdir/Class::Struct.3 \ + $libdir/Config.3 \ + $libdir/CPAN.3 \ + $libdir/CPAN::FirstTime.3 \ + $libdir/CPAN::Nox.3 \ + $libdir/Cwd.3 \ + $libdir/Data::Dumper.3 \ + $libdir/DB_File.3 \ + $libdir/Devel::SelfStubber.3 \ + $libdir/DirHandle.3 \ + $libdir/DynaLoader.3 \ + $libdir/English.3 \ + $libdir/Env.3 \ + $libdir/Errno.3 \ + $libdir/Exporter.3 \ + $libdir/ExtUtils::Command.3 \ + $libdir/ExtUtils::Embed.3 \ + $libdir/ExtUtils::Install.3 \ + $libdir/ExtUtils::Installed.3 \ + $libdir/ExtUtils::Liblist.3 \ + $libdir/ExtUtils::MakeMaker.3 \ + $libdir/ExtUtils::Manifest.3 \ + $libdir/ExtUtils::Miniperl.3 \ + $libdir/ExtUtils::Mkbootstrap.3 \ + $libdir/ExtUtils::Mksymlists.3 \ + $libdir/ExtUtils::MM_OS2.3 \ + $libdir/ExtUtils::MM_Unix.3 \ + $libdir/ExtUtils::MM_VMS.3 \ + $libdir/ExtUtils::MM_Win32.3 \ + $libdir/ExtUtils::Packlist.3 \ + $libdir/ExtUtils::testlib.3 \ + $libdir/Fatal.3 \ + $libdir/Fcntl.3 \ + $libdir/File::Basename.3 \ + $libdir/File::CheckTree.3 \ + $libdir/File::Compare.3 \ + $libdir/File::Copy.3 \ + $libdir/File::DosGlob.3 \ + $libdir/File::Find.3 \ + $libdir/File::Path.3 \ + $libdir/File::Spec.3 \ + $libdir/File::Spec::Mac.3 \ + $libdir/File::Spec::OS2.3 \ + $libdir/File::Spec::Unix.3 \ + $libdir/File::Spec::VMS.3 \ + $libdir/File::Spec::Win32.3 \ + $libdir/File::stat.3 \ + $libdir/FileCache.3 \ + $libdir/FileHandle.3 \ + $libdir/FindBin.3 \ + $libdir/GDBM_File.3 \ + $libdir/Getopt::Long.3 \ + $libdir/Getopt::Std.3 \ + $libdir/I18N::Collate.3 \ + $libdir/IO.3 \ + $libdir/IO::File.3 \ + $libdir/IO::Handle.3 \ + $libdir/IO::Pipe.3 \ + $libdir/IO::Seekable.3 \ + $libdir/IO::Select.3 \ + $libdir/IO::Socket.3 \ + $libdir/IPC::Msg.3 \ + $libdir/IPC::Open2.3 \ + $libdir/IPC::Open3.3 \ + $libdir/IPC::Semaphore.3 \ + $libdir/IPC::SysV.3 \ + $libdir/Math::BigFloat.3 \ + $libdir/Math::BigInt.3 \ + $libdir/Math::Complex.3 \ + $libdir/Math::Trig.3 \ + $libdir/NDBM_File.3 \ + $libdir/Net::hostent.3 \ + $libdir/Net::netent.3 \ + $libdir/Net::Ping.3 \ + $libdir/Net::protoent.3 \ + $libdir/Net::servent.3 \ + $libdir/O.3 \ + $libdir/Opcode.3 \ + $libdir/Pod::Html.3 \ + $libdir/Pod::Text.3 \ + $libdir/POSIX.3 \ + $libdir/Safe.3 \ + $libdir/SDBM_File.3 \ + $libdir/Search::Dict.3 \ + $libdir/SelectSaver.3 \ + $libdir/SelfLoader.3 \ + $libdir/Shell.3 \ + $libdir/Socket.3 \ + $libdir/Symbol.3 \ + $libdir/Sys::Hostname.3 \ + $libdir/Sys::Syslog.3 \ + $libdir/Term::Cap.3 \ + $libdir/Term::Complete.3 \ + $libdir/Term::ReadLine.3 \ + $libdir/Test.3 \ + $libdir/Test::Harness.3 \ + $libdir/Text::Abbrev.3 \ + $libdir/Text::ParseWords.3 \ + $libdir/Text::Soundex.3 \ + $libdir/Text::Tabs.3 \ + $libdir/Text::Wrap.3 \ + $libdir/Tie::Array.3 \ + $libdir/Tie::Handle.3 \ + $libdir/Tie::Hash.3 \ + $libdir/Tie::RefHash.3 \ + $libdir/Tie::Scalar.3 \ + $libdir/Tie::SubstrHash.3 \ + $libdir/Time::gmtime.3 \ + $libdir/Time::Local.3 \ + $libdir/Time::localtime.3 \ + $libdir/Time::tm.3 \ + $libdir/UNIVERSAL.3 \ + $libdir/User::grent.3 \ + $libdir/User::pwent.3 | \ + perl -ne 'map { -r && print "$_ " } split'` + + # Bypass internal shell buffer limit -- can't use case + if perl -e '$a = shift; exit($a =~ m|/|)' $toroff; then + echo "$me: empty file list -- did you run install?" >&2 + exit 1 + fi + + #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw + #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw + + # First, create the raw data + run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" + echo "$me: running $run" + eval $run $toroff + + #Now create the TOC + echo "$me: parsing TOC" + ./rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man + run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext" + echo "$me: running $run" + eval $run + + # Finally, recreate the Doc, without the blank page 0 + run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw" + echo "$me: running $run" + eval $run $toroff + rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw + echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext" + diff --git a/contrib/perl5/pod/rofftoc b/contrib/perl5/pod/rofftoc new file mode 100755 index 00000000000..a2d0e7ba204 --- /dev/null +++ b/contrib/perl5/pod/rofftoc @@ -0,0 +1,66 @@ +# feed this into perl + eval 'exec perl -S $0 ${1+"$@"}' + if $running_under_some_shell; + +# Usage: rofftoc PerlTOC.xxx.raw +# +# Post-processes roffitall output. Called from roffitall to produce +# a formatted table of contents. +# +# Author: Tom Christiansen + +print <<'EOF'; +.de NP +'.sp 0.8i +.tl ''- % -'' +'bp +'sp 0.5i +.tl ''\fB\s+2Perl Table of Contents\s0\fR'' +'sp 0.3i +.. +.wh -1i NP +.af % i +.sp 0.5i +.tl ''\fB\s+5Perl Table of Contents\s0\fR'' +.sp 0.5i +.nf +.na +EOF +while (<>) { + #chomp; + s/Index://; + ($type, $page, $desc) = split ' ', $_, 3; + $desc =~ s/^"(.*)"$/$1/; + if ($type eq 'Title') { + ($name = $desc) =~ s/ .*//; + next; + } elsif ($type eq 'Name') { + #print STDERR $page, "\t", $desc; + print ".ne 5\n"; + print ".in 0\n"; + print ".sp\n"; + print ".ft B\n"; + print "$desc\n"; + print ".ft P\n"; + print ".in 5n\n"; + } elsif ($type eq 'Header') { + print ".br\n", $page, "\t", $desc; + } elsif ($type eq 'Subsection') { + print ".br\n", $page, "\t\t", $desc; + } elsif ($type eq 'Item') { + next if $desc =~ /\\bu/; + next unless $name =~ /POSIX|func/i; + print ".br\n", $page, "\t\t\t", $desc; + } +} +__END__ +Index:Title 1 "PERL 1" +Index:Name 1 "perl - Practical Extraction and Report Language" +Index:Header 1 "NAME" +Index:Header 1 "SYNOPSIS" +Index:Header 2 "DESCRIPTION" +Index:Item 2 "\(bu Many usability enhancements" +Index:Item 2 "\(bu Simplified grammar" +Index:Item 2 "\(bu Lexical scoping" +Index:Item 2 "\(bu Arbitrarily nested data structures" +Index:Item 2 "\(bu Modularity and reusability" diff --git a/contrib/perl5/pod/splitman b/contrib/perl5/pod/splitman new file mode 100755 index 00000000000..9fe404a0610 --- /dev/null +++ b/contrib/perl5/pod/splitman @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +while (<>) { + if ($seqno = 1 .. /^\.TH/) { + unless ($seqno =~ /e/i) { + $header .= $_; + } + next; + } + + if ( /^\.Ip\s*"(.*)"\s*\d+$/) { + $desking = 0; + $desc = $1; + if (name($desc) ne $myname) { + $myname = name($desc); + print $myname, "\n"; + open(MAN, "> $myname.3pl"); + print MAN <) { + + next unless /^=(?!cut)/ .. /^=cut/; + + if (s/=item (\S+)/$1/) { + #$cur = "POSIX::" . $1; + $next{$cur} = $1; + $cur = $1; + $syn{$cur} .= $_; + next; + } else { + #s,L $name.pod") || die "can't open $name.pod: $!"; + print POD < 4 && defined(_CRAY) && !defined(_CRAYMPP) +# define BW_BITS 32 +# define BW_MASK ((1 << BW_BITS) - 1) +# define BW_SIGN (1 << (BW_BITS - 1)) +# define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK)) +# define BWu(u) ((u) & BW_MASK) +#else +# define BWi(i) (i) +# define BWu(u) (u) +#endif + +/* + * Offset for integer pack/unpack. + * + * On architectures where I16 and I32 aren't really 16 and 32 bits, + * which for now are all Crays, pack and unpack have to play games. + */ + +/* + * These values are required for portability of pack() output. + * If they're not right on your machine, then pack() and unpack() + * wouldn't work right anyway; you'll need to apply the Cray hack. + * (I'd like to check them with #if, but you can't use sizeof() in + * the preprocessor.) --??? + */ +/* + The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE + defines are now in config.h. --Andy Dougherty April 1998 + */ +#define SIZE16 2 +#define SIZE32 4 + +#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP) +# if BYTEORDER == 0x12345678 +# define OFF16(p) (char*)(p) +# define OFF32(p) (char*)(p) +# else +# if BYTEORDER == 0x87654321 +# define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16)) +# define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32)) +# else + }}}} bad cray byte order +# endif +# endif +# define COPY16(s,p) (*(p) = 0, Copy(s, OFF16(p), SIZE16, char)) +# define COPY32(s,p) (*(p) = 0, Copy(s, OFF32(p), SIZE32, char)) +# define CAT16(sv,p) sv_catpvn(sv, OFF16(p), SIZE16) +# define CAT32(sv,p) sv_catpvn(sv, OFF32(p), SIZE32) +#else +# define COPY16(s,p) Copy(s, p, SIZE16, char) +# define COPY32(s,p) Copy(s, p, SIZE32, char) +# define CAT16(sv,p) sv_catpvn(sv, (char*)(p), SIZE16) +# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) +#endif + +#ifndef PERL_OBJECT +static void doencodes _((SV* sv, char* s, I32 len)); +static SV* refto _((SV* sv)); +static U32 seed _((void)); +#endif + +static bool srand_called = FALSE; + +/* variations on pp_null */ + +#ifdef I_UNISTD +#include +#endif + +/* XXX I can't imagine anyone who doesn't have this actually _needs_ + it, since pid_t is an integral type. + --AD 2/20/1998 +*/ +#ifdef NEED_GETPID_PROTO +extern Pid_t getpid (void); +#endif + +PP(pp_stub) +{ + djSP; + if (GIMME_V == G_SCALAR) + XPUSHs(&PL_sv_undef); + RETURN; +} + +PP(pp_scalar) +{ + return NORMAL; +} + +/* Pushy stuff. */ + +PP(pp_padav) +{ + djSP; dTARGET; + if (PL_op->op_private & OPpLVAL_INTRO) + SAVECLEARSV(PL_curpad[PL_op->op_targ]); + EXTEND(SP, 1); + if (PL_op->op_flags & OPf_REF) { + PUSHs(TARG); + RETURN; + } + if (GIMME == G_ARRAY) { + I32 maxarg = AvFILL((AV*)TARG) + 1; + EXTEND(SP, maxarg); + if (SvMAGICAL(TARG)) { + U32 i; + for (i=0; i < maxarg; i++) { + SV **svp = av_fetch((AV*)TARG, i, FALSE); + SP[i+1] = (svp) ? *svp : &PL_sv_undef; + } + } + else { + Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*); + } + SP += maxarg; + } + else { + SV* sv = sv_newmortal(); + I32 maxarg = AvFILL((AV*)TARG) + 1; + sv_setiv(sv, maxarg); + PUSHs(sv); + } + RETURN; +} + +PP(pp_padhv) +{ + djSP; dTARGET; + I32 gimme; + + XPUSHs(TARG); + if (PL_op->op_private & OPpLVAL_INTRO) + SAVECLEARSV(PL_curpad[PL_op->op_targ]); + if (PL_op->op_flags & OPf_REF) + RETURN; + gimme = GIMME_V; + if (gimme == G_ARRAY) { + RETURNOP(do_kv(ARGS)); + } + else if (gimme == G_SCALAR) { + SV* sv = sv_newmortal(); + if (HvFILL((HV*)TARG)) + sv_setpvf(sv, "%ld/%ld", + (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1); + else + sv_setiv(sv, 0); + SETs(sv); + } + RETURN; +} + +PP(pp_padany) +{ + DIE("NOT IMPL LINE %d",__LINE__); +} + +/* Translations. */ + +PP(pp_rv2gv) +{ + djSP; dTOPss; + + if (SvROK(sv)) { + wasref: + sv = SvRV(sv); + if (SvTYPE(sv) == SVt_PVIO) { + GV *gv = (GV*) sv_newmortal(); + gv_init(gv, 0, "", 0, 0); + GvIOp(gv) = (IO *)sv; + (void)SvREFCNT_inc(sv); + sv = (SV*) gv; + } else if (SvTYPE(sv) != SVt_PVGV) + DIE("Not a GLOB reference"); + } + else { + if (SvTYPE(sv) != SVt_PVGV) { + char *sym; + + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (PL_op->op_flags & OPf_REF || + PL_op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "a symbol"); + if (PL_dowarn) + warn(warn_uninit); + RETSETUNDEF; + } + sym = SvPV(sv, PL_na); + if (PL_op->op_private & HINT_STRICT_REFS) + DIE(no_symref, sym, "a symbol"); + sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); + } + } + if (PL_op->op_private & OPpLVAL_INTRO) + save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL)); + SETs(sv); + RETURN; +} + +PP(pp_rv2sv) +{ + djSP; dTOPss; + + if (SvROK(sv)) { + wasref: + sv = SvRV(sv); + switch (SvTYPE(sv)) { + case SVt_PVAV: + case SVt_PVHV: + case SVt_PVCV: + DIE("Not a SCALAR reference"); + } + } + else { + GV *gv = (GV*)sv; + char *sym; + + if (SvTYPE(gv) != SVt_PVGV) { + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (PL_op->op_flags & OPf_REF || + PL_op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "a SCALAR"); + if (PL_dowarn) + warn(warn_uninit); + RETSETUNDEF; + } + sym = SvPV(sv, PL_na); + if (PL_op->op_private & HINT_STRICT_REFS) + DIE(no_symref, sym, "a SCALAR"); + gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); + } + sv = GvSV(gv); + } + if (PL_op->op_flags & OPf_MOD) { + if (PL_op->op_private & OPpLVAL_INTRO) + sv = save_scalar((GV*)TOPs); + else if (PL_op->op_private & OPpDEREF) + vivify_ref(sv, PL_op->op_private & OPpDEREF); + } + SETs(sv); + RETURN; +} + +PP(pp_av2arylen) +{ + djSP; + AV *av = (AV*)TOPs; + SV *sv = AvARYLEN(av); + if (!sv) { + AvARYLEN(av) = sv = NEWSV(0,0); + sv_upgrade(sv, SVt_IV); + sv_magic(sv, (SV*)av, '#', Nullch, 0); + } + SETs(sv); + RETURN; +} + +PP(pp_pos) +{ + djSP; dTARGET; dPOPss; + + if (PL_op->op_flags & OPf_MOD) { + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, '.', Nullch, 0); + } + + LvTYPE(TARG) = '.'; + if (LvTARG(TARG) != sv) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(sv); + } + PUSHs(TARG); /* no SvSETMAGIC */ + RETURN; + } + else { + MAGIC* mg; + + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { + mg = mg_find(sv, 'g'); + if (mg && mg->mg_len >= 0) { + PUSHi(mg->mg_len + PL_curcop->cop_arybase); + RETURN; + } + } + RETPUSHUNDEF; + } +} + +PP(pp_rv2cv) +{ + djSP; + GV *gv; + HV *stash; + + /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */ + /* (But not in defined().) */ + CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL)); + if (cv) { + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + } + else + cv = (CV*)&PL_sv_undef; + SETs((SV*)cv); + RETURN; +} + +PP(pp_prototype) +{ + djSP; + CV *cv; + HV *stash; + GV *gv; + SV *ret; + + ret = &PL_sv_undef; + if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { + char *s = SvPVX(TOPs); + if (strnEQ(s, "CORE::", 6)) { + int code; + + code = keyword(s + 6, SvCUR(TOPs) - 6); + if (code < 0) { /* Overridable. */ +#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2) + int i = 0, n = 0, seen_question = 0; + I32 oa; + char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */ + + while (i < MAXO) { /* The slow way. */ + if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i])) + goto found; + i++; + } + goto nonesuch; /* Should not happen... */ + found: + oa = opargs[i] >> OASHIFT; + while (oa) { + if (oa & OA_OPTIONAL) { + seen_question = 1; + str[n++] = ';'; + } else if (seen_question) + goto set; /* XXXX system, exec */ + if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF + && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) { + str[n++] = '\\'; + } + /* What to do with R ((un)tie, tied, (sys)read, recv)? */ + str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; + oa = oa >> 4; + } + str[n++] = '\0'; + ret = sv_2mortal(newSVpv(str, n - 1)); + } else if (code) /* Non-Overridable */ + goto set; + else { /* None such */ + nonesuch: + croak("Cannot find an opnumber for \"%s\"", s+6); + } + } + } + cv = sv_2cv(TOPs, &stash, &gv, FALSE); + if (cv && SvPOK(cv)) + ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv))); + set: + SETs(ret); + RETURN; +} + +PP(pp_anoncode) +{ + djSP; + CV* cv = (CV*)PL_curpad[PL_op->op_targ]; + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + EXTEND(SP,1); + PUSHs((SV*)cv); + RETURN; +} + +PP(pp_srefgen) +{ + djSP; + *SP = refto(*SP); + RETURN; +} + +PP(pp_refgen) +{ + djSP; dMARK; + if (GIMME != G_ARRAY) { + if (++MARK <= SP) + *MARK = *SP; + else + *MARK = &PL_sv_undef; + *MARK = refto(*MARK); + SP = MARK; + RETURN; + } + EXTEND_MORTAL(SP - MARK); + while (++MARK <= SP) + *MARK = refto(*MARK); + RETURN; +} + +STATIC SV* +refto(SV *sv) +{ + SV* rv; + + if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { + if (LvTARGLEN(sv)) + vivify_defelem(sv); + if (!(sv = LvTARG(sv))) + sv = &PL_sv_undef; + } + else if (SvPADTMP(sv)) + sv = newSVsv(sv); + else { + SvTEMP_off(sv); + (void)SvREFCNT_inc(sv); + } + rv = sv_newmortal(); + sv_upgrade(rv, SVt_RV); + SvRV(rv) = sv; + SvROK_on(rv); + return rv; +} + +PP(pp_ref) +{ + djSP; dTARGET; + SV *sv; + char *pv; + + sv = POPs; + + if (sv && SvGMAGICAL(sv)) + mg_get(sv); + + if (!sv || !SvROK(sv)) + RETPUSHNO; + + sv = SvRV(sv); + pv = sv_reftype(sv,TRUE); + PUSHp(pv, strlen(pv)); + RETURN; +} + +PP(pp_bless) +{ + djSP; + HV *stash; + + if (MAXARG == 1) + stash = PL_curcop->cop_stash; + else { + SV *ssv = POPs; + STRLEN len; + char *ptr = SvPV(ssv,len); + if (PL_dowarn && len == 0) + warn("Explicit blessing to '' (assuming package main)"); + stash = gv_stashpvn(ptr, len, TRUE); + } + + (void)sv_bless(TOPs, stash); + RETURN; +} + +PP(pp_gelem) +{ + GV *gv; + SV *sv; + SV *tmpRef; + char *elem; + djSP; + + sv = POPs; + elem = SvPV(sv, PL_na); + gv = (GV*)POPs; + tmpRef = Nullsv; + sv = Nullsv; + switch (elem ? *elem : '\0') + { + case 'A': + if (strEQ(elem, "ARRAY")) + tmpRef = (SV*)GvAV(gv); + break; + case 'C': + if (strEQ(elem, "CODE")) + tmpRef = (SV*)GvCVu(gv); + break; + case 'F': + if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ + tmpRef = (SV*)GvIOp(gv); + break; + case 'G': + if (strEQ(elem, "GLOB")) + tmpRef = (SV*)gv; + break; + case 'H': + if (strEQ(elem, "HASH")) + tmpRef = (SV*)GvHV(gv); + break; + case 'I': + if (strEQ(elem, "IO")) + tmpRef = (SV*)GvIOp(gv); + break; + case 'N': + if (strEQ(elem, "NAME")) + sv = newSVpv(GvNAME(gv), GvNAMELEN(gv)); + break; + case 'P': + if (strEQ(elem, "PACKAGE")) + sv = newSVpv(HvNAME(GvSTASH(gv)), 0); + break; + case 'S': + if (strEQ(elem, "SCALAR")) + tmpRef = GvSV(gv); + break; + } + if (tmpRef) + sv = newRV(tmpRef); + if (sv) + sv_2mortal(sv); + else + sv = &PL_sv_undef; + XPUSHs(sv); + RETURN; +} + +/* Pattern matching */ + +PP(pp_study) +{ + djSP; dPOPss; + register UNOP *unop = cUNOP; + register unsigned char *s; + register I32 pos; + register I32 ch; + register I32 *sfirst; + register I32 *snext; + STRLEN len; + + if (sv == PL_lastscream) { + if (SvSCREAM(sv)) + RETPUSHYES; + } + else { + if (PL_lastscream) { + SvSCREAM_off(PL_lastscream); + SvREFCNT_dec(PL_lastscream); + } + PL_lastscream = SvREFCNT_inc(sv); + } + + s = (unsigned char*)(SvPV(sv, len)); + pos = len; + if (pos <= 0) + RETPUSHNO; + if (pos > PL_maxscream) { + if (PL_maxscream < 0) { + PL_maxscream = pos + 80; + New(301, PL_screamfirst, 256, I32); + New(302, PL_screamnext, PL_maxscream, I32); + } + else { + PL_maxscream = pos + pos / 4; + Renew(PL_screamnext, PL_maxscream, I32); + } + } + + sfirst = PL_screamfirst; + snext = PL_screamnext; + + if (!sfirst || !snext) + DIE("do_study: out of memory"); + + for (ch = 256; ch; --ch) + *sfirst++ = -1; + sfirst -= 256; + + while (--pos >= 0) { + ch = s[pos]; + if (sfirst[ch] >= 0) + snext[pos] = sfirst[ch] - pos; + else + snext[pos] = -pos; + sfirst[ch] = pos; + } + + SvSCREAM_on(sv); + sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ + RETPUSHYES; +} + +PP(pp_trans) +{ + djSP; dTARG; + SV *sv; + + if (PL_op->op_flags & OPf_STACKED) + sv = POPs; + else { + sv = DEFSV; + EXTEND(SP,1); + } + TARG = sv_newmortal(); + PUSHi(do_trans(sv, PL_op)); + RETURN; +} + +/* Lvalue operators. */ + +PP(pp_schop) +{ + djSP; dTARGET; + do_chop(TARG, TOPs); + SETTARG; + RETURN; +} + +PP(pp_chop) +{ + djSP; dMARK; dTARGET; + while (SP > MARK) + do_chop(TARG, POPs); + PUSHTARG; + RETURN; +} + +PP(pp_schomp) +{ + djSP; dTARGET; + SETi(do_chomp(TOPs)); + RETURN; +} + +PP(pp_chomp) +{ + djSP; dMARK; dTARGET; + register I32 count = 0; + + while (SP > MARK) + count += do_chomp(POPs); + PUSHi(count); + RETURN; +} + +PP(pp_defined) +{ + djSP; + register SV* sv; + + sv = POPs; + if (!sv || !SvANY(sv)) + RETPUSHNO; + switch (SvTYPE(sv)) { + case SVt_PVAV: + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)) + RETPUSHYES; + break; + case SVt_PVHV: + if (HvARRAY(sv) || SvGMAGICAL(sv)) + RETPUSHYES; + break; + case SVt_PVCV: + if (CvROOT(sv) || CvXSUB(sv)) + RETPUSHYES; + break; + default: + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvOK(sv)) + RETPUSHYES; + } + RETPUSHNO; +} + +PP(pp_undef) +{ + djSP; + SV *sv; + + if (!PL_op->op_private) { + EXTEND(SP, 1); + RETPUSHUNDEF; + } + + sv = POPs; + if (!sv) + RETPUSHUNDEF; + + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) + RETPUSHUNDEF; + if (SvROK(sv)) + sv_unref(sv); + } + + switch (SvTYPE(sv)) { + case SVt_NULL: + break; + case SVt_PVAV: + av_undef((AV*)sv); + break; + case SVt_PVHV: + hv_undef((HV*)sv); + break; + case SVt_PVCV: + if (PL_dowarn && cv_const_sv((CV*)sv)) + warn("Constant subroutine %s undefined", + CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); + /* FALL THROUGH */ + case SVt_PVFM: + { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); + cv_undef((CV*)sv); + CvGV((CV*)sv) = gv; } /* let user-undef'd sub keep its identity */ + break; + case SVt_PVGV: + if (SvFAKE(sv)) + SvSetMagicSV(sv, &PL_sv_undef); + else { + GP *gp; + gp_free((GV*)sv); + Newz(602, gp, 1, GP); + GvGP(sv) = gp_ref(gp); + GvSV(sv) = NEWSV(72,0); + GvLINE(sv) = PL_curcop->cop_line; + GvEGV(sv) = (GV*)sv; + GvMULTI_on(sv); + } + break; + default: + if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { + (void)SvOOK_off(sv); + Safefree(SvPVX(sv)); + SvPV_set(sv, Nullch); + SvLEN_set(sv, 0); + } + (void)SvOK_off(sv); + SvSETMAGIC(sv); + } + + RETPUSHUNDEF; +} + +PP(pp_predec) +{ + djSP; + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + croak(no_modify); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MIN) + { + --SvIVX(TOPs); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); + } + else + sv_dec(TOPs); + SvSETMAGIC(TOPs); + return NORMAL; +} + +PP(pp_postinc) +{ + djSP; dTARGET; + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + croak(no_modify); + sv_setsv(TARG, TOPs); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MAX) + { + ++SvIVX(TOPs); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); + } + else + sv_inc(TOPs); + SvSETMAGIC(TOPs); + if (!SvOK(TARG)) + sv_setiv(TARG, 0); + SETs(TARG); + return NORMAL; +} + +PP(pp_postdec) +{ + djSP; dTARGET; + if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + croak(no_modify); + sv_setsv(TARG, TOPs); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MIN) + { + --SvIVX(TOPs); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); + } + else + sv_dec(TOPs); + SvSETMAGIC(TOPs); + SETs(TARG); + return NORMAL; +} + +/* Ordinary operators. */ + +PP(pp_pow) +{ + djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + { + dPOPTOPnnrl; + SETn( pow( left, right) ); + RETURN; + } +} + +PP(pp_multiply) +{ + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + { + dPOPTOPnnrl; + SETn( left * right ); + RETURN; + } +} + +PP(pp_divide) +{ + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + { + dPOPPOPnnrl; + double value; + if (right == 0.0) + DIE("Illegal division by zero"); +#ifdef SLOPPYDIVIDE + /* insure that 20./5. == 4. */ + { + IV k; + if ((double)I_V(left) == left && + (double)I_V(right) == right && + (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) { + value = k; + } else { + value = left / right; + } + } +#else + value = left / right; +#endif + PUSHn( value ); + RETURN; + } +} + +PP(pp_modulo) +{ + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + { + UV left; + UV right; + bool left_neg; + bool right_neg; + UV ans; + + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + IV i = SvIVX(POPs); + right = (right_neg = (i < 0)) ? -i : i; + } + else { + double n = POPn; + right = U_V((right_neg = (n < 0)) ? -n : n); + } + + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + IV i = SvIVX(POPs); + left = (left_neg = (i < 0)) ? -i : i; + } + else { + double n = POPn; + left = U_V((left_neg = (n < 0)) ? -n : n); + } + + if (!right) + DIE("Illegal modulus zero"); + + ans = left % right; + 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)+1) + sv_setiv(TARG, ~ans+1); + else + sv_setnv(TARG, -(double)ans); + } + else + sv_setuv(TARG, ans); + PUSHTARG; + RETURN; + } +} + +PP(pp_repeat) +{ + djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); + { + register I32 count = POPi; + if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { + dMARK; + I32 items = SP - MARK; + I32 max; + + max = items * count; + MEXTEND(MARK, max); + if (count > 1) { + while (SP > MARK) { + if (*SP) + SvTEMP_off((*SP)); + SP--; + } + MARK++; + repeatcpy((char*)(MARK + items), (char*)MARK, + items * sizeof(SV*), count - 1); + SP += max; + } + else if (count <= 0) + SP -= items; + } + else { /* Note: mark already snarfed by pp_list */ + SV *tmpstr; + STRLEN len; + + tmpstr = POPs; + if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) { + if (SvREADONLY(tmpstr) && PL_curcop != &PL_compiling) + DIE("Can't x= to readonly value"); + if (SvROK(tmpstr)) + sv_unref(tmpstr); + } + SvSetSV(TARG, tmpstr); + SvPV_force(TARG, len); + if (count != 1) { + if (count < 1) + SvCUR_set(TARG, 0); + else { + SvGROW(TARG, (count * len) + 1); + repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1); + SvCUR(TARG) *= count; + } + *SvEND(TARG) = '\0'; + } + (void)SvPOK_only(TARG); + PUSHTARG; + } + RETURN; + } +} + +PP(pp_subtract) +{ + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + { + dPOPTOPnnrl_ul; + SETn( left - right ); + RETURN; + } +} + +PP(pp_left_shift) +{ + djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + { + IBW shift = POPi; + if (PL_op->op_private & HINT_INTEGER) { + IBW i = TOPi; + i = BWi(i) << shift; + SETi(BWi(i)); + } + else { + UBW u = TOPu; + u <<= shift; + SETu(BWu(u)); + } + RETURN; + } +} + +PP(pp_right_shift) +{ + djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + { + IBW shift = POPi; + if (PL_op->op_private & HINT_INTEGER) { + IBW i = TOPi; + i = BWi(i) >> shift; + SETi(BWi(i)); + } + else { + UBW u = TOPu; + u >>= shift; + SETu(BWu(u)); + } + RETURN; + } +} + +PP(pp_lt) +{ + djSP; tryAMAGICbinSET(lt,0); + { + dPOPnv; + SETs(boolSV(TOPn < value)); + RETURN; + } +} + +PP(pp_gt) +{ + djSP; tryAMAGICbinSET(gt,0); + { + dPOPnv; + SETs(boolSV(TOPn > value)); + RETURN; + } +} + +PP(pp_le) +{ + djSP; tryAMAGICbinSET(le,0); + { + dPOPnv; + SETs(boolSV(TOPn <= value)); + RETURN; + } +} + +PP(pp_ge) +{ + djSP; tryAMAGICbinSET(ge,0); + { + dPOPnv; + SETs(boolSV(TOPn >= value)); + RETURN; + } +} + +PP(pp_ne) +{ + djSP; tryAMAGICbinSET(ne,0); + { + dPOPnv; + SETs(boolSV(TOPn != value)); + RETURN; + } +} + +PP(pp_ncmp) +{ + djSP; dTARGET; tryAMAGICbin(ncmp,0); + { + dPOPTOPnnrl; + I32 value; + + if (left == right) + value = 0; + else if (left < right) + value = -1; + else if (left > right) + value = 1; + else { + SETs(&PL_sv_undef); + RETURN; + } + SETi(value); + RETURN; + } +} + +PP(pp_slt) +{ + djSP; tryAMAGICbinSET(slt,0); + { + dPOPTOPssrl; + int cmp = ((PL_op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs(boolSV(cmp < 0)); + RETURN; + } +} + +PP(pp_sgt) +{ + djSP; tryAMAGICbinSET(sgt,0); + { + dPOPTOPssrl; + int cmp = ((PL_op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs(boolSV(cmp > 0)); + RETURN; + } +} + +PP(pp_sle) +{ + djSP; tryAMAGICbinSET(sle,0); + { + dPOPTOPssrl; + int cmp = ((PL_op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs(boolSV(cmp <= 0)); + RETURN; + } +} + +PP(pp_sge) +{ + djSP; tryAMAGICbinSET(sge,0); + { + dPOPTOPssrl; + int cmp = ((PL_op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs(boolSV(cmp >= 0)); + RETURN; + } +} + +PP(pp_seq) +{ + djSP; tryAMAGICbinSET(seq,0); + { + dPOPTOPssrl; + SETs(boolSV(sv_eq(left, right))); + RETURN; + } +} + +PP(pp_sne) +{ + djSP; tryAMAGICbinSET(sne,0); + { + dPOPTOPssrl; + SETs(boolSV(!sv_eq(left, right))); + RETURN; + } +} + +PP(pp_scmp) +{ + djSP; dTARGET; tryAMAGICbin(scmp,0); + { + dPOPTOPssrl; + int cmp = ((PL_op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETi( cmp ); + RETURN; + } +} + +PP(pp_bit_and) +{ + djSP; dATARGET; tryAMAGICbin(band,opASSIGN); + { + dPOPTOPssrl; + if (SvNIOKp(left) || SvNIOKp(right)) { + if (PL_op->op_private & HINT_INTEGER) { + IBW value = SvIV(left) & SvIV(right); + SETi(BWi(value)); + } + else { + UBW value = SvUV(left) & SvUV(right); + SETu(BWu(value)); + } + } + else { + do_vop(PL_op->op_type, TARG, left, right); + SETTARG; + } + RETURN; + } +} + +PP(pp_bit_xor) +{ + djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + { + dPOPTOPssrl; + if (SvNIOKp(left) || SvNIOKp(right)) { + if (PL_op->op_private & HINT_INTEGER) { + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + SETi(BWi(value)); + } + else { + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + SETu(BWu(value)); + } + } + else { + do_vop(PL_op->op_type, TARG, left, right); + SETTARG; + } + RETURN; + } +} + +PP(pp_bit_or) +{ + djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + { + dPOPTOPssrl; + if (SvNIOKp(left) || SvNIOKp(right)) { + if (PL_op->op_private & HINT_INTEGER) { + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + SETi(BWi(value)); + } + else { + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + SETu(BWu(value)); + } + } + else { + do_vop(PL_op->op_type, TARG, left, right); + SETTARG; + } + RETURN; + } +} + +PP(pp_negate) +{ + djSP; dTARGET; tryAMAGICun(neg); + { + dTOPss; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN) + SETi(-SvIVX(sv)); + else if (SvNIOKp(sv)) + SETn(-SvNV(sv)); + else if (SvPOKp(sv)) { + STRLEN len; + char *s = SvPV(sv, len); + if (isIDFIRST(*s)) { + sv_setpvn(TARG, "-", 1); + sv_catsv(TARG, sv); + } + else if (*s == '+' || *s == '-') { + sv_setsv(TARG, sv); + *SvPV_force(TARG, len) = *s == '-' ? '+' : '-'; + } + else + sv_setnv(TARG, -SvNV(sv)); + SETTARG; + } + else + SETn(-SvNV(sv)); + } + RETURN; +} + +PP(pp_not) +{ +#ifdef OVERLOAD + djSP; tryAMAGICunSET(not); +#endif /* OVERLOAD */ + *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); + return NORMAL; +} + +PP(pp_complement) +{ + djSP; dTARGET; tryAMAGICun(compl); + { + dTOPss; + if (SvNIOKp(sv)) { + if (PL_op->op_private & HINT_INTEGER) { + IBW value = ~SvIV(sv); + SETi(BWi(value)); + } + else { + UBW value = ~SvUV(sv); + SETu(BWu(value)); + } + } + else { + register char *tmps; + register long *tmpl; + register I32 anum; + STRLEN len; + + SvSetSV(TARG, sv); + tmps = SvPV_force(TARG, len); + anum = len; +#ifdef LIBERAL + for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) + *tmps = ~*tmps; + tmpl = (long*)tmps; + for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++) + *tmpl = ~*tmpl; + tmps = (char*)tmpl; +#endif + for ( ; anum > 0; anum--, tmps++) + *tmps = ~*tmps; + + SETs(TARG); + } + RETURN; + } +} + +/* integer versions of some of the above */ + +PP(pp_i_multiply) +{ + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + { + dPOPTOPiirl; + SETi( left * right ); + RETURN; + } +} + +PP(pp_i_divide) +{ + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + { + dPOPiv; + if (value == 0) + DIE("Illegal division by zero"); + value = POPi / value; + PUSHi( value ); + RETURN; + } +} + +PP(pp_i_modulo) +{ + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + { + dPOPTOPiirl; + if (!right) + DIE("Illegal modulus zero"); + SETi( left % right ); + RETURN; + } +} + +PP(pp_i_add) +{ + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + { + dPOPTOPiirl; + SETi( left + right ); + RETURN; + } +} + +PP(pp_i_subtract) +{ + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + { + dPOPTOPiirl; + SETi( left - right ); + RETURN; + } +} + +PP(pp_i_lt) +{ + djSP; tryAMAGICbinSET(lt,0); + { + dPOPTOPiirl; + SETs(boolSV(left < right)); + RETURN; + } +} + +PP(pp_i_gt) +{ + djSP; tryAMAGICbinSET(gt,0); + { + dPOPTOPiirl; + SETs(boolSV(left > right)); + RETURN; + } +} + +PP(pp_i_le) +{ + djSP; tryAMAGICbinSET(le,0); + { + dPOPTOPiirl; + SETs(boolSV(left <= right)); + RETURN; + } +} + +PP(pp_i_ge) +{ + djSP; tryAMAGICbinSET(ge,0); + { + dPOPTOPiirl; + SETs(boolSV(left >= right)); + RETURN; + } +} + +PP(pp_i_eq) +{ + djSP; tryAMAGICbinSET(eq,0); + { + dPOPTOPiirl; + SETs(boolSV(left == right)); + RETURN; + } +} + +PP(pp_i_ne) +{ + djSP; tryAMAGICbinSET(ne,0); + { + dPOPTOPiirl; + SETs(boolSV(left != right)); + RETURN; + } +} + +PP(pp_i_ncmp) +{ + djSP; dTARGET; tryAMAGICbin(ncmp,0); + { + dPOPTOPiirl; + I32 value; + + if (left > right) + value = 1; + else if (left < right) + value = -1; + else + value = 0; + SETi(value); + RETURN; + } +} + +PP(pp_i_negate) +{ + djSP; dTARGET; tryAMAGICun(neg); + SETi(-TOPi); + RETURN; +} + +/* High falutin' math. */ + +PP(pp_atan2) +{ + djSP; dTARGET; tryAMAGICbin(atan2,0); + { + dPOPTOPnnrl; + SETn(atan2(left, right)); + RETURN; + } +} + +PP(pp_sin) +{ + djSP; dTARGET; tryAMAGICun(sin); + { + double value; + value = POPn; + value = sin(value); + XPUSHn(value); + RETURN; + } +} + +PP(pp_cos) +{ + djSP; dTARGET; tryAMAGICun(cos); + { + double value; + value = POPn; + value = cos(value); + XPUSHn(value); + RETURN; + } +} + +/* Support Configure command-line overrides for rand() functions. + After 5.005, perhaps we should replace this by Configure support + for drand48(), random(), or rand(). For 5.005, though, maintain + compatibility by calling rand() but allow the user to override it. + See INSTALL for details. --Andy Dougherty 15 July 1998 +*/ +#ifndef my_rand +# define my_rand rand +#endif +#ifndef my_srand +# define my_srand srand +#endif + +PP(pp_rand) +{ + djSP; dTARGET; + double value; + if (MAXARG < 1) + value = 1.0; + else + value = POPn; + if (value == 0.0) + value = 1.0; + if (!srand_called) { + (void)my_srand((unsigned)seed()); + srand_called = TRUE; + } +#if RANDBITS == 31 + value = my_rand() * value / 2147483648.0; +#else +#if RANDBITS == 16 + value = my_rand() * value / 65536.0; +#else +#if RANDBITS == 15 + value = my_rand() * value / 32768.0; +#else + value = my_rand() * value / (double)(((unsigned long)1) << RANDBITS); +#endif +#endif +#endif + XPUSHn(value); + RETURN; +} + +PP(pp_srand) +{ + djSP; + UV anum; + if (MAXARG < 1) + anum = seed(); + else + anum = POPu; + (void)my_srand((unsigned)anum); + srand_called = TRUE; + EXTEND(SP, 1); + RETPUSHYES; +} + +STATIC U32 +seed(void) +{ + /* + * This is really just a quick hack which grabs various garbage + * values. It really should be a real hash algorithm which + * spreads the effect of every input bit onto every output bit, + * if someone who knows about such tings would bother to write it. + * Might be a good idea to add that function to CORE as well. + * No numbers below come from careful analysis or anyting here, + * except they are primes and SEED_C1 > 1E6 to get a full-width + * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should + * probably be bigger too. + */ +#if RANDBITS > 16 +# define SEED_C1 1000003 +#define SEED_C4 73819 +#else +# define SEED_C1 25747 +#define SEED_C4 20639 +#endif +#define SEED_C2 3 +#define SEED_C3 269 +#define SEED_C5 26107 + + dTHR; + U32 u; +#ifdef VMS +# include + /* when[] = (low 32 bits, high 32 bits) of time since epoch + * in 100-ns units, typically incremented ever 10 ms. */ + unsigned int when[2]; + _ckvmssts(sys$gettim(when)); + u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1]; +#else +# ifdef HAS_GETTIMEOFDAY + struct timeval when; + gettimeofday(&when,(struct timezone *) 0); + u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec; +# else + Time_t when; + (void)time(&when); + u = (U32)SEED_C1 * when; +# endif +#endif + u += SEED_C3 * (U32)getpid(); + u += SEED_C4 * (U32)(UV)PL_stack_sp; +#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ + u += SEED_C5 * (U32)(UV)&when; +#endif + return u; +} + +PP(pp_exp) +{ + djSP; dTARGET; tryAMAGICun(exp); + { + double value; + value = POPn; + value = exp(value); + XPUSHn(value); + RETURN; + } +} + +PP(pp_log) +{ + djSP; dTARGET; tryAMAGICun(log); + { + double value; + value = POPn; + if (value <= 0.0) { + SET_NUMERIC_STANDARD(); + DIE("Can't take log of %g", value); + } + value = log(value); + XPUSHn(value); + RETURN; + } +} + +PP(pp_sqrt) +{ + djSP; dTARGET; tryAMAGICun(sqrt); + { + double value; + value = POPn; + if (value < 0.0) { + SET_NUMERIC_STANDARD(); + DIE("Can't take sqrt of %g", value); + } + value = sqrt(value); + XPUSHn(value); + RETURN; + } +} + +PP(pp_int) +{ + djSP; dTARGET; + { + double value = TOPn; + IV iv; + + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) { + iv = SvIVX(TOPs); + SETi(iv); + } + else { + if (value >= 0.0) + (void)modf(value, &value); + else { + (void)modf(-value, &value); + value = -value; + } + iv = I_V(value); + if (iv == value) + SETi(iv); + else + SETn(value); + } + } + RETURN; +} + +PP(pp_abs) +{ + djSP; dTARGET; tryAMAGICun(abs); + { + double value = TOPn; + IV iv; + + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) && + (iv = SvIVX(TOPs)) != IV_MIN) { + if (iv < 0) + iv = -iv; + SETi(iv); + } + else { + if (value < 0.0) + value = -value; + SETn(value); + } + } + RETURN; +} + +PP(pp_hex) +{ + djSP; dTARGET; + char *tmps; + I32 argtype; + + tmps = POPp; + XPUSHu(scan_hex(tmps, 99, &argtype)); + RETURN; +} + +PP(pp_oct) +{ + djSP; dTARGET; + UV value; + I32 argtype; + char *tmps; + + tmps = POPp; + while (*tmps && isSPACE(*tmps)) + tmps++; + if (*tmps == '0') + tmps++; + if (*tmps == 'x') + value = scan_hex(++tmps, 99, &argtype); + else + value = scan_oct(tmps, 99, &argtype); + XPUSHu(value); + RETURN; +} + +/* String stuff. */ + +PP(pp_length) +{ + djSP; dTARGET; + SETi( sv_len(TOPs) ); + RETURN; +} + +PP(pp_substr) +{ + djSP; dTARGET; + SV *sv; + I32 len; + STRLEN curlen; + I32 pos; + I32 rem; + I32 fail; + I32 lvalue = PL_op->op_flags & OPf_MOD; + char *tmps; + I32 arybase = PL_curcop->cop_arybase; + char *repl = 0; + STRLEN repl_len; + + SvTAINTED_off(TARG); /* decontaminate */ + if (MAXARG > 2) { + if (MAXARG > 3) { + sv = POPs; + repl = SvPV(sv, repl_len); + } + len = POPi; + } + pos = POPi; + sv = POPs; + PUTBACK; + tmps = SvPV(sv, curlen); + if (pos >= arybase) { + pos -= arybase; + rem = curlen-pos; + fail = rem; + if (MAXARG > 2) { + if (len < 0) { + rem += len; + if (rem < 0) + rem = 0; + } + else if (rem > len) + rem = len; + } + } + else { + pos += curlen; + if (MAXARG < 3) + rem = curlen; + else if (len >= 0) { + rem = pos+len; + if (rem > (I32)curlen) + rem = curlen; + } + else { + rem = curlen+len; + if (rem < pos) + rem = pos; + } + if (pos < 0) + pos = 0; + fail = rem; + rem -= pos; + } + if (fail < 0) { + if (PL_dowarn || lvalue || repl) + warn("substr outside of string"); + RETPUSHUNDEF; + } + else { + tmps += pos; + sv_setpvn(TARG, tmps, rem); + if (lvalue) { /* it's an lvalue! */ + if (!SvGMAGICAL(sv)) { + if (SvROK(sv)) { + SvPV_force(sv,PL_na); + if (PL_dowarn) + warn("Attempt to use reference as lvalue in substr"); + } + if (SvOK(sv)) /* is it defined ? */ + (void)SvPOK_only(sv); + else + sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ + } + + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, 'x', Nullch, 0); + } + + LvTYPE(TARG) = 'x'; + if (LvTARG(TARG) != sv) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(sv); + } + LvTARGOFF(TARG) = pos; + LvTARGLEN(TARG) = rem; + } + else if (repl) + sv_insert(sv, pos, rem, repl, repl_len); + } + SPAGAIN; + PUSHs(TARG); /* avoid SvSETMAGIC here */ + RETURN; +} + +PP(pp_vec) +{ + djSP; dTARGET; + register I32 size = POPi; + register I32 offset = POPi; + register SV *src = POPs; + I32 lvalue = PL_op->op_flags & OPf_MOD; + STRLEN srclen; + unsigned char *s = (unsigned char*)SvPV(src, srclen); + unsigned long retnum; + I32 len; + + SvTAINTED_off(TARG); /* decontaminate */ + offset *= size; /* turn into bit offset */ + len = (offset + size + 7) / 8; + if (offset < 0 || size < 1) + retnum = 0; + else { + if (lvalue) { /* it's an lvalue! */ + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, 'v', Nullch, 0); + } + + LvTYPE(TARG) = 'v'; + if (LvTARG(TARG) != src) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(src); + } + LvTARGOFF(TARG) = offset; + LvTARGLEN(TARG) = size; + } + if (len > srclen) { + if (size <= 8) + retnum = 0; + else { + offset >>= 3; + if (size == 16) { + if (offset >= srclen) + retnum = 0; + else + retnum = (unsigned long) s[offset] << 8; + } + else if (size == 32) { + if (offset >= srclen) + retnum = 0; + else if (offset + 1 >= srclen) + retnum = (unsigned long) s[offset] << 24; + else if (offset + 2 >= srclen) + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16); + else + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16) + + (s[offset + 2] << 8); + } + } + } + else if (size < 8) + retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); + else { + offset >>= 3; + if (size == 8) + retnum = s[offset]; + else if (size == 16) + retnum = ((unsigned long) s[offset] << 8) + s[offset+1]; + else if (size == 32) + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16) + + (s[offset + 2] << 8) + s[offset+3]; + } + } + + sv_setuv(TARG, (UV)retnum); + PUSHs(TARG); + RETURN; +} + +PP(pp_index) +{ + djSP; dTARGET; + SV *big; + SV *little; + I32 offset; + I32 retval; + char *tmps; + char *tmps2; + STRLEN biglen; + I32 arybase = PL_curcop->cop_arybase; + + if (MAXARG < 3) + offset = 0; + else + offset = POPi - arybase; + little = POPs; + big = POPs; + tmps = SvPV(big, biglen); + if (offset < 0) + offset = 0; + else if (offset > biglen) + offset = biglen; + if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset, + (unsigned char*)tmps + biglen, little, 0))) + retval = -1 + arybase; + else + retval = tmps2 - tmps + arybase; + PUSHi(retval); + RETURN; +} + +PP(pp_rindex) +{ + djSP; dTARGET; + SV *big; + SV *little; + STRLEN blen; + STRLEN llen; + SV *offstr; + I32 offset; + I32 retval; + char *tmps; + char *tmps2; + I32 arybase = PL_curcop->cop_arybase; + + if (MAXARG >= 3) + offstr = POPs; + little = POPs; + big = POPs; + tmps2 = SvPV(little, llen); + tmps = SvPV(big, blen); + if (MAXARG < 3) + offset = blen; + else + offset = SvIV(offstr) - arybase + llen; + if (offset < 0) + offset = 0; + else if (offset > blen) + offset = blen; + if (!(tmps2 = rninstr(tmps, tmps + offset, + tmps2, tmps2 + llen))) + retval = -1 + arybase; + else + retval = tmps2 - tmps + arybase; + PUSHi(retval); + RETURN; +} + +PP(pp_sprintf) +{ + djSP; dMARK; dORIGMARK; dTARGET; +#ifdef USE_LOCALE_NUMERIC + if (PL_op->op_private & OPpLOCALE) + SET_NUMERIC_LOCAL(); + else + SET_NUMERIC_STANDARD(); +#endif + do_sprintf(TARG, SP-MARK, MARK+1); + TAINT_IF(SvTAINTED(TARG)); + SP = ORIGMARK; + PUSHTARG; + RETURN; +} + +PP(pp_ord) +{ + djSP; dTARGET; + I32 value; + char *tmps; + +#ifndef I286 + tmps = POPp; + value = (I32) (*tmps & 255); +#else + I32 anum; + tmps = POPp; + anum = (I32) *tmps; + value = (I32) (anum & 255); +#endif + XPUSHi(value); + RETURN; +} + +PP(pp_chr) +{ + djSP; dTARGET; + char *tmps; + + (void)SvUPGRADE(TARG,SVt_PV); + SvGROW(TARG,2); + SvCUR_set(TARG, 1); + tmps = SvPVX(TARG); + *tmps++ = POPi; + *tmps = '\0'; + (void)SvPOK_only(TARG); + XPUSHs(TARG); + RETURN; +} + +PP(pp_crypt) +{ + djSP; dTARGET; dPOPTOPssrl; +#ifdef HAS_CRYPT + char *tmps = SvPV(left, PL_na); +#ifdef FCRYPT + sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na))); +#else + sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na))); +#endif +#else + DIE( + "The crypt() function is unimplemented due to excessive paranoia."); +#endif + SETs(TARG); + RETURN; +} + +PP(pp_ucfirst) +{ + djSP; + SV *sv = TOPs; + register char *s; + + if (!SvPADTMP(sv)) { + dTARGET; + sv_setsv(TARG, sv); + sv = TARG; + SETs(sv); + } + s = SvPV_force(sv, PL_na); + if (*s) { + if (PL_op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + *s = toUPPER_LC(*s); + } + else + *s = toUPPER(*s); + } + + RETURN; +} + +PP(pp_lcfirst) +{ + djSP; + SV *sv = TOPs; + register char *s; + + if (!SvPADTMP(sv)) { + dTARGET; + sv_setsv(TARG, sv); + sv = TARG; + SETs(sv); + } + s = SvPV_force(sv, PL_na); + if (*s) { + if (PL_op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + *s = toLOWER_LC(*s); + } + else + *s = toLOWER(*s); + } + + SETs(sv); + RETURN; +} + +PP(pp_uc) +{ + djSP; + SV *sv = TOPs; + register char *s; + STRLEN len; + + if (!SvPADTMP(sv)) { + dTARGET; + sv_setsv(TARG, sv); + sv = TARG; + SETs(sv); + } + + s = SvPV_force(sv, len); + if (len) { + register char *send = s + len; + + if (PL_op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + for (; s < send; s++) + *s = toUPPER_LC(*s); + } + else { + for (; s < send; s++) + *s = toUPPER(*s); + } + } + RETURN; +} + +PP(pp_lc) +{ + djSP; + SV *sv = TOPs; + register char *s; + STRLEN len; + + if (!SvPADTMP(sv)) { + dTARGET; + sv_setsv(TARG, sv); + sv = TARG; + SETs(sv); + } + + s = SvPV_force(sv, len); + if (len) { + register char *send = s + len; + + if (PL_op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + for (; s < send; s++) + *s = toLOWER_LC(*s); + } + else { + for (; s < send; s++) + *s = toLOWER(*s); + } + } + RETURN; +} + +PP(pp_quotemeta) +{ + djSP; dTARGET; + SV *sv = TOPs; + STRLEN len; + register char *s = SvPV(sv,len); + register char *d; + + if (len) { + (void)SvUPGRADE(TARG, SVt_PV); + SvGROW(TARG, (len * 2) + 1); + d = SvPVX(TARG); + while (len--) { + if (!isALNUM(*s)) + *d++ = '\\'; + *d++ = *s++; + } + *d = '\0'; + SvCUR_set(TARG, d - SvPVX(TARG)); + (void)SvPOK_only(TARG); + } + else + sv_setpvn(TARG, s, len); + SETs(TARG); + RETURN; +} + +/* Arrays. */ + +PP(pp_aslice) +{ + djSP; dMARK; dORIGMARK; + register SV** svp; + register AV* av = (AV*)POPs; + register I32 lval = PL_op->op_flags & OPf_MOD; + I32 arybase = PL_curcop->cop_arybase; + I32 elem; + + if (SvTYPE(av) == SVt_PVAV) { + if (lval && PL_op->op_private & OPpLVAL_INTRO) { + I32 max = -1; + for (svp = MARK + 1; svp <= SP; svp++) { + elem = SvIVx(*svp); + if (elem > max) + max = elem; + } + if (max > AvMAX(av)) + av_extend(av, max); + } + while (++MARK <= SP) { + elem = SvIVx(*MARK); + + if (elem > 0) + elem -= arybase; + svp = av_fetch(av, elem, lval); + if (lval) { + if (!svp || *svp == &PL_sv_undef) + DIE(no_aelem, elem); + if (PL_op->op_private & OPpLVAL_INTRO) + save_aelem(av, elem, svp); + } + *MARK = svp ? *svp : &PL_sv_undef; + } + } + if (GIMME != G_ARRAY) { + MARK = ORIGMARK; + *++MARK = *SP; + SP = MARK; + } + RETURN; +} + +/* Associative arrays. */ + +PP(pp_each) +{ + djSP; dTARGET; + HV *hash = (HV*)POPs; + HE *entry; + I32 gimme = GIMME_V; + I32 realhv = (SvTYPE(hash) == SVt_PVHV); + + PUTBACK; + /* might clobber stack_sp */ + entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash); + SPAGAIN; + + EXTEND(SP, 2); + if (entry) { + PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ + if (gimme == G_ARRAY) { + PUTBACK; + /* might clobber stack_sp */ + sv_setsv(TARG, realhv ? + hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry)); + SPAGAIN; + PUSHs(TARG); + } + } + else if (gimme == G_SCALAR) + RETPUSHUNDEF; + + RETURN; +} + +PP(pp_values) +{ + return do_kv(ARGS); +} + +PP(pp_keys) +{ + return do_kv(ARGS); +} + +PP(pp_delete) +{ + djSP; + I32 gimme = GIMME_V; + I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; + SV *sv; + HV *hv; + + if (PL_op->op_private & OPpSLICE) { + dMARK; dORIGMARK; + U32 hvtype; + hv = (HV*)POPs; + hvtype = SvTYPE(hv); + while (++MARK <= SP) { + if (hvtype == SVt_PVHV) + sv = hv_delete_ent(hv, *MARK, discard, 0); + else + DIE("Not a HASH reference"); + *MARK = sv ? sv : &PL_sv_undef; + } + if (discard) + SP = ORIGMARK; + else if (gimme == G_SCALAR) { + MARK = ORIGMARK; + *++MARK = *SP; + SP = MARK; + } + } + else { + SV *keysv = POPs; + hv = (HV*)POPs; + if (SvTYPE(hv) == SVt_PVHV) + sv = hv_delete_ent(hv, keysv, discard, 0); + else + DIE("Not a HASH reference"); + if (!sv) + sv = &PL_sv_undef; + if (!discard) + PUSHs(sv); + } + RETURN; +} + +PP(pp_exists) +{ + djSP; + SV *tmpsv = POPs; + HV *hv = (HV*)POPs; + if (SvTYPE(hv) == SVt_PVHV) { + if (hv_exists_ent(hv, tmpsv, 0)) + RETPUSHYES; + } else if (SvTYPE(hv) == SVt_PVAV) { + if (avhv_exists_ent((AV*)hv, tmpsv, 0)) + RETPUSHYES; + } else { + DIE("Not a HASH reference"); + } + RETPUSHNO; +} + +PP(pp_hslice) +{ + djSP; dMARK; dORIGMARK; + register HV *hv = (HV*)POPs; + register I32 lval = PL_op->op_flags & OPf_MOD; + I32 realhv = (SvTYPE(hv) == SVt_PVHV); + + if (!realhv && PL_op->op_private & OPpLVAL_INTRO) + DIE("Can't localize pseudo-hash element"); + + if (realhv || SvTYPE(hv) == SVt_PVAV) { + while (++MARK <= SP) { + SV *keysv = *MARK; + SV **svp; + if (realhv) { + HE *he = hv_fetch_ent(hv, keysv, lval, 0); + svp = he ? &HeVAL(he) : 0; + } else { + svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0); + } + if (lval) { + if (!svp || *svp == &PL_sv_undef) + DIE(no_helem, SvPV(keysv, PL_na)); + if (PL_op->op_private & OPpLVAL_INTRO) + save_helem(hv, keysv, svp); + } + *MARK = svp ? *svp : &PL_sv_undef; + } + } + if (GIMME != G_ARRAY) { + MARK = ORIGMARK; + *++MARK = *SP; + SP = MARK; + } + RETURN; +} + +/* List operators. */ + +PP(pp_list) +{ + djSP; dMARK; + if (GIMME != G_ARRAY) { + if (++MARK <= SP) + *MARK = *SP; /* unwanted list, return last item */ + else + *MARK = &PL_sv_undef; + SP = MARK; + } + RETURN; +} + +PP(pp_lslice) +{ + djSP; + SV **lastrelem = PL_stack_sp; + SV **lastlelem = PL_stack_base + POPMARK; + SV **firstlelem = PL_stack_base + POPMARK + 1; + register SV **firstrelem = lastlelem + 1; + I32 arybase = PL_curcop->cop_arybase; + I32 lval = PL_op->op_flags & OPf_MOD; + I32 is_something_there = lval; + + register I32 max = lastrelem - lastlelem; + register SV **lelem; + register I32 ix; + + if (GIMME != G_ARRAY) { + ix = SvIVx(*lastlelem); + if (ix < 0) + ix += max; + else + ix -= arybase; + if (ix < 0 || ix >= max) + *firstlelem = &PL_sv_undef; + else + *firstlelem = firstrelem[ix]; + SP = firstlelem; + RETURN; + } + + if (max == 0) { + SP = firstlelem - 1; + RETURN; + } + + for (lelem = firstlelem; lelem <= lastlelem; lelem++) { + ix = SvIVx(*lelem); + if (ix < 0) { + ix += max; + if (ix < 0) + *lelem = &PL_sv_undef; + else if (!(*lelem = firstrelem[ix])) + *lelem = &PL_sv_undef; + } + else { + ix -= arybase; + if (ix >= max || !(*lelem = firstrelem[ix])) + *lelem = &PL_sv_undef; + } + if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem))) + is_something_there = TRUE; + } + if (is_something_there) + SP = lastlelem; + else + SP = firstlelem - 1; + RETURN; +} + +PP(pp_anonlist) +{ + djSP; dMARK; dORIGMARK; + I32 items = SP - MARK; + SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); + SP = ORIGMARK; /* av_make() might realloc stack_sp */ + XPUSHs(av); + RETURN; +} + +PP(pp_anonhash) +{ + djSP; dMARK; dORIGMARK; + HV* hv = (HV*)sv_2mortal((SV*)newHV()); + + while (MARK < SP) { + SV* key = *++MARK; + SV *val = NEWSV(46, 0); + if (MARK < SP) + sv_setsv(val, *++MARK); + else if (PL_dowarn) + warn("Odd number of elements in hash assignment"); + (void)hv_store_ent(hv,key,val,0); + } + SP = ORIGMARK; + XPUSHs((SV*)hv); + RETURN; +} + +PP(pp_splice) +{ + djSP; dMARK; dORIGMARK; + register AV *ary = (AV*)*++MARK; + register SV **src; + register SV **dst; + register I32 i; + register I32 offset; + register I32 length; + I32 newlen; + I32 after; + I32 diff; + SV **tmparyval = 0; + MAGIC *mg; + + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("SPLICE",GIMME_V); + LEAVE; + SPAGAIN; + RETURN; + } + + SP++; + + if (++MARK < SP) { + offset = i = SvIVx(*MARK); + if (offset < 0) + offset += AvFILLp(ary) + 1; + else + offset -= PL_curcop->cop_arybase; + if (offset < 0) + DIE(no_aelem, i); + if (++MARK < SP) { + length = SvIVx(*MARK++); + if (length < 0) { + length += AvFILLp(ary) - offset + 1; + if (length < 0) + length = 0; + } + } + else + length = AvMAX(ary) + 1; /* close enough to infinity */ + } + else { + offset = 0; + length = AvMAX(ary) + 1; + } + if (offset > AvFILLp(ary) + 1) + offset = AvFILLp(ary) + 1; + after = AvFILLp(ary) + 1 - (offset + length); + if (after < 0) { /* not that much array */ + length += after; /* offset+length now in array */ + after = 0; + if (!AvALLOC(ary)) + av_extend(ary, 0); + } + + /* At this point, MARK .. SP-1 is our new LIST */ + + newlen = SP - MARK; + diff = newlen - length; + if (newlen && !AvREAL(ary)) { + if (AvREIFY(ary)) + av_reify(ary); + else + assert(AvREAL(ary)); /* would leak, so croak */ + } + + if (diff < 0) { /* shrinking the area */ + if (newlen) { + New(451, tmparyval, newlen, SV*); /* so remember insertion */ + Copy(MARK, tmparyval, newlen, SV*); + } + + MARK = ORIGMARK + 1; + if (GIMME == G_ARRAY) { /* copy return vals to stack */ + MEXTEND(MARK, length); + Copy(AvARRAY(ary)+offset, MARK, length, SV*); + if (AvREAL(ary)) { + EXTEND_MORTAL(length); + for (i = length, dst = MARK; i; i--) { + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } + } + MARK += length - 1; + } + else { + *MARK = AvARRAY(ary)[offset+length-1]; + if (AvREAL(ary)) { + sv_2mortal(*MARK); + for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) + SvREFCNT_dec(*dst++); /* free them now */ + } + } + AvFILLp(ary) += diff; + + /* pull up or down? */ + + if (offset < after) { /* easier to pull up */ + if (offset) { /* esp. if nothing to pull */ + src = &AvARRAY(ary)[offset-1]; + dst = src - diff; /* diff is negative */ + for (i = offset; i > 0; i--) /* can't trust Copy */ + *dst-- = *src--; + } + dst = AvARRAY(ary); + SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */ + AvMAX(ary) += diff; + } + else { + if (after) { /* anything to pull down? */ + src = AvARRAY(ary) + offset + length; + dst = src + diff; /* diff is negative */ + Move(src, dst, after, SV*); + } + dst = &AvARRAY(ary)[AvFILLp(ary)+1]; + /* avoid later double free */ + } + i = -diff; + while (i) + dst[--i] = &PL_sv_undef; + + if (newlen) { + for (src = tmparyval, dst = AvARRAY(ary) + offset; + newlen; newlen--) { + *dst = NEWSV(46, 0); + sv_setsv(*dst++, *src++); + } + Safefree(tmparyval); + } + } + else { /* no, expanding (or same) */ + if (length) { + New(452, tmparyval, length, SV*); /* so remember deletion */ + Copy(AvARRAY(ary)+offset, tmparyval, length, SV*); + } + + if (diff > 0) { /* expanding */ + + /* push up or down? */ + + if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) { + if (offset) { + src = AvARRAY(ary); + dst = src - diff; + Move(src, dst, offset, SV*); + } + SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */ + AvMAX(ary) += diff; + AvFILLp(ary) += diff; + } + else { + if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */ + av_extend(ary, AvFILLp(ary) + diff); + AvFILLp(ary) += diff; + + if (after) { + dst = AvARRAY(ary) + AvFILLp(ary); + src = dst - diff; + for (i = after; i; i--) { + *dst-- = *src--; + } + } + } + } + + for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) { + *dst = NEWSV(46, 0); + sv_setsv(*dst++, *src++); + } + MARK = ORIGMARK + 1; + if (GIMME == G_ARRAY) { /* copy return vals to stack */ + if (length) { + Copy(tmparyval, MARK, length, SV*); + if (AvREAL(ary)) { + EXTEND_MORTAL(length); + for (i = length, dst = MARK; i; i--) { + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } + } + Safefree(tmparyval); + } + MARK += length - 1; + } + else if (length--) { + *MARK = tmparyval[length]; + if (AvREAL(ary)) { + sv_2mortal(*MARK); + while (length-- > 0) + SvREFCNT_dec(tmparyval[length]); + } + Safefree(tmparyval); + } + else + *MARK = &PL_sv_undef; + } + SP = MARK; + RETURN; +} + +PP(pp_push) +{ + djSP; dMARK; dORIGMARK; dTARGET; + register AV *ary = (AV*)*++MARK; + register SV *sv = &PL_sv_undef; + MAGIC *mg; + + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("PUSH",G_SCALAR|G_DISCARD); + LEAVE; + SPAGAIN; + } + else { + /* Why no pre-extend of ary here ? */ + for (++MARK; MARK <= SP; MARK++) { + sv = NEWSV(51, 0); + if (*MARK) + sv_setsv(sv, *MARK); + av_push(ary, sv); + } + } + SP = ORIGMARK; + PUSHi( AvFILL(ary) + 1 ); + RETURN; +} + +PP(pp_pop) +{ + djSP; + AV *av = (AV*)POPs; + SV *sv = av_pop(av); + if (AvREAL(av)) + (void)sv_2mortal(sv); + PUSHs(sv); + RETURN; +} + +PP(pp_shift) +{ + djSP; + AV *av = (AV*)POPs; + SV *sv = av_shift(av); + EXTEND(SP, 1); + if (!sv) + RETPUSHUNDEF; + if (AvREAL(av)) + (void)sv_2mortal(sv); + PUSHs(sv); + RETURN; +} + +PP(pp_unshift) +{ + djSP; dMARK; dORIGMARK; dTARGET; + register AV *ary = (AV*)*++MARK; + register SV *sv; + register I32 i = 0; + MAGIC *mg; + + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD); + LEAVE; + SPAGAIN; + } + else { + av_unshift(ary, SP - MARK); + while (MARK < SP) { + sv = NEWSV(27, 0); + sv_setsv(sv, *++MARK); + (void)av_store(ary, i++, sv); + } + } + SP = ORIGMARK; + PUSHi( AvFILL(ary) + 1 ); + RETURN; +} + +PP(pp_reverse) +{ + djSP; dMARK; + register SV *tmp; + SV **oldsp = SP; + + if (GIMME == G_ARRAY) { + MARK++; + while (MARK < SP) { + tmp = *MARK; + *MARK++ = *SP; + *SP-- = tmp; + } + SP = oldsp; + } + else { + register char *up; + register char *down; + register I32 tmp; + dTARGET; + STRLEN len; + + if (SP - MARK > 1) + do_join(TARG, &PL_sv_no, MARK, SP); + else + sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV); + up = SvPV_force(TARG, len); + if (len > 1) { + down = SvPVX(TARG) + len - 1; + while (down > up) { + tmp = *up; + *up++ = *down; + *down-- = tmp; + } + (void)SvPOK_only(TARG); + } + SP = MARK + 1; + SETTARG; + } + RETURN; +} + +STATIC SV * +mul128(SV *sv, U8 m) +{ + STRLEN len; + char *s = SvPV(sv, len); + char *t; + U32 i = 0; + + if (!strnEQ(s, "0000", 4)) { /* need to grow sv */ + SV *tmpNew = newSVpv("0000000000", 10); + + sv_catsv(tmpNew, sv); + SvREFCNT_dec(sv); /* free old sv */ + sv = tmpNew; + s = SvPV(sv, len); + } + t = s + len - 1; + while (!*t) /* trailing '\0'? */ + t--; + while (t > s) { + i = ((*t - '0') << 7) + m; + *(t--) = '0' + (i % 10); + m = i / 10; + } + return (sv); +} + +/* Explosives and implosives. */ + +static const char uuemap[] = + "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; +static char uudmap[256]; /* Initialised on first use */ +#if 'I' == 73 && 'J' == 74 +/* On an ASCII/ISO kind of system */ +#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a') +#else +/* + Some other sort of character set - use memchr() so we don't match + the null byte. + */ +#define ISUUCHAR(ch) (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ') +#endif + +PP(pp_unpack) +{ + djSP; + dPOPPOPssrl; + SV **oldsp = SP; + I32 gimme = GIMME_V; + SV *sv; + STRLEN llen; + STRLEN rlen; + register char *pat = SvPV(left, llen); + register char *s = SvPV(right, rlen); + char *strend = s + rlen; + char *strbeg = s; + register char *patend = pat + llen; + I32 datumtype; + register I32 len; + register I32 bits; + + /* These must not be in registers: */ + I16 ashort; + int aint; + I32 along; +#ifdef HAS_QUAD + Quad_t aquad; +#endif + U16 aushort; + unsigned int auint; + U32 aulong; +#ifdef HAS_QUAD + unsigned Quad_t auquad; +#endif + char *aptr; + float afloat; + double adouble; + I32 checksum = 0; + register U32 culong; + double cdouble; + static char* bitcount = 0; + int commas = 0; + + if (gimme != G_ARRAY) { /* arrange to do first one only */ + /*SUPPRESS 530*/ + for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ; + if (strchr("aAbBhHP", *patend) || *pat == '%') { + patend++; + while (isDIGIT(*patend) || *patend == '*') + patend++; + } + else + patend++; + } + while (pat < patend) { + reparse: + datumtype = *pat++ & 0xFF; + if (isSPACE(datumtype)) + continue; + if (pat >= patend) + len = 1; + else if (*pat == '*') { + len = strend - strbeg; /* long enough */ + pat++; + } + else if (isDIGIT(*pat)) { + len = *pat++ - '0'; + while (isDIGIT(*pat)) + len = (len * 10) + (*pat++ - '0'); + } + else + len = (datumtype != '@'); + switch(datumtype) { + default: + croak("Invalid type in unpack: '%c'", (int)datumtype); + case ',': /* grandfather in commas but with a warning */ + if (commas++ == 0 && PL_dowarn) + warn("Invalid type in unpack: '%c'", (int)datumtype); + break; + case '%': + if (len == 1 && pat[-1] != '1') + len = 16; + checksum = len; + culong = 0; + cdouble = 0; + if (pat < patend) + goto reparse; + break; + case '@': + if (len > strend - strbeg) + DIE("@ outside of string"); + s = strbeg + len; + break; + case 'X': + if (len > s - strbeg) + DIE("X outside of string"); + s -= len; + break; + case 'x': + if (len > strend - s) + DIE("x outside of string"); + s += len; + break; + case 'A': + case 'a': + if (len > strend - s) + len = strend - s; + if (checksum) + goto uchar_checksum; + sv = NEWSV(35, len); + sv_setpvn(sv, s, len); + s += len; + if (datumtype == 'A') { + aptr = s; /* borrow register */ + s = SvPVX(sv) + len - 1; + while (s >= SvPVX(sv) && (!*s || isSPACE(*s))) + s--; + *++s = '\0'; + SvCUR_set(sv, s - SvPVX(sv)); + s = aptr; /* unborrow register */ + } + XPUSHs(sv_2mortal(sv)); + break; + case 'B': + case 'b': + if (pat[-1] == '*' || len > (strend - s) * 8) + len = (strend - s) * 8; + if (checksum) { + if (!bitcount) { + Newz(601, bitcount, 256, char); + for (bits = 1; bits < 256; bits++) { + if (bits & 1) bitcount[bits]++; + if (bits & 2) bitcount[bits]++; + if (bits & 4) bitcount[bits]++; + if (bits & 8) bitcount[bits]++; + if (bits & 16) bitcount[bits]++; + if (bits & 32) bitcount[bits]++; + if (bits & 64) bitcount[bits]++; + if (bits & 128) bitcount[bits]++; + } + } + while (len >= 8) { + culong += bitcount[*(unsigned char*)s++]; + len -= 8; + } + if (len) { + bits = *s; + if (datumtype == 'b') { + while (len-- > 0) { + if (bits & 1) culong++; + bits >>= 1; + } + } + else { + while (len-- > 0) { + if (bits & 128) culong++; + bits <<= 1; + } + } + } + break; + } + sv = NEWSV(35, len + 1); + SvCUR_set(sv, len); + SvPOK_on(sv); + aptr = pat; /* borrow register */ + pat = SvPVX(sv); + if (datumtype == 'b') { + aint = len; + for (len = 0; len < aint; len++) { + if (len & 7) /*SUPPRESS 595*/ + bits >>= 1; + else + bits = *s++; + *pat++ = '0' + (bits & 1); + } + } + else { + aint = len; + for (len = 0; len < aint; len++) { + if (len & 7) + bits <<= 1; + else + bits = *s++; + *pat++ = '0' + ((bits & 128) != 0); + } + } + *pat = '\0'; + pat = aptr; /* unborrow register */ + XPUSHs(sv_2mortal(sv)); + break; + case 'H': + case 'h': + if (pat[-1] == '*' || len > (strend - s) * 2) + len = (strend - s) * 2; + sv = NEWSV(35, len + 1); + SvCUR_set(sv, len); + SvPOK_on(sv); + aptr = pat; /* borrow register */ + pat = SvPVX(sv); + if (datumtype == 'h') { + aint = len; + for (len = 0; len < aint; len++) { + if (len & 1) + bits >>= 4; + else + bits = *s++; + *pat++ = PL_hexdigit[bits & 15]; + } + } + else { + aint = len; + for (len = 0; len < aint; len++) { + if (len & 1) + bits <<= 4; + else + bits = *s++; + *pat++ = PL_hexdigit[(bits >> 4) & 15]; + } + } + *pat = '\0'; + pat = aptr; /* unborrow register */ + XPUSHs(sv_2mortal(sv)); + break; + case 'c': + if (len > strend - s) + len = strend - s; + if (checksum) { + while (len-- > 0) { + aint = *s++; + if (aint >= 128) /* fake up signed chars */ + aint -= 256; + culong += aint; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + aint = *s++; + if (aint >= 128) /* fake up signed chars */ + aint -= 256; + sv = NEWSV(36, 0); + sv_setiv(sv, (IV)aint); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'C': + if (len > strend - s) + len = strend - s; + if (checksum) { + uchar_checksum: + while (len-- > 0) { + auint = *s++ & 255; + culong += auint; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + auint = *s++ & 255; + sv = NEWSV(37, 0); + sv_setiv(sv, (IV)auint); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 's': + along = (strend - s) / SIZE16; + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + COPY16(s, &ashort); + s += SIZE16; + culong += ashort; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + COPY16(s, &ashort); + s += SIZE16; + sv = NEWSV(38, 0); + sv_setiv(sv, (IV)ashort); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'v': + case 'n': + case 'S': + along = (strend - s) / SIZE16; + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + COPY16(s, &aushort); + s += SIZE16; +#ifdef HAS_NTOHS + if (datumtype == 'n') + aushort = PerlSock_ntohs(aushort); +#endif +#ifdef HAS_VTOHS + if (datumtype == 'v') + aushort = vtohs(aushort); +#endif + culong += aushort; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + COPY16(s, &aushort); + s += SIZE16; + sv = NEWSV(39, 0); +#ifdef HAS_NTOHS + if (datumtype == 'n') + aushort = PerlSock_ntohs(aushort); +#endif +#ifdef HAS_VTOHS + if (datumtype == 'v') + aushort = vtohs(aushort); +#endif + sv_setiv(sv, (IV)aushort); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'i': + along = (strend - s) / sizeof(int); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + Copy(s, &aint, 1, int); + s += sizeof(int); + if (checksum > 32) + cdouble += (double)aint; + else + culong += aint; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + Copy(s, &aint, 1, int); + s += sizeof(int); + sv = NEWSV(40, 0); +#ifdef __osf__ + /* Without the dummy below unpack("i", pack("i",-1)) + * return 0xFFffFFff instead of -1 for Digital Unix V4.0 + * cc with optimization turned on */ + (aint) ? + sv_setiv(sv, (IV)aint) : +#endif + sv_setiv(sv, (IV)aint); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'I': + along = (strend - s) / sizeof(unsigned int); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + Copy(s, &auint, 1, unsigned int); + s += sizeof(unsigned int); + if (checksum > 32) + cdouble += (double)auint; + else + culong += auint; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + Copy(s, &auint, 1, unsigned int); + s += sizeof(unsigned int); + sv = NEWSV(41, 0); + sv_setuv(sv, (UV)auint); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'l': + along = (strend - s) / SIZE32; + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + COPY32(s, &along); + s += SIZE32; + if (checksum > 32) + cdouble += (double)along; + else + culong += along; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + COPY32(s, &along); + s += SIZE32; + sv = NEWSV(42, 0); + sv_setiv(sv, (IV)along); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'V': + case 'N': + case 'L': + along = (strend - s) / SIZE32; + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + COPY32(s, &aulong); + s += SIZE32; +#ifdef HAS_NTOHL + if (datumtype == 'N') + aulong = PerlSock_ntohl(aulong); +#endif +#ifdef HAS_VTOHL + if (datumtype == 'V') + aulong = vtohl(aulong); +#endif + if (checksum > 32) + cdouble += (double)aulong; + else + culong += aulong; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + COPY32(s, &aulong); + s += SIZE32; +#ifdef HAS_NTOHL + if (datumtype == 'N') + aulong = PerlSock_ntohl(aulong); +#endif +#ifdef HAS_VTOHL + if (datumtype == 'V') + aulong = vtohl(aulong); +#endif + sv = NEWSV(43, 0); + sv_setuv(sv, (UV)aulong); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'p': + along = (strend - s) / sizeof(char*); + if (len > along) + len = along; + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + if (sizeof(char*) > strend - s) + break; + else { + Copy(s, &aptr, 1, char*); + s += sizeof(char*); + } + sv = NEWSV(44, 0); + if (aptr) + sv_setpv(sv, aptr); + PUSHs(sv_2mortal(sv)); + } + break; + case 'w': + EXTEND(SP, len); + EXTEND_MORTAL(len); + { + UV auv = 0; + U32 bytes = 0; + + while ((len > 0) && (s < strend)) { + auv = (auv << 7) | (*s & 0x7f); + if (!(*s++ & 0x80)) { + bytes = 0; + sv = NEWSV(40, 0); + sv_setuv(sv, auv); + PUSHs(sv_2mortal(sv)); + len--; + auv = 0; + } + else if (++bytes >= sizeof(UV)) { /* promote to string */ + char *t; + + sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv); + while (s < strend) { + sv = mul128(sv, *s & 0x7f); + if (!(*s++ & 0x80)) { + bytes = 0; + break; + } + } + t = SvPV(sv, PL_na); + while (*t == '0') + t++; + sv_chop(sv, t); + PUSHs(sv_2mortal(sv)); + len--; + auv = 0; + } + } + if ((s >= strend) && bytes) + croak("Unterminated compressed integer"); + } + break; + case 'P': + EXTEND(SP, 1); + if (sizeof(char*) > strend - s) + break; + else { + Copy(s, &aptr, 1, char*); + s += sizeof(char*); + } + sv = NEWSV(44, 0); + if (aptr) + sv_setpvn(sv, aptr, len); + PUSHs(sv_2mortal(sv)); + break; +#ifdef HAS_QUAD + case 'q': + along = (strend - s) / sizeof(Quad_t); + if (len > along) + len = along; + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + if (s + sizeof(Quad_t) > strend) + aquad = 0; + else { + Copy(s, &aquad, 1, Quad_t); + s += sizeof(Quad_t); + } + sv = NEWSV(42, 0); + if (aquad >= IV_MIN && aquad <= IV_MAX) + sv_setiv(sv, (IV)aquad); + else + sv_setnv(sv, (double)aquad); + PUSHs(sv_2mortal(sv)); + } + break; + case 'Q': + along = (strend - s) / sizeof(Quad_t); + if (len > along) + len = along; + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + if (s + sizeof(unsigned Quad_t) > strend) + auquad = 0; + else { + Copy(s, &auquad, 1, unsigned Quad_t); + s += sizeof(unsigned Quad_t); + } + sv = NEWSV(43, 0); + if (auquad <= UV_MAX) + sv_setuv(sv, (UV)auquad); + else + sv_setnv(sv, (double)auquad); + PUSHs(sv_2mortal(sv)); + } + break; +#endif + /* float and double added gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + case 'F': + along = (strend - s) / sizeof(float); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + Copy(s, &afloat, 1, float); + s += sizeof(float); + cdouble += afloat; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + Copy(s, &afloat, 1, float); + s += sizeof(float); + sv = NEWSV(47, 0); + sv_setnv(sv, (double)afloat); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'd': + case 'D': + along = (strend - s) / sizeof(double); + if (len > along) + len = along; + if (checksum) { + while (len-- > 0) { + Copy(s, &adouble, 1, double); + s += sizeof(double); + cdouble += adouble; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + Copy(s, &adouble, 1, double); + s += sizeof(double); + sv = NEWSV(48, 0); + sv_setnv(sv, (double)adouble); + PUSHs(sv_2mortal(sv)); + } + } + break; + case 'u': + /* MKS: + * Initialise the decode mapping. By using a table driven + * algorithm, the code will be character-set independent + * (and just as fast as doing character arithmetic) + */ + if (uudmap['M'] == 0) { + int i; + + for (i = 0; i < sizeof(uuemap); i += 1) + uudmap[uuemap[i]] = i; + /* + * Because ' ' and '`' map to the same value, + * we need to decode them both the same. + */ + uudmap[' '] = 0; + } + + along = (strend - s) * 3 / 4; + sv = NEWSV(42, along); + if (along) + SvPOK_on(sv); + while (s < strend && *s > ' ' && ISUUCHAR(*s)) { + I32 a, b, c, d; + char hunk[4]; + + hunk[3] = '\0'; + len = (*s++ - ' ') & 077; + while (len > 0) { + if (s < strend && ISUUCHAR(*s)) + a = uudmap[*s++] & 077; + else + a = 0; + if (s < strend && ISUUCHAR(*s)) + b = uudmap[*s++] & 077; + else + b = 0; + if (s < strend && ISUUCHAR(*s)) + c = uudmap[*s++] & 077; + else + c = 0; + if (s < strend && ISUUCHAR(*s)) + d = uudmap[*s++] & 077; + else + d = 0; + hunk[0] = (a << 2) | (b >> 4); + hunk[1] = (b << 4) | (c >> 2); + hunk[2] = (c << 6) | d; + sv_catpvn(sv, hunk, (len > 3) ? 3 : len); + len -= 3; + } + if (*s == '\n') + s++; + else if (s[1] == '\n') /* possible checksum byte */ + s += 2; + } + XPUSHs(sv_2mortal(sv)); + break; + } + if (checksum) { + sv = NEWSV(42, 0); + if (strchr("fFdD", datumtype) || + (checksum > 32 && strchr("iIlLN", datumtype)) ) { + double trouble; + + adouble = 1.0; + while (checksum >= 16) { + checksum -= 16; + adouble *= 65536.0; + } + while (checksum >= 4) { + checksum -= 4; + adouble *= 16.0; + } + while (checksum--) + adouble *= 2.0; + along = (1 << checksum) - 1; + while (cdouble < 0.0) + cdouble += adouble; + cdouble = modf(cdouble / adouble, &trouble) * adouble; + sv_setnv(sv, cdouble); + } + else { + if (checksum < 32) { + aulong = (1 << checksum) - 1; + culong &= aulong; + } + sv_setuv(sv, (UV)culong); + } + XPUSHs(sv_2mortal(sv)); + checksum = 0; + } + } + if (SP == oldsp && gimme == G_SCALAR) + PUSHs(&PL_sv_undef); + RETURN; +} + +STATIC void +doencodes(register SV *sv, register char *s, register I32 len) +{ + char hunk[5]; + + *hunk = uuemap[len]; + sv_catpvn(sv, hunk, 1); + hunk[4] = '\0'; + while (len > 2) { + hunk[0] = uuemap[(077 & (*s >> 2))]; + hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))]; + hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; + hunk[3] = uuemap[(077 & (s[2] & 077))]; + sv_catpvn(sv, hunk, 4); + s += 3; + len -= 3; + } + if (len > 0) { + char r = (len > 1 ? s[1] : '\0'); + hunk[0] = uuemap[(077 & (*s >> 2))]; + hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))]; + hunk[2] = uuemap[(077 & ((r << 2) & 074))]; + hunk[3] = uuemap[0]; + sv_catpvn(sv, hunk, 4); + } + sv_catpvn(sv, "\n", 1); +} + +STATIC SV * +is_an_int(char *s, STRLEN l) +{ + SV *result = newSVpv("", l); + char *result_c = SvPV(result, PL_na); /* convenience */ + char *out = result_c; + bool skip = 1; + bool ignore = 0; + + while (*s) { + switch (*s) { + case ' ': + break; + case '+': + if (!skip) { + SvREFCNT_dec(result); + return (NULL); + } + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + skip = 0; + if (!ignore) { + *(out++) = *s; + } + break; + case '.': + ignore = 1; + break; + default: + SvREFCNT_dec(result); + return (NULL); + } + s++; + } + *(out++) = '\0'; + SvCUR_set(result, out - result_c); + return (result); +} + +STATIC int +div128(SV *pnum, bool *done) + /* must be '\0' terminated */ + +{ + STRLEN len; + char *s = SvPV(pnum, len); + int m = 0; + int r = 0; + char *t = s; + + *done = 1; + while (*t) { + int i; + + i = m * 10 + (*t - '0'); + m = i & 0x7F; + r = (i >> 7); /* r < 10 */ + if (r) { + *done = 0; + } + *(t++) = '0' + r; + } + *(t++) = '\0'; + SvCUR_set(pnum, (STRLEN) (t - s)); + return (m); +} + + +PP(pp_pack) +{ + djSP; dMARK; dORIGMARK; dTARGET; + register SV *cat = TARG; + register I32 items; + STRLEN fromlen; + register char *pat = SvPVx(*++MARK, fromlen); + register char *patend = pat + fromlen; + register I32 len; + I32 datumtype; + SV *fromstr; + /*SUPPRESS 442*/ + static char null10[] = {0,0,0,0,0,0,0,0,0,0}; + static char *space10 = " "; + + /* These must not be in registers: */ + char achar; + I16 ashort; + int aint; + unsigned int auint; + I32 along; + U32 aulong; +#ifdef HAS_QUAD + Quad_t aquad; + unsigned Quad_t auquad; +#endif + char *aptr; + float afloat; + double adouble; + int commas = 0; + + items = SP - MARK; + MARK++; + sv_setpvn(cat, "", 0); + while (pat < patend) { +#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no) + datumtype = *pat++ & 0xFF; + if (isSPACE(datumtype)) + continue; + if (*pat == '*') { + len = strchr("@Xxu", datumtype) ? 0 : items; + pat++; + } + else if (isDIGIT(*pat)) { + len = *pat++ - '0'; + while (isDIGIT(*pat)) + len = (len * 10) + (*pat++ - '0'); + } + else + len = 1; + switch(datumtype) { + default: + croak("Invalid type in pack: '%c'", (int)datumtype); + case ',': /* grandfather in commas but with a warning */ + if (commas++ == 0 && PL_dowarn) + warn("Invalid type in pack: '%c'", (int)datumtype); + break; + case '%': + DIE("%% may only be used in unpack"); + case '@': + len -= SvCUR(cat); + if (len > 0) + goto grow; + len = -len; + if (len > 0) + goto shrink; + break; + case 'X': + shrink: + if (SvCUR(cat) < len) + DIE("X outside of string"); + SvCUR(cat) -= len; + *SvEND(cat) = '\0'; + break; + case 'x': + grow: + while (len >= 10) { + sv_catpvn(cat, null10, 10); + len -= 10; + } + sv_catpvn(cat, null10, len); + break; + case 'A': + case 'a': + fromstr = NEXTFROM; + aptr = SvPV(fromstr, fromlen); + if (pat[-1] == '*') + len = fromlen; + if (fromlen > len) + sv_catpvn(cat, aptr, len); + else { + sv_catpvn(cat, aptr, fromlen); + len -= fromlen; + if (datumtype == 'A') { + while (len >= 10) { + sv_catpvn(cat, space10, 10); + len -= 10; + } + sv_catpvn(cat, space10, len); + } + else { + while (len >= 10) { + sv_catpvn(cat, null10, 10); + len -= 10; + } + sv_catpvn(cat, null10, len); + } + } + break; + case 'B': + case 'b': + { + char *savepat = pat; + I32 saveitems; + + fromstr = NEXTFROM; + saveitems = items; + aptr = SvPV(fromstr, fromlen); + if (pat[-1] == '*') + len = fromlen; + pat = aptr; + aint = SvCUR(cat); + SvCUR(cat) += (len+7)/8; + SvGROW(cat, SvCUR(cat) + 1); + aptr = SvPVX(cat) + aint; + if (len > fromlen) + len = fromlen; + aint = len; + items = 0; + if (datumtype == 'B') { + for (len = 0; len++ < aint;) { + items |= *pat++ & 1; + if (len & 7) + items <<= 1; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + else { + for (len = 0; len++ < aint;) { + if (*pat++ & 1) + items |= 128; + if (len & 7) + items >>= 1; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + if (aint & 7) { + if (datumtype == 'B') + items <<= 7 - (aint & 7); + else + items >>= 7 - (aint & 7); + *aptr++ = items & 0xff; + } + pat = SvPVX(cat) + SvCUR(cat); + while (aptr <= pat) + *aptr++ = '\0'; + + pat = savepat; + items = saveitems; + } + break; + case 'H': + case 'h': + { + char *savepat = pat; + I32 saveitems; + + fromstr = NEXTFROM; + saveitems = items; + aptr = SvPV(fromstr, fromlen); + if (pat[-1] == '*') + len = fromlen; + pat = aptr; + aint = SvCUR(cat); + SvCUR(cat) += (len+1)/2; + SvGROW(cat, SvCUR(cat) + 1); + aptr = SvPVX(cat) + aint; + if (len > fromlen) + len = fromlen; + aint = len; + items = 0; + if (datumtype == 'H') { + for (len = 0; len++ < aint;) { + if (isALPHA(*pat)) + items |= ((*pat++ & 15) + 9) & 15; + else + items |= *pat++ & 15; + if (len & 1) + items <<= 4; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + else { + for (len = 0; len++ < aint;) { + if (isALPHA(*pat)) + items |= (((*pat++ & 15) + 9) & 15) << 4; + else + items |= (*pat++ & 15) << 4; + if (len & 1) + items >>= 4; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + if (aint & 1) + *aptr++ = items & 0xff; + pat = SvPVX(cat) + SvCUR(cat); + while (aptr <= pat) + *aptr++ = '\0'; + + pat = savepat; + items = saveitems; + } + break; + case 'C': + case 'c': + while (len-- > 0) { + fromstr = NEXTFROM; + aint = SvIV(fromstr); + achar = aint; + sv_catpvn(cat, &achar, sizeof(char)); + } + break; + /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + case 'F': + while (len-- > 0) { + fromstr = NEXTFROM; + afloat = (float)SvNV(fromstr); + sv_catpvn(cat, (char *)&afloat, sizeof (float)); + } + break; + case 'd': + case 'D': + while (len-- > 0) { + fromstr = NEXTFROM; + adouble = (double)SvNV(fromstr); + sv_catpvn(cat, (char *)&adouble, sizeof (double)); + } + break; + case 'n': + while (len-- > 0) { + fromstr = NEXTFROM; + ashort = (I16)SvIV(fromstr); +#ifdef HAS_HTONS + ashort = PerlSock_htons(ashort); +#endif + CAT16(cat, &ashort); + } + break; + case 'v': + while (len-- > 0) { + fromstr = NEXTFROM; + ashort = (I16)SvIV(fromstr); +#ifdef HAS_HTOVS + ashort = htovs(ashort); +#endif + CAT16(cat, &ashort); + } + break; + case 'S': + case 's': + while (len-- > 0) { + fromstr = NEXTFROM; + ashort = (I16)SvIV(fromstr); + CAT16(cat, &ashort); + } + break; + case 'I': + while (len-- > 0) { + fromstr = NEXTFROM; + auint = SvUV(fromstr); + sv_catpvn(cat, (char*)&auint, sizeof(unsigned int)); + } + break; + case 'w': + while (len-- > 0) { + fromstr = NEXTFROM; + adouble = floor(SvNV(fromstr)); + + if (adouble < 0) + croak("Cannot compress negative numbers"); + + if ( +#ifdef BW_BITS + adouble <= BW_MASK +#else +#ifdef CXUX_BROKEN_CONSTANT_CONVERT + adouble <= UV_MAX_cxux +#else + adouble <= UV_MAX +#endif +#endif + ) + { + char buf[1 + sizeof(UV)]; + char *in = buf + sizeof(buf); + UV auv = U_V(adouble);; + + do { + *--in = (auv & 0x7f) | 0x80; + auv >>= 7; + } while (auv); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + sv_catpvn(cat, in, (buf + sizeof(buf)) - in); + } + else if (SvPOKp(fromstr)) { /* decimal string arithmetics */ + char *from, *result, *in; + SV *norm; + STRLEN len; + bool done; + + /* Copy string and check for compliance */ + from = SvPV(fromstr, len); + if ((norm = is_an_int(from, len)) == NULL) + croak("can compress only unsigned integer"); + + New('w', result, len, char); + in = result + len; + done = FALSE; + while (!done) + *--in = div128(norm, &done) | 0x80; + result[len - 1] &= 0x7F; /* clear continue bit */ + sv_catpvn(cat, in, (result + len) - in); + Safefree(result); + SvREFCNT_dec(norm); /* free norm */ + } + else if (SvNOKp(fromstr)) { + char buf[sizeof(double) * 2]; /* 8/7 <= 2 */ + char *in = buf + sizeof(buf); + + do { + double next = floor(adouble / 128); + *--in = (unsigned char)(adouble - (next * 128)) | 0x80; + if (--in < buf) /* this cannot happen ;-) */ + croak ("Cannot compress integer"); + adouble = next; + } while (adouble > 0); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + sv_catpvn(cat, in, (buf + sizeof(buf)) - in); + } + else + croak("Cannot compress non integer"); + } + break; + case 'i': + while (len-- > 0) { + fromstr = NEXTFROM; + aint = SvIV(fromstr); + sv_catpvn(cat, (char*)&aint, sizeof(int)); + } + break; + case 'N': + while (len-- > 0) { + fromstr = NEXTFROM; + aulong = SvUV(fromstr); +#ifdef HAS_HTONL + aulong = PerlSock_htonl(aulong); +#endif + CAT32(cat, &aulong); + } + break; + case 'V': + while (len-- > 0) { + fromstr = NEXTFROM; + aulong = SvUV(fromstr); +#ifdef HAS_HTOVL + aulong = htovl(aulong); +#endif + CAT32(cat, &aulong); + } + break; + case 'L': + while (len-- > 0) { + fromstr = NEXTFROM; + aulong = SvUV(fromstr); + CAT32(cat, &aulong); + } + break; + case 'l': + while (len-- > 0) { + fromstr = NEXTFROM; + along = SvIV(fromstr); + CAT32(cat, &along); + } + break; +#ifdef HAS_QUAD + case 'Q': + while (len-- > 0) { + fromstr = NEXTFROM; + auquad = (unsigned Quad_t)SvIV(fromstr); + sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t)); + } + break; + case 'q': + while (len-- > 0) { + fromstr = NEXTFROM; + aquad = (Quad_t)SvIV(fromstr); + sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t)); + } + break; +#endif /* HAS_QUAD */ + case 'P': + len = 1; /* assume SV is correct length */ + /* FALL THROUGH */ + case 'p': + while (len-- > 0) { + fromstr = NEXTFROM; + if (fromstr == &PL_sv_undef) + aptr = NULL; + else { + /* XXX better yet, could spirit away the string to + * a safe spot and hang on to it until the result + * of pack() (and all copies of the result) are + * gone. + */ + if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr))) + warn("Attempt to pack pointer to temporary value"); + if (SvPOK(fromstr) || SvNIOK(fromstr)) + aptr = SvPV(fromstr,PL_na); + else + aptr = SvPV_force(fromstr,PL_na); + } + sv_catpvn(cat, (char*)&aptr, sizeof(char*)); + } + break; + case 'u': + fromstr = NEXTFROM; + aptr = SvPV(fromstr, fromlen); + SvGROW(cat, fromlen * 4 / 3); + if (len <= 1) + len = 45; + else + len = len / 3 * 3; + while (fromlen > 0) { + I32 todo; + + if (fromlen > len) + todo = len; + else + todo = fromlen; + doencodes(cat, aptr, todo); + fromlen -= todo; + aptr += todo; + } + break; + } + } + SvSETMAGIC(cat); + SP = ORIGMARK; + PUSHs(cat); + RETURN; +} +#undef NEXTFROM + + +PP(pp_split) +{ + djSP; dTARG; + AV *ary; + register I32 limit = POPi; /* note, negative is forever */ + SV *sv = POPs; + STRLEN len; + register char *s = SvPV(sv, len); + char *strend = s + len; + register PMOP *pm; + register REGEXP *rx; + register SV *dstr; + register char *m; + I32 iters = 0; + I32 maxiters = (strend - s) + 10; + I32 i; + char *orig; + I32 origlimit = limit; + I32 realarray = 0; + I32 base; + AV *oldstack = PL_curstack; + I32 gimme = GIMME_V; + I32 oldsave = PL_savestack_ix; + I32 make_mortal = 1; + MAGIC *mg = (MAGIC *) NULL; + +#ifdef DEBUGGING + Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*); +#else + pm = (PMOP*)POPs; +#endif + if (!pm || !s) + DIE("panic: do_split"); + rx = pm->op_pmregexp; + + TAINT_IF((pm->op_pmflags & PMf_LOCALE) && + (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE))); + + if (pm->op_pmreplroot) + ary = GvAVn((GV*)pm->op_pmreplroot); + else if (gimme != G_ARRAY) +#ifdef USE_THREADS + ary = (AV*)PL_curpad[0]; +#else + ary = GvAVn(PL_defgv); +#endif /* USE_THREADS */ + else + ary = Nullav; + if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) { + realarray = 1; + PUTBACK; + av_extend(ary,0); + av_clear(ary); + SPAGAIN; + if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) { + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + } + else { + if (!AvREAL(ary)) { + AvREAL_on(ary); + for (i = AvFILLp(ary); i >= 0; i--) + AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ + } + /* temporarily switch stacks */ + SWITCHSTACK(PL_curstack, ary); + make_mortal = 0; + } + } + base = SP - PL_stack_base; + orig = s; + if (pm->op_pmflags & PMf_SKIPWHITE) { + if (pm->op_pmflags & PMf_LOCALE) { + while (isSPACE_LC(*s)) + s++; + } + else { + while (isSPACE(*s)) + s++; + } + } + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(PL_multiline); + PL_multiline = pm->op_pmflags & PMf_MULTILINE; + } + + if (!limit) + limit = maxiters + 2; + if (pm->op_pmflags & PMf_WHITE) { + while (--limit) { + m = s; + while (m < strend && + !((pm->op_pmflags & PMf_LOCALE) + ? isSPACE_LC(*m) : isSPACE(*m))) + ++m; + if (m >= strend) + break; + + dstr = NEWSV(30, m-s); + sv_setpvn(dstr, s, m-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + + s = m + 1; + while (s < strend && + ((pm->op_pmflags & PMf_LOCALE) + ? isSPACE_LC(*s) : isSPACE(*s))) + ++s; + } + } + else if (strEQ("^", rx->precomp)) { + while (--limit) { + /*SUPPRESS 530*/ + for (m = s; m < strend && *m != '\n'; m++) ; + m++; + if (m >= strend) + break; + dstr = NEWSV(30, m-s); + sv_setpvn(dstr, s, m-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + s = m; + } + } + else if (rx->check_substr && !rx->nparens + && (rx->reganch & ROPT_CHECK_ALL) + && !(rx->reganch & ROPT_ANCH)) { + i = SvCUR(rx->check_substr); + if (i == 1 && !SvTAIL(rx->check_substr)) { + i = *SvPVX(rx->check_substr); + while (--limit) { + /*SUPPRESS 530*/ + for (m = s; m < strend && *m != i; m++) ; + if (m >= strend) + break; + dstr = NEWSV(30, m-s); + sv_setpvn(dstr, s, m-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + s = m + 1; + } + } + else { +#ifndef lint + while (s < strend && --limit && + (m=fbm_instr((unsigned char*)s, (unsigned char*)strend, + rx->check_substr, 0)) ) +#endif + { + dstr = NEWSV(31, m-s); + sv_setpvn(dstr, s, m-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + s = m + i; + } + } + } + else { + maxiters += (strend - s) * rx->nparens; + while (s < strend && --limit && + CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0)) + { + TAINT_IF(RX_MATCH_TAINTED(rx)); + if (rx->subbase + && rx->subbase != orig) { + m = s; + s = orig; + orig = rx->subbase; + s = orig + (m - s); + strend = s + (strend - m); + } + m = rx->startp[0]; + dstr = NEWSV(32, m-s); + sv_setpvn(dstr, s, m-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + if (rx->nparens) { + for (i = 1; i <= rx->nparens; i++) { + s = rx->startp[i]; + m = rx->endp[i]; + if (m && s) { + dstr = NEWSV(33, m-s); + sv_setpvn(dstr, s, m-s); + } + else + dstr = NEWSV(33, 0); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + } + } + s = rx->endp[0]; + } + } + + LEAVE_SCOPE(oldsave); + iters = (SP - PL_stack_base) - base; + if (iters > maxiters) + DIE("Split loop"); + + /* keep field after final delim? */ + if (s < strend || (iters && origlimit)) { + dstr = NEWSV(34, strend-s); + sv_setpvn(dstr, s, strend-s); + if (make_mortal) + sv_2mortal(dstr); + XPUSHs(dstr); + iters++; + } + else if (!origlimit) { + while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) + iters--, SP--; + } + + if (realarray) { + if (!mg) { + SWITCHSTACK(ary, oldstack); + if (SvSMAGICAL(ary)) { + PUTBACK; + mg_set((SV*)ary); + SPAGAIN; + } + if (gimme == G_ARRAY) { + EXTEND(SP, iters); + Copy(AvARRAY(ary), SP + 1, iters, SV*); + SP += iters; + RETURN; + } + } + else { + PUTBACK; + ENTER; + perl_call_method("PUSH",G_SCALAR|G_DISCARD); + LEAVE; + SPAGAIN; + if (gimme == G_ARRAY) { + /* EXTEND should not be needed - we just popped them */ + EXTEND(SP, iters); + for (i=0; i < iters; i++) { + SV **svp = av_fetch(ary, i, FALSE); + PUSHs((svp) ? *svp : &PL_sv_undef); + } + RETURN; + } + } + } + else { + if (gimme == G_ARRAY) + RETURN; + } + if (iters || !pm->op_pmreplroot) { + GETTARGET; + PUSHi(iters); + RETURN; + } + RETPUSHUNDEF; +} + +#ifdef USE_THREADS +void +unlock_condpair(void *svv) +{ + dTHR; + MAGIC *mg = mg_find((SV*)svv, 'm'); + + if (!mg) + croak("panic: unlock_condpair unlocking non-mutex"); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) != thr) + croak("panic: unlock_condpair unlocking mutex that we don't own"); + MgOWNER(mg) = 0; + COND_SIGNAL(MgOWNERCONDP(mg)); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", + (unsigned long)thr, (unsigned long)svv);) + MUTEX_UNLOCK(MgMUTEXP(mg)); +} +#endif /* USE_THREADS */ + +PP(pp_lock) +{ + djSP; + dTOPss; + SV *retsv = sv; +#ifdef USE_THREADS + MAGIC *mg; + + if (SvROK(sv)) + sv = SvRV(sv); + + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", + (unsigned long)thr, (unsigned long)sv);) + MUTEX_UNLOCK(MgMUTEXP(mg)); + SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */ + save_destructor(unlock_condpair, sv); + } +#endif /* USE_THREADS */ + if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV + || SvTYPE(retsv) == SVt_PVCV) { + retsv = refto(retsv); + } + SETs(retsv); + RETURN; +} + +PP(pp_threadsv) +{ + djSP; +#ifdef USE_THREADS + EXTEND(SP, 1); + if (PL_op->op_private & OPpLVAL_INTRO) + PUSHs(*save_threadsv(PL_op->op_targ)); + else + PUSHs(THREADSV(PL_op->op_targ)); + RETURN; +#else + DIE("tried to access per-thread data in non-threaded perl"); +#endif /* USE_THREADS */ +} diff --git a/contrib/perl5/pp.h b/contrib/perl5/pp.h new file mode 100644 index 00000000000..6fe91f40c80 --- /dev/null +++ b/contrib/perl5/pp.h @@ -0,0 +1,237 @@ +/* pp.h + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +#ifdef USE_THREADS +#define ARGS thr +#define dARGS struct perl_thread *thr; +#else +#define ARGS +#define dARGS +#endif /* USE_THREADS */ +#ifdef PERL_OBJECT +#define PP(s) OP * CPerlObj::s(ARGSproto) +#else +#define PP(s) OP * s(ARGSproto) +#endif + +#define SP sp +#define MARK mark +#define TARG targ + +#define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max) \ + markstack_grow(); \ + *PL_markstack_ptr = (p) - PL_stack_base + +#define TOPMARK (*PL_markstack_ptr) +#define POPMARK (*PL_markstack_ptr--) + +#define djSP register SV **sp = PL_stack_sp +#define dSP dTHR; djSP +#define dMARK register SV **mark = PL_stack_base + POPMARK +#define dORIGMARK I32 origmark = mark - PL_stack_base +#define SETORIGMARK origmark = mark - PL_stack_base +#define ORIGMARK (PL_stack_base + origmark) + +#define SPAGAIN sp = PL_stack_sp +#define MSPAGAIN sp = PL_stack_sp; mark = ORIGMARK + +#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ)) +#define dTARGETSTACKED SV * GETTARGETSTACKED + +#define GETTARGET targ = PAD_SV(PL_op->op_targ) +#define dTARGET SV * GETTARGET + +#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ)) +#define dATARGET SV * GETATARGET + +#define dTARG SV *targ + +#define NORMAL PL_op->op_next +#define DIE return die + +#define PUTBACK PL_stack_sp = sp +#define RETURN return PUTBACK, NORMAL +#define RETURNOP(o) return PUTBACK, o +#define RETURNX(x) return x, PUTBACK, NORMAL + +#define POPs (*sp--) +#define POPp (SvPVx(POPs, PL_na)) +#define POPn (SvNVx(POPs)) +#define POPi ((IV)SvIVx(POPs)) +#define POPu ((UV)SvUVx(POPs)) +#define POPl ((long)SvIVx(POPs)) + +#define TOPs (*sp) +#define TOPp (SvPV(TOPs, PL_na)) +#define TOPn (SvNV(TOPs)) +#define TOPi ((IV)SvIV(TOPs)) +#define TOPu ((UV)SvUV(TOPs)) +#define TOPl ((long)SvIV(TOPs)) + +/* Go to some pains in the rare event that we must extend the stack. */ +#define EXTEND(p,n) STMT_START { if (PL_stack_max - p < (n)) { \ + sp = stack_grow(sp,p, (int) (n)); \ + } } STMT_END + +/* Same thing, but update mark register too. */ +#define MEXTEND(p,n) STMT_START {if (PL_stack_max - p < (n)) { \ + int markoff = mark - PL_stack_base; \ + sp = stack_grow(sp,p,(int) (n)); \ + mark = PL_stack_base + markoff; \ + } } STMT_END + +#define PUSHs(s) (*++sp = (s)) +#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END +#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END +#define PUSHn(n) STMT_START { sv_setnv(TARG, (double)(n)); PUSHTARG; } STMT_END +#define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END +#define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END + +#define XPUSHs(s) STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END +#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END +#define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END +#define XPUSHn(n) STMT_START { sv_setnv(TARG, (double)(n)); XPUSHTARG; } STMT_END +#define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END +#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END + +#define SETs(s) (*sp = s) +#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END +#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END +#define SETn(n) STMT_START { sv_setnv(TARG, (double)(n)); SETTARG; } STMT_END +#define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END +#define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END + +#define dTOPss SV *sv = TOPs +#define dPOPss SV *sv = POPs +#define dTOPnv double value = TOPn +#define dPOPnv double value = POPn +#define dTOPiv IV value = TOPi +#define dPOPiv IV value = POPi +#define dTOPuv UV value = TOPu +#define dPOPuv UV value = POPu + +#define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s) +#define dPOPXnnrl(X) double right = POPn; double left = CAT2(X,n) +#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i) + +#define USE_LEFT(sv) \ + (SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED)) +#define dPOPXnnrl_ul(X) \ + double right = POPn; \ + SV *leftsv = CAT2(X,s); \ + double left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0 +#define dPOPXiirl_ul(X) \ + IV right = POPi; \ + SV *leftsv = CAT2(X,s); \ + IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0 + +#define dPOPPOPssrl dPOPXssrl(POP) +#define dPOPPOPnnrl dPOPXnnrl(POP) +#define dPOPPOPnnrl_ul dPOPXnnrl_ul(POP) +#define dPOPPOPiirl dPOPXiirl(POP) +#define dPOPPOPiirl_ul dPOPXiirl_ul(POP) + +#define dPOPTOPssrl dPOPXssrl(TOP) +#define dPOPTOPnnrl dPOPXnnrl(TOP) +#define dPOPTOPnnrl_ul dPOPXnnrl_ul(TOP) +#define dPOPTOPiirl dPOPXiirl(TOP) +#define dPOPTOPiirl_ul dPOPXiirl_ul(TOP) + +#define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes)) +#define RETPUSHNO RETURNX(PUSHs(&PL_sv_no)) +#define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef)) + +#define RETSETYES RETURNX(SETs(&PL_sv_yes)) +#define RETSETNO RETURNX(SETs(&PL_sv_no)) +#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef)) + +#define ARGTARG PL_op->op_targ +#define MAXARG PL_op->op_private + +#define SWITCHSTACK(f,t) \ + STMT_START { \ + AvFILLp(f) = sp - PL_stack_base; \ + PL_stack_base = AvARRAY(t); \ + PL_stack_max = PL_stack_base + AvMAX(t); \ + sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ + PL_curstack = t; \ + } STMT_END + +#define EXTEND_MORTAL(n) \ + STMT_START { \ + if (PL_tmps_ix + (n) >= PL_tmps_max) \ + Renew(PL_tmps_stack, PL_tmps_max = PL_tmps_ix + (n) + 1, SV*); \ + } STMT_END + +#ifdef OVERLOAD + +#define AMGf_noright 1 +#define AMGf_noleft 2 +#define AMGf_assign 4 +#define AMGf_unary 8 + +#define tryAMAGICbinW(meth,assign,set) STMT_START { \ + if (PL_amagic_generation) { \ + SV* tmpsv; \ + SV* right= *(sp); SV* left= *(sp-1);\ + if ((SvAMAGIC(left)||SvAMAGIC(right))&&\ + (tmpsv=amagic_call(left, \ + right, \ + CAT2(meth,_amg), \ + (assign)? AMGf_assign: 0))) {\ + SPAGAIN; \ + (void)POPs; set(tmpsv); RETURN; } \ + } \ + } STMT_END + +#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv) +#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs) + +#define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef, \ + CAT2(meth,_amg),AMGf_noright | AMGf_unary) +#define AMG_CALLbinL(left,right,meth) \ + amagic_call(left,right,CAT2(meth,_amg),AMGf_noright) + +#define tryAMAGICunW(meth,set) STMT_START { \ + if (PL_amagic_generation) { \ + SV* tmpsv; \ + SV* arg= *(sp); \ + if ((SvAMAGIC(arg))&&\ + (tmpsv=AMG_CALLun(arg,meth))) {\ + SPAGAIN; \ + set(tmpsv); RETURN; } \ + } \ + } STMT_END + +#define tryAMAGICun tryAMAGICunSET +#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs) + +#define opASSIGN (PL_op->op_flags & OPf_STACKED) +#define SETsv(sv) STMT_START { \ + if (opASSIGN) { sv_setsv(TARG, (sv)); SETTARG; } \ + else SETs(sv); } STMT_END + +/* newSVsv does not behave as advertised, so we copy missing + * information by hand */ + +/* SV* ref causes confusion with the member variable + changed SV* ref to SV* tmpRef */ +#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \ + if (SvREFCNT(tmpRef)>1) { \ + SvREFCNT_dec(tmpRef); \ + SvRV(rv)=AMG_CALLun(rv,copy); \ + } } STMT_END +#else + +#define tryAMAGICbin(a,b) +#define tryAMAGICbinSET(a,b) +#define tryAMAGICun(a) +#define tryAMAGICunSET(a) + +#endif /* OVERLOAD */ diff --git a/contrib/perl5/pp_ctl.c b/contrib/perl5/pp_ctl.c new file mode 100644 index 00000000000..7a1ad799b85 --- /dev/null +++ b/contrib/perl5/pp_ctl.c @@ -0,0 +1,3716 @@ +/* pp_ctl.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * Now far ahead the Road has gone, + * And I must follow, if I can, + * Pursuing it with eager feet, + * Until it joins some larger way + * Where many paths and errands meet. + * And whither then? I cannot say. + */ + +#include "EXTERN.h" +#include "perl.h" + +#ifndef WORD_ALIGN +#define WORD_ALIGN sizeof(U16) +#endif + +#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) + +#ifdef PERL_OBJECT +#define CALLOP this->*PL_op +#else +#define CALLOP *PL_op +static OP *docatch _((OP *o)); +static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); +static void doparseform _((SV *sv)); +static I32 dopoptoeval _((I32 startingblock)); +static I32 dopoptolabel _((char *label)); +static I32 dopoptoloop _((I32 startingblock)); +static I32 dopoptosub _((I32 startingblock)); +static I32 dopoptosub_at _((PERL_CONTEXT *cxstk, I32 startingblock)); +static void save_lines _((AV *array, SV *sv)); +static I32 sortcv _((SV *a, SV *b)); +static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b))); +static OP *doeval _((int gimme, OP** startop)); +#endif + +PP(pp_wantarray) +{ + djSP; + I32 cxix; + EXTEND(SP, 1); + + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + RETPUSHUNDEF; + + switch (cxstack[cxix].blk_gimme) { + case G_ARRAY: + RETPUSHYES; + case G_SCALAR: + RETPUSHNO; + default: + RETPUSHUNDEF; + } +} + +PP(pp_regcmaybe) +{ + return NORMAL; +} + +PP(pp_regcreset) +{ + /* XXXX Should store the old value to allow for tie/overload - and + restore in regcomp, where marked with XXXX. */ + PL_reginterp_cnt = 0; + return NORMAL; +} + +PP(pp_regcomp) +{ + djSP; + register PMOP *pm = (PMOP*)cLOGOP->op_other; + register char *t; + SV *tmpstr; + STRLEN len; + MAGIC *mg = Null(MAGIC*); + + tmpstr = POPs; + if (SvROK(tmpstr)) { + SV *sv = SvRV(tmpstr); + if(SvMAGICAL(sv)) + mg = mg_find(sv, 'r'); + } + if (mg) { + regexp *re = (regexp *)mg->mg_obj; + ReREFCNT_dec(pm->op_pmregexp); + pm->op_pmregexp = ReREFCNT_inc(re); + } + else { + t = SvPV(tmpstr, len); + + /* Check against the last compiled regexp. */ + if (!pm->op_pmregexp || !pm->op_pmregexp->precomp || + pm->op_pmregexp->prelen != len || + memNE(pm->op_pmregexp->precomp, t, len)) + { + if (pm->op_pmregexp) { + ReREFCNT_dec(pm->op_pmregexp); + pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */ + } + if (PL_op->op_flags & OPf_SPECIAL) + PL_reginterp_cnt = I32_MAX; /* Mark as safe. */ + + pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */ + pm->op_pmregexp = CALLREGCOMP(t, t + len, pm); + PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed + inside tie/overload accessors. */ + } + } + +#ifndef INCOMPLETE_TAINTS + if (PL_tainting) { + if (PL_tainted) + pm->op_pmdynflags |= PMdf_TAINTED; + else + pm->op_pmdynflags &= ~PMdf_TAINTED; + } +#endif + + if (!pm->op_pmregexp->prelen && PL_curpm) + pm = PL_curpm; + else if (strEQ("\\s+", pm->op_pmregexp->precomp)) + pm->op_pmflags |= PMf_WHITE; + + if (pm->op_pmflags & PMf_KEEP) { + pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ + cLOGOP->op_first->op_next = PL_op->op_next; + } + RETURN; +} + +PP(pp_substcont) +{ + djSP; + register PMOP *pm = (PMOP*) cLOGOP->op_other; + register PERL_CONTEXT *cx = &cxstack[cxstack_ix]; + register SV *dstr = cx->sb_dstr; + register char *s = cx->sb_s; + register char *m = cx->sb_m; + char *orig = cx->sb_orig; + register REGEXP *rx = cx->sb_rx; + + rxres_restore(&cx->sb_rxres, rx); + + if (cx->sb_iters++) { + if (cx->sb_iters > cx->sb_maxiters) + DIE("Substitution loop"); + + if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs)) + cx->sb_rxtainted |= 2; + sv_catsv(dstr, POPs); + + /* Are we done */ + if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig, + s == m, Nullsv, NULL, + cx->sb_safebase ? 0 : REXEC_COPY_STR)) + { + SV *targ = cx->sb_targ; + sv_catpvn(dstr, s, cx->sb_strend - s); + + cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); + + (void)SvOOK_off(targ); + Safefree(SvPVX(targ)); + SvPVX(targ) = SvPVX(dstr); + SvCUR_set(targ, SvCUR(dstr)); + SvLEN_set(targ, SvLEN(dstr)); + SvPVX(dstr) = 0; + sv_free(dstr); + + TAINT_IF(cx->sb_rxtainted & 1); + PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); + + (void)SvPOK_only(targ); + TAINT_IF(cx->sb_rxtainted); + SvSETMAGIC(targ); + SvTAINT(targ); + + LEAVE_SCOPE(cx->sb_oldsave); + POPSUBST(cx); + RETURNOP(pm->op_next); + } + } + if (rx->subbase && rx->subbase != orig) { + m = s; + s = orig; + cx->sb_orig = orig = rx->subbase; + s = orig + (m - s); + cx->sb_strend = s + (cx->sb_strend - m); + } + cx->sb_m = m = rx->startp[0]; + sv_catpvn(dstr, s, m-s); + cx->sb_s = rx->endp[0]; + cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); + rxres_save(&cx->sb_rxres, rx); + RETURNOP(pm->op_pmreplstart); +} + +void +rxres_save(void **rsp, REGEXP *rx) +{ + UV *p = (UV*)*rsp; + U32 i; + + if (!p || p[1] < rx->nparens) { + i = 6 + rx->nparens * 2; + if (!p) + New(501, p, i, UV); + else + Renew(p, i, UV); + *rsp = (void*)p; + } + + *p++ = (UV)rx->subbase; + rx->subbase = Nullch; + + *p++ = rx->nparens; + + *p++ = (UV)rx->subbeg; + *p++ = (UV)rx->subend; + for (i = 0; i <= rx->nparens; ++i) { + *p++ = (UV)rx->startp[i]; + *p++ = (UV)rx->endp[i]; + } +} + +void +rxres_restore(void **rsp, REGEXP *rx) +{ + UV *p = (UV*)*rsp; + U32 i; + + Safefree(rx->subbase); + rx->subbase = (char*)(*p); + *p++ = 0; + + rx->nparens = *p++; + + rx->subbeg = (char*)(*p++); + rx->subend = (char*)(*p++); + for (i = 0; i <= rx->nparens; ++i) { + rx->startp[i] = (char*)(*p++); + rx->endp[i] = (char*)(*p++); + } +} + +void +rxres_free(void **rsp) +{ + UV *p = (UV*)*rsp; + + if (p) { + Safefree((char*)(*p)); + Safefree(p); + *rsp = Null(void*); + } +} + +PP(pp_formline) +{ + djSP; dMARK; dORIGMARK; + register SV *tmpForm = *++MARK; + register U16 *fpc; + register char *t; + register char *f; + register char *s; + register char *send; + register I32 arg; + register SV *sv; + char *item; + I32 itemsize; + I32 fieldsize; + I32 lines = 0; + bool chopspace = (strchr(PL_chopset, ' ') != Nullch); + char *chophere; + char *linemark; + double value; + bool gotsome; + STRLEN len; + + if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { + SvREADONLY_off(tmpForm); + doparseform(tmpForm); + } + + SvPV_force(PL_formtarget, len); + t = SvGROW(PL_formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */ + t += len; + f = SvPV(tmpForm, len); + /* need to jump to the next word */ + s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN; + + fpc = (U16*)s; + + for (;;) { + DEBUG_f( { + char *name = "???"; + arg = -1; + switch (*fpc) { + case FF_LITERAL: arg = fpc[1]; name = "LITERAL"; break; + case FF_BLANK: arg = fpc[1]; name = "BLANK"; break; + case FF_SKIP: arg = fpc[1]; name = "SKIP"; break; + case FF_FETCH: arg = fpc[1]; name = "FETCH"; break; + case FF_DECIMAL: arg = fpc[1]; name = "DECIMAL"; break; + + case FF_CHECKNL: name = "CHECKNL"; break; + case FF_CHECKCHOP: name = "CHECKCHOP"; break; + case FF_SPACE: name = "SPACE"; break; + case FF_HALFSPACE: name = "HALFSPACE"; break; + case FF_ITEM: name = "ITEM"; break; + case FF_CHOP: name = "CHOP"; break; + case FF_LINEGLOB: name = "LINEGLOB"; break; + case FF_NEWLINE: name = "NEWLINE"; break; + case FF_MORE: name = "MORE"; break; + case FF_LINEMARK: name = "LINEMARK"; break; + case FF_END: name = "END"; break; + } + if (arg >= 0) + PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg); + else + PerlIO_printf(PerlIO_stderr(), "%-16s\n", name); + } ) + switch (*fpc++) { + case FF_LINEMARK: + linemark = t; + lines++; + gotsome = FALSE; + break; + + case FF_LITERAL: + arg = *fpc++; + while (arg--) + *t++ = *f++; + break; + + case FF_SKIP: + f += *fpc++; + break; + + case FF_FETCH: + arg = *fpc++; + f += arg; + fieldsize = arg; + + if (MARK < SP) + sv = *++MARK; + else { + sv = &PL_sv_no; + if (PL_dowarn) + warn("Not enough format arguments"); + } + break; + + case FF_CHECKNL: + item = s = SvPV(sv, len); + itemsize = len; + if (itemsize > fieldsize) + itemsize = fieldsize; + send = chophere = s + itemsize; + while (s < send) { + if (*s & ~31) + gotsome = TRUE; + else if (*s == '\n') + break; + s++; + } + itemsize = s - item; + break; + + case FF_CHECKCHOP: + item = s = SvPV(sv, len); + itemsize = len; + if (itemsize <= fieldsize) { + send = chophere = s + itemsize; + while (s < send) { + if (*s == '\r') { + itemsize = s - item; + break; + } + if (*s++ & ~31) + gotsome = TRUE; + } + } + else { + itemsize = fieldsize; + send = chophere = s + itemsize; + while (s < send || (s == send && isSPACE(*s))) { + if (isSPACE(*s)) { + if (chopspace) + chophere = s; + if (*s == '\r') + break; + } + else { + if (*s & ~31) + gotsome = TRUE; + if (strchr(PL_chopset, *s)) + chophere = s + 1; + } + s++; + } + itemsize = chophere - item; + } + break; + + case FF_SPACE: + arg = fieldsize - itemsize; + if (arg) { + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + break; + + case FF_HALFSPACE: + arg = fieldsize - itemsize; + if (arg) { + arg /= 2; + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + break; + + case FF_ITEM: + arg = itemsize; + s = item; + while (arg--) { +#ifdef EBCDIC + int ch = *t++ = *s++; + if (iscntrl(ch)) +#else + if ( !((*t++ = *s++) & ~31) ) +#endif + t[-1] = ' '; + } + break; + + case FF_CHOP: + s = chophere; + if (chopspace) { + while (*s && isSPACE(*s)) + s++; + } + sv_chop(sv,s); + break; + + case FF_LINEGLOB: + item = s = SvPV(sv, len); + itemsize = len; + if (itemsize) { + gotsome = TRUE; + send = s + itemsize; + while (s < send) { + if (*s++ == '\n') { + if (s == send) + itemsize--; + else + lines++; + } + } + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + sv_catpvn(PL_formtarget, item, itemsize); + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + SvCUR(tmpForm) + 1); + t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); + } + break; + + case FF_DECIMAL: + /* If the field is marked with ^ and the value is undefined, + blank it out. */ + arg = *fpc++; + if ((arg & 512) && !SvOK(sv)) { + arg = fieldsize; + while (arg--) + *t++ = ' '; + break; + } + gotsome = TRUE; + value = SvNV(sv); + /* Formats aren't yet marked for locales, so assume "yes". */ + SET_NUMERIC_LOCAL(); + if (arg & 256) { + sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value); + } else { + sprintf(t, "%*.0f", (int) fieldsize, value); + } + t += fieldsize; + break; + + case FF_NEWLINE: + f++; + while (t-- > linemark && *t == ' ') ; + t++; + *t++ = '\n'; + break; + + case FF_BLANK: + arg = *fpc++; + if (gotsome) { + if (arg) { /* repeat until fields exhausted? */ + *t = '\0'; + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + lines += FmLINES(PL_formtarget); + if (lines == 200) { + arg = t - linemark; + if (strnEQ(linemark, linemark - arg, arg)) + DIE("Runaway format"); + } + FmLINES(PL_formtarget) = lines; + SP = ORIGMARK; + RETURNOP(cLISTOP->op_first); + } + } + else { + t = linemark; + lines--; + } + break; + + case FF_MORE: + if (itemsize) { + arg = fieldsize - itemsize; + if (arg) { + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + s = t - 3; + if (strnEQ(s," ",3)) { + while (s > SvPVX(PL_formtarget) && isSPACE(s[-1])) + s--; + } + *s++ = '.'; + *s++ = '.'; + *s++ = '.'; + } + break; + + case FF_END: + *t = '\0'; + SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + FmLINES(PL_formtarget) += lines; + SP = ORIGMARK; + RETPUSHYES; + } + } +} + +PP(pp_grepstart) +{ + djSP; + SV *src; + + if (PL_stack_base + *PL_markstack_ptr == SP) { + (void)POPMARK; + if (GIMME_V == G_SCALAR) + XPUSHs(&PL_sv_no); + RETURNOP(PL_op->op_next->op_next); + } + PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1; + pp_pushmark(ARGS); /* push dst */ + pp_pushmark(ARGS); /* push src */ + ENTER; /* enter outer scope */ + + SAVETMPS; +#ifdef USE_THREADS + /* SAVE_DEFSV does *not* suffice here */ + save_sptr(&THREADSV(0)); +#else + SAVESPTR(GvSV(PL_defgv)); +#endif /* USE_THREADS */ + ENTER; /* enter inner scope */ + SAVESPTR(PL_curpm); + + src = PL_stack_base[*PL_markstack_ptr]; + SvTEMP_off(src); + DEFSV = src; + + PUTBACK; + if (PL_op->op_type == OP_MAPSTART) + pp_pushmark(ARGS); /* push top */ + return ((LOGOP*)PL_op->op_next)->op_other; +} + +PP(pp_mapstart) +{ + DIE("panic: mapstart"); /* uses grepstart */ +} + +PP(pp_mapwhile) +{ + djSP; + I32 diff = (SP - PL_stack_base) - *PL_markstack_ptr; + I32 count; + I32 shift; + SV** src; + SV** dst; + + ++PL_markstack_ptr[-1]; + if (diff) { + if (diff > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { + shift = diff - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); + count = (SP - PL_stack_base) - PL_markstack_ptr[-1] + 2; + + EXTEND(SP,shift); + src = SP; + dst = (SP += shift); + PL_markstack_ptr[-1] += shift; + *PL_markstack_ptr += shift; + while (--count) + *dst-- = *src--; + } + dst = PL_stack_base + (PL_markstack_ptr[-2] += diff) - 1; + ++diff; + while (--diff) + *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs); + } + LEAVE; /* exit inner scope */ + + /* All done yet? */ + if (PL_markstack_ptr[-1] > *PL_markstack_ptr) { + I32 items; + I32 gimme = GIMME_V; + + (void)POPMARK; /* pop top */ + LEAVE; /* exit outer scope */ + (void)POPMARK; /* pop src */ + items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; + (void)POPMARK; /* pop dst */ + SP = PL_stack_base + POPMARK; /* pop original mark */ + if (gimme == G_SCALAR) { + dTARGET; + XPUSHi(items); + } + else if (gimme == G_ARRAY) + SP += items; + RETURN; + } + else { + SV *src; + + ENTER; /* enter inner scope */ + SAVESPTR(PL_curpm); + + src = PL_stack_base[PL_markstack_ptr[-1]]; + SvTEMP_off(src); + DEFSV = src; + + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_sort) +{ + djSP; dMARK; dORIGMARK; + register SV **up; + SV **myorigmark = ORIGMARK; + register I32 max; + HV *stash; + GV *gv; + CV *cv; + I32 gimme = GIMME; + OP* nextop = PL_op->op_next; + + if (gimme != G_ARRAY) { + SP = MARK; + RETPUSHUNDEF; + } + + ENTER; + SAVEPPTR(PL_sortcop); + if (PL_op->op_flags & OPf_STACKED) { + if (PL_op->op_flags & OPf_SPECIAL) { + OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */ + kid = kUNOP->op_first; /* pass rv2gv */ + kid = kUNOP->op_first; /* pass leave */ + PL_sortcop = kid->op_next; + stash = PL_curcop->cop_stash; + } + else { + cv = sv_2cv(*++MARK, &stash, &gv, 0); + if (!(cv && CvROOT(cv))) { + if (gv) { + SV *tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, gv, Nullch); + if (cv && CvXSUB(cv)) + DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr)); + DIE("Undefined sort subroutine \"%s\" called", + SvPVX(tmpstr)); + } + if (cv) { + if (CvXSUB(cv)) + DIE("Xsub called in sort"); + DIE("Undefined subroutine in sort"); + } + DIE("Not a CODE reference in sort"); + } + PL_sortcop = CvSTART(cv); + SAVESPTR(CvROOT(cv)->op_ppaddr); + CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL]; + + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + } + } + else { + PL_sortcop = Nullop; + stash = PL_curcop->cop_stash; + } + + up = myorigmark + 1; + while (MARK < SP) { /* This may or may not shift down one here. */ + /*SUPPRESS 560*/ + if (*up = *++MARK) { /* Weed out nulls. */ + SvTEMP_off(*up); + if (!PL_sortcop && !SvPOK(*up)) + (void)sv_2pv(*up, &PL_na); + up++; + } + } + max = --up - myorigmark; + if (PL_sortcop) { + if (max > 1) { + PERL_CONTEXT *cx; + SV** newsp; + bool oldcatch = CATCH_GET; + + SAVETMPS; + SAVEOP(); + + CATCH_SET(TRUE); + PUSHSTACKi(PERLSI_SORT); + if (PL_sortstash != stash) { + PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV); + PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); + PL_sortstash = stash; + } + + SAVESPTR(GvSV(PL_firstgv)); + SAVESPTR(GvSV(PL_secondgv)); + + PUSHBLOCK(cx, CXt_NULL, PL_stack_base); + if (!(PL_op->op_flags & OPf_SPECIAL)) { + bool hasargs = FALSE; + cx->cx_type = CXt_SUB; + cx->blk_gimme = G_SCALAR; + PUSHSUB(cx); + if (!CvDEPTH(cv)) + (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ + } + PL_sortcxix = cxstack_ix; + qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv)); + + POPBLOCK(cx,PL_curpm); + POPSTACK; + CATCH_SET(oldcatch); + } + } + else { + if (max > 1) { + MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ + qsortsv(ORIGMARK+1, max, + (PL_op->op_private & OPpLOCALE) + ? FUNC_NAME_TO_PTR(sv_cmp_locale) + : FUNC_NAME_TO_PTR(sv_cmp)); + } + } + LEAVE; + PL_stack_sp = ORIGMARK + max; + return nextop; +} + +/* Range stuff. */ + +PP(pp_range) +{ + if (GIMME == G_ARRAY) + return cCONDOP->op_true; + return SvTRUEx(PAD_SV(PL_op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true; +} + +PP(pp_flip) +{ + djSP; + + if (GIMME == G_ARRAY) { + RETURNOP(((CONDOP*)cUNOP->op_first)->op_false); + } + else { + dTOPss; + SV *targ = PAD_SV(PL_op->op_targ); + + if ((PL_op->op_private & OPpFLIP_LINENUM) + ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) + : SvTRUE(sv) ) { + sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); + if (PL_op->op_flags & OPf_SPECIAL) { + sv_setiv(targ, 1); + SETs(targ); + RETURN; + } + else { + sv_setiv(targ, 0); + SP--; + RETURNOP(((CONDOP*)cUNOP->op_first)->op_false); + } + } + sv_setpv(TARG, ""); + SETs(targ); + RETURN; + } +} + +PP(pp_flop) +{ + djSP; + + if (GIMME == G_ARRAY) { + dPOPPOPssrl; + register I32 i; + register SV *sv; + I32 max; + + if (SvNIOKp(left) || !SvPOKp(left) || + (looks_like_number(left) && *SvPVX(left) != '0') ) + { + if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX) + croak("Range iterator outside integer range"); + i = SvIV(left); + max = SvIV(right); + if (max >= i) { + EXTEND_MORTAL(max - i + 1); + EXTEND(SP, max - i + 1); + } + while (i <= max) { + sv = sv_2mortal(newSViv(i++)); + PUSHs(sv); + } + } + else { + SV *final = sv_mortalcopy(right); + STRLEN len; + char *tmps = SvPV(final, len); + + sv = sv_mortalcopy(left); + SvPV_force(sv,PL_na); + while (!SvNIOKp(sv) && SvCUR(sv) <= len) { + XPUSHs(sv); + if (strEQ(SvPVX(sv),tmps)) + break; + sv = sv_2mortal(newSVsv(sv)); + sv_inc(sv); + } + } + } + else { + dTOPss; + SV *targ = PAD_SV(cUNOP->op_first->op_targ); + sv_inc(targ); + if ((PL_op->op_private & OPpFLIP_LINENUM) + ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) + : SvTRUE(sv) ) { + sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); + sv_catpv(targ, "E0"); + } + SETs(targ); + } + + RETURN; +} + +/* Control. */ + +STATIC I32 +dopoptolabel(char *label) +{ + dTHR; + register I32 i; + register PERL_CONTEXT *cx; + + for (i = cxstack_ix; i >= 0; i--) { + cx = &cxstack[i]; + switch (cx->cx_type) { + case CXt_SUBST: + if (PL_dowarn) + warn("Exiting substitution via %s", op_name[PL_op->op_type]); + break; + case CXt_SUB: + if (PL_dowarn) + warn("Exiting subroutine via %s", op_name[PL_op->op_type]); + break; + case CXt_EVAL: + if (PL_dowarn) + warn("Exiting eval via %s", op_name[PL_op->op_type]); + break; + case CXt_NULL: + if (PL_dowarn) + warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); + return -1; + case CXt_LOOP: + if (!cx->blk_loop.label || + strNE(label, cx->blk_loop.label) ) { + DEBUG_l(deb("(Skipping label #%ld %s)\n", + (long)i, cx->blk_loop.label)); + continue; + } + DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label)); + return i; + } + } + return i; +} + +I32 +dowantarray(void) +{ + I32 gimme = block_gimme(); + return (gimme == G_VOID) ? G_SCALAR : gimme; +} + +I32 +block_gimme(void) +{ + dTHR; + I32 cxix; + + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + return G_VOID; + + switch (cxstack[cxix].blk_gimme) { + case G_VOID: + return G_VOID; + case G_SCALAR: + return G_SCALAR; + case G_ARRAY: + return G_ARRAY; + default: + croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); + /* NOTREACHED */ + return 0; + } +} + +STATIC I32 +dopoptosub(I32 startingblock) +{ + dTHR; + return dopoptosub_at(cxstack, startingblock); +} + +STATIC I32 +dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock) +{ + dTHR; + I32 i; + register PERL_CONTEXT *cx; + for (i = startingblock; i >= 0; i--) { + cx = &cxstk[i]; + switch (cx->cx_type) { + default: + continue; + case CXt_EVAL: + case CXt_SUB: + DEBUG_l( deb("(Found sub #%ld)\n", (long)i)); + return i; + } + } + return i; +} + +STATIC I32 +dopoptoeval(I32 startingblock) +{ + dTHR; + I32 i; + register PERL_CONTEXT *cx; + for (i = startingblock; i >= 0; i--) { + cx = &cxstack[i]; + switch (cx->cx_type) { + default: + continue; + case CXt_EVAL: + DEBUG_l( deb("(Found eval #%ld)\n", (long)i)); + return i; + } + } + return i; +} + +STATIC I32 +dopoptoloop(I32 startingblock) +{ + dTHR; + I32 i; + register PERL_CONTEXT *cx; + for (i = startingblock; i >= 0; i--) { + cx = &cxstack[i]; + switch (cx->cx_type) { + case CXt_SUBST: + if (PL_dowarn) + warn("Exiting substitution via %s", op_name[PL_op->op_type]); + break; + case CXt_SUB: + if (PL_dowarn) + warn("Exiting subroutine via %s", op_name[PL_op->op_type]); + break; + case CXt_EVAL: + if (PL_dowarn) + warn("Exiting eval via %s", op_name[PL_op->op_type]); + break; + case CXt_NULL: + if (PL_dowarn) + warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); + return -1; + case CXt_LOOP: + DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); + return i; + } + } + return i; +} + +void +dounwind(I32 cxix) +{ + dTHR; + register PERL_CONTEXT *cx; + SV **newsp; + I32 optype; + + while (cxstack_ix > cxix) { + cx = &cxstack[cxstack_ix]; + DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", + (long) cxstack_ix, block_type[cx->cx_type])); + /* Note: we don't need to restore the base context info till the end. */ + switch (cx->cx_type) { + case CXt_SUBST: + POPSUBST(cx); + continue; /* not break */ + case CXt_SUB: + POPSUB(cx); + break; + case CXt_EVAL: + POPEVAL(cx); + break; + case CXt_LOOP: + POPLOOP(cx); + break; + case CXt_NULL: + break; + } + cxstack_ix--; + } +} + +OP * +die_where(char *message) +{ + dSP; + if (PL_in_eval) { + I32 cxix; + register PERL_CONTEXT *cx; + I32 gimme; + SV **newsp; + + if (message) { + if (PL_in_eval & 4) { + SV **svp; + STRLEN klen = strlen(message); + + svp = hv_fetch(ERRHV, message, klen, TRUE); + if (svp) { + if (!SvIOK(*svp)) { + static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; + sv_upgrade(*svp, SVt_IV); + (void)SvIOK_only(*svp); + if (!SvPOK(err)) + sv_setpv(err,""); + SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, klen); + } + sv_inc(*svp); + } + } + else + sv_setpv(ERRSV, message); + } + else + message = SvPVx(ERRSV, PL_na); + + while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { + dounwind(-1); + POPSTACK; + } + + if (cxix >= 0) { + I32 optype; + + if (cxix < cxstack_ix) + dounwind(cxix); + + POPBLOCK(cx,PL_curpm); + if (cx->cx_type != CXt_EVAL) { + PerlIO_printf(PerlIO_stderr(), "panic: die %s", message); + my_exit(1); + } + POPEVAL(cx); + + if (gimme == G_SCALAR) + *++newsp = &PL_sv_undef; + PL_stack_sp = newsp; + + LEAVE; + + if (optype == OP_REQUIRE) { + char* msg = SvPVx(ERRSV, PL_na); + DIE("%s", *msg ? msg : "Compilation failed in require"); + } + return pop_return(); + } + } + PerlIO_printf(PerlIO_stderr(), "%s",message); + PerlIO_flush(PerlIO_stderr()); + my_failure_exit(); + /* NOTREACHED */ + return 0; +} + +PP(pp_xor) +{ + djSP; dPOPTOPssrl; + if (SvTRUE(left) != SvTRUE(right)) + RETSETYES; + else + RETSETNO; +} + +PP(pp_andassign) +{ + djSP; + if (!SvTRUE(TOPs)) + RETURN; + else + RETURNOP(cLOGOP->op_other); +} + +PP(pp_orassign) +{ + djSP; + if (SvTRUE(TOPs)) + RETURN; + else + RETURNOP(cLOGOP->op_other); +} + +PP(pp_caller) +{ + djSP; + register I32 cxix = dopoptosub(cxstack_ix); + register PERL_CONTEXT *cx; + register PERL_CONTEXT *ccstack = cxstack; + PERL_SI *top_si = PL_curstackinfo; + I32 dbcxix; + I32 gimme; + HV *hv; + SV *sv; + I32 count = 0; + + if (MAXARG) + count = POPi; + EXTEND(SP, 6); + for (;;) { + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = dopoptosub_at(ccstack, top_si->si_cxix); + } + if (cxix < 0) { + if (GIMME != G_ARRAY) + RETPUSHUNDEF; + RETURN; + } + if (PL_DBsub && cxix >= 0 && + ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) + count++; + if (!count--) + break; + cxix = dopoptosub_at(ccstack, cxix - 1); + } + + cx = &ccstack[cxix]; + if (ccstack[cxix].cx_type == CXt_SUB) { + dbcxix = dopoptosub_at(ccstack, cxix - 1); + /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the + field below is defined for any cx. */ + if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) + cx = &ccstack[dbcxix]; + } + + if (GIMME != G_ARRAY) { + hv = cx->blk_oldcop->cop_stash; + if (!hv) + PUSHs(&PL_sv_undef); + else { + dTARGET; + sv_setpv(TARG, HvNAME(hv)); + PUSHs(TARG); + } + RETURN; + } + + hv = cx->blk_oldcop->cop_stash; + if (!hv) + PUSHs(&PL_sv_undef); + else + PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0))); + PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0))); + PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); + if (!MAXARG) + RETURN; + if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */ + sv = NEWSV(49, 0); + gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch); + PUSHs(sv_2mortal(sv)); + PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs))); + } + else { + PUSHs(sv_2mortal(newSVpv("(eval)",0))); + PUSHs(sv_2mortal(newSViv(0))); + } + gimme = (I32)cx->blk_gimme; + if (gimme == G_VOID) + PUSHs(&PL_sv_undef); + else + PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); + if (cx->cx_type == CXt_EVAL) { + if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { + PUSHs(cx->blk_eval.cur_text); + PUSHs(&PL_sv_no); + } + else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */ + /* Require, put the name. */ + PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0))); + PUSHs(&PL_sv_yes); + } + } + else if (cx->cx_type == CXt_SUB && + cx->blk_sub.hasargs && + PL_curcop->cop_stash == PL_debstash) + { + AV *ary = cx->blk_sub.argarray; + int off = AvARRAY(ary) - AvALLOC(ary); + + if (!PL_dbargs) { + GV* tmpgv; + PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE, + SVt_PVAV))); + GvMULTI_on(tmpgv); + AvREAL_off(PL_dbargs); /* XXX Should be REIFY */ + } + + if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) + av_extend(PL_dbargs, AvFILLp(ary) + off); + Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*); + AvFILLp(PL_dbargs) = AvFILLp(ary) + off; + } + RETURN; +} + +STATIC I32 +sortcv(SV *a, SV *b) +{ + dTHR; + I32 oldsaveix = PL_savestack_ix; + I32 oldscopeix = PL_scopestack_ix; + I32 result; + GvSV(PL_firstgv) = a; + GvSV(PL_secondgv) = b; + PL_stack_sp = PL_stack_base; + PL_op = PL_sortcop; + CALLRUNOPS(); + if (PL_stack_sp != PL_stack_base + 1) + croak("Sort subroutine didn't return single value"); + if (!SvNIOKp(*PL_stack_sp)) + croak("Sort subroutine didn't return a numeric value"); + result = SvIV(*PL_stack_sp); + while (PL_scopestack_ix > oldscopeix) { + LEAVE; + } + leave_scope(oldsaveix); + return result; +} + +PP(pp_reset) +{ + djSP; + char *tmps; + + if (MAXARG < 1) + tmps = ""; + else + tmps = POPp; + sv_reset(tmps, PL_curcop->cop_stash); + PUSHs(&PL_sv_yes); + RETURN; +} + +PP(pp_lineseq) +{ + return NORMAL; +} + +PP(pp_dbstate) +{ + PL_curcop = (COP*)PL_op; + TAINT_NOT; /* Each statement is presumed innocent */ + PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + FREETMPS; + + if (PL_op->op_private || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) + { + djSP; + register CV *cv; + register PERL_CONTEXT *cx; + I32 gimme = G_ARRAY; + I32 hasargs; + GV *gv; + + gv = PL_DBgv; + cv = GvCV(gv); + if (!cv) + DIE("No DB::DB routine defined"); + + if (CvDEPTH(cv) >= 1 && !(PL_debug & (1<<30))) /* don't do recursive DB::DB call */ + return NORMAL; + + ENTER; + SAVETMPS; + + SAVEI32(PL_debug); + SAVESTACK_POS(); + PL_debug = 0; + hasargs = 0; + SPAGAIN; + + push_return(PL_op->op_next); + PUSHBLOCK(cx, CXt_SUB, SP); + PUSHSUB(cx); + CvDEPTH(cv)++; + (void)SvREFCNT_inc(cv); + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); + RETURNOP(CvSTART(cv)); + } + else + return NORMAL; +} + +PP(pp_scope) +{ + return NORMAL; +} + +PP(pp_enteriter) +{ + djSP; dMARK; + register PERL_CONTEXT *cx; + I32 gimme = GIMME_V; + SV **svp; + + ENTER; + SAVETMPS; + +#ifdef USE_THREADS + if (PL_op->op_flags & OPf_SPECIAL) + svp = save_threadsv(PL_op->op_targ); /* per-thread variable */ + else +#endif /* USE_THREADS */ + if (PL_op->op_targ) { + svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ + SAVESPTR(*svp); + } + else { + GV *gv = (GV*)POPs; + (void)save_scalar(gv); + svp = &GvSV(gv); /* symbol table variable */ + } + + ENTER; + + PUSHBLOCK(cx, CXt_LOOP, SP); + PUSHLOOP(cx, svp, MARK); + if (PL_op->op_flags & OPf_STACKED) { + cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); + if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { + dPOPss; + if (SvNIOKp(sv) || !SvPOKp(sv) || + (looks_like_number(sv) && *SvPVX(sv) != '0')) { + if (SvNV(sv) < IV_MIN || + SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) + croak("Range iterator outside integer range"); + cx->blk_loop.iterix = SvIV(sv); + cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary); + } + else + cx->blk_loop.iterlval = newSVsv(sv); + } + } + else { + cx->blk_loop.iterary = PL_curstack; + AvFILLp(PL_curstack) = SP - PL_stack_base; + cx->blk_loop.iterix = MARK - PL_stack_base; + } + + RETURN; +} + +PP(pp_enterloop) +{ + djSP; + register PERL_CONTEXT *cx; + I32 gimme = GIMME_V; + + ENTER; + SAVETMPS; + ENTER; + + PUSHBLOCK(cx, CXt_LOOP, SP); + PUSHLOOP(cx, 0, SP); + + RETURN; +} + +PP(pp_leaveloop) +{ + djSP; + register PERL_CONTEXT *cx; + struct block_loop cxloop; + I32 gimme; + SV **newsp; + PMOP *newpm; + SV **mark; + + POPBLOCK(cx,newpm); + mark = newsp; + POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + + TAINT_NOT; + if (gimme == G_VOID) + ; /* do nothing */ + else if (gimme == G_SCALAR) { + if (mark < SP) + *++newsp = sv_mortalcopy(*SP); + else + *++newsp = &PL_sv_undef; + } + else { + while (mark < SP) { + *++newsp = sv_mortalcopy(*++mark); + TAINT_NOT; /* Each item is independent */ + } + } + SP = newsp; + PUTBACK; + + POPLOOP2(); /* Stack values are safe: release loop vars ... */ + PL_curpm = newpm; /* ... and pop $1 et al */ + + LEAVE; + LEAVE; + + return NORMAL; +} + +PP(pp_return) +{ + djSP; dMARK; + I32 cxix; + register PERL_CONTEXT *cx; + struct block_sub cxsub; + bool popsub2 = FALSE; + I32 gimme; + SV **newsp; + PMOP *newpm; + I32 optype = 0; + + if (PL_curstackinfo->si_type == PERLSI_SORT) { + if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) { + if (cxstack_ix > PL_sortcxix) + dounwind(PL_sortcxix); + AvARRAY(PL_curstack)[1] = *SP; + PL_stack_sp = PL_stack_base + 1; + return 0; + } + } + + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + DIE("Can't return outside a subroutine"); + if (cxix < cxstack_ix) + dounwind(cxix); + + POPBLOCK(cx,newpm); + switch (cx->cx_type) { + case CXt_SUB: + POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ + popsub2 = TRUE; + break; + case CXt_EVAL: + POPEVAL(cx); + if (optype == OP_REQUIRE && + (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) + { + /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; + (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); + DIE("%s did not return a true value", name); + } + break; + default: + DIE("panic: return"); + } + + TAINT_NOT; + if (gimme == G_SCALAR) { + if (MARK < SP) { + if (popsub2) { + if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (SvTEMP(TOPs)) { + *++newsp = SvREFCNT_inc(*SP); + FREETMPS; + sv_2mortal(*newsp); + } else { + FREETMPS; + *++newsp = sv_mortalcopy(*SP); + } + } else + *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP); + } else + *++newsp = sv_mortalcopy(*SP); + } else + *++newsp = &PL_sv_undef; + } + else if (gimme == G_ARRAY) { + while (++MARK <= SP) { + *++newsp = (popsub2 && SvTEMP(*MARK)) + ? *MARK : sv_mortalcopy(*MARK); + TAINT_NOT; /* Each item is independent */ + } + } + PL_stack_sp = newsp; + + /* Stack values are safe: */ + if (popsub2) { + POPSUB2(); /* release CV and @_ ... */ + } + PL_curpm = newpm; /* ... and pop $1 et al */ + + LEAVE; + return pop_return(); +} + +PP(pp_last) +{ + djSP; + I32 cxix; + register PERL_CONTEXT *cx; + struct block_loop cxloop; + struct block_sub cxsub; + I32 pop2 = 0; + I32 gimme; + I32 optype; + OP *nextop; + SV **newsp; + PMOP *newpm; + SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + + if (PL_op->op_flags & OPf_SPECIAL) { + cxix = dopoptoloop(cxstack_ix); + if (cxix < 0) + DIE("Can't \"last\" outside a block"); + } + else { + cxix = dopoptolabel(cPVOP->op_pv); + if (cxix < 0) + DIE("Label not found for \"last %s\"", cPVOP->op_pv); + } + if (cxix < cxstack_ix) + dounwind(cxix); + + POPBLOCK(cx,newpm); + switch (cx->cx_type) { + case CXt_LOOP: + POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + pop2 = CXt_LOOP; + nextop = cxloop.last_op->op_next; + break; + case CXt_SUB: + POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ + pop2 = CXt_SUB; + nextop = pop_return(); + break; + case CXt_EVAL: + POPEVAL(cx); + nextop = pop_return(); + break; + default: + DIE("panic: last"); + } + + TAINT_NOT; + if (gimme == G_SCALAR) { + if (MARK < SP) + *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP)) + ? *SP : sv_mortalcopy(*SP); + else + *++newsp = &PL_sv_undef; + } + else if (gimme == G_ARRAY) { + while (++MARK <= SP) { + *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK)) + ? *MARK : sv_mortalcopy(*MARK); + TAINT_NOT; /* Each item is independent */ + } + } + SP = newsp; + PUTBACK; + + /* Stack values are safe: */ + switch (pop2) { + case CXt_LOOP: + POPLOOP2(); /* release loop vars ... */ + LEAVE; + break; + case CXt_SUB: + POPSUB2(); /* release CV and @_ ... */ + break; + } + PL_curpm = newpm; /* ... and pop $1 et al */ + + LEAVE; + return nextop; +} + +PP(pp_next) +{ + I32 cxix; + register PERL_CONTEXT *cx; + I32 oldsave; + + if (PL_op->op_flags & OPf_SPECIAL) { + cxix = dopoptoloop(cxstack_ix); + if (cxix < 0) + DIE("Can't \"next\" outside a block"); + } + else { + cxix = dopoptolabel(cPVOP->op_pv); + if (cxix < 0) + DIE("Label not found for \"next %s\"", cPVOP->op_pv); + } + if (cxix < cxstack_ix) + dounwind(cxix); + + TOPBLOCK(cx); + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + return cx->blk_loop.next_op; +} + +PP(pp_redo) +{ + I32 cxix; + register PERL_CONTEXT *cx; + I32 oldsave; + + if (PL_op->op_flags & OPf_SPECIAL) { + cxix = dopoptoloop(cxstack_ix); + if (cxix < 0) + DIE("Can't \"redo\" outside a block"); + } + else { + cxix = dopoptolabel(cPVOP->op_pv); + if (cxix < 0) + DIE("Label not found for \"redo %s\"", cPVOP->op_pv); + } + if (cxix < cxstack_ix) + dounwind(cxix); + + TOPBLOCK(cx); + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + return cx->blk_loop.redo_op; +} + +STATIC OP * +dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit) +{ + OP *kid; + OP **ops = opstack; + static char too_deep[] = "Target of goto is too deeply nested"; + + if (ops >= oplimit) + croak(too_deep); + if (o->op_type == OP_LEAVE || + o->op_type == OP_SCOPE || + o->op_type == OP_LEAVELOOP || + o->op_type == OP_LEAVETRY) + { + *ops++ = cUNOPo->op_first; + if (ops >= oplimit) + croak(too_deep); + } + *ops = 0; + if (o->op_flags & OPf_KIDS) { + dTHR; + /* First try all the kids at this level, since that's likeliest. */ + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { + if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && + kCOP->cop_label && strEQ(kCOP->cop_label, label)) + return kid; + } + for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { + if (kid == PL_lastgotoprobe) + continue; + if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && + (ops == opstack || + (ops[-1]->op_type != OP_NEXTSTATE && + ops[-1]->op_type != OP_DBSTATE))) + *ops++ = kid; + if (o = dofindlabel(kid, label, ops, oplimit)) + return o; + } + } + *ops = 0; + return 0; +} + +PP(pp_dump) +{ + return pp_goto(ARGS); + /*NOTREACHED*/ +} + +PP(pp_goto) +{ + djSP; + OP *retop = 0; + I32 ix; + register PERL_CONTEXT *cx; +#define GOTO_DEPTH 64 + OP *enterops[GOTO_DEPTH]; + char *label; + int do_dump = (PL_op->op_type == OP_DUMP); + + label = 0; + if (PL_op->op_flags & OPf_STACKED) { + SV *sv = POPs; + + /* This egregious kludge implements goto &subroutine */ + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { + I32 cxix; + register PERL_CONTEXT *cx; + CV* cv = (CV*)SvRV(sv); + SV** mark; + I32 items = 0; + I32 oldsave; + + if (!CvROOT(cv) && !CvXSUB(cv)) { + if (CvGV(cv)) { + SV *tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, CvGV(cv), Nullch); + DIE("Goto undefined subroutine &%s",SvPVX(tmpstr)); + } + DIE("Goto undefined subroutine"); + } + + /* First do some returnish stuff. */ + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + DIE("Can't goto subroutine outside a subroutine"); + if (cxix < cxstack_ix) + dounwind(cxix); + TOPBLOCK(cx); + if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) + DIE("Can't goto subroutine from an eval-string"); + mark = PL_stack_sp; + if (cx->cx_type == CXt_SUB && + cx->blk_sub.hasargs) { /* put @_ back onto stack */ + AV* av = cx->blk_sub.argarray; + + items = AvFILLp(av) + 1; + PL_stack_sp++; + EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ + Copy(AvARRAY(av), PL_stack_sp, items, SV*); + PL_stack_sp += items; +#ifndef USE_THREADS + SvREFCNT_dec(GvAV(PL_defgv)); + GvAV(PL_defgv) = cx->blk_sub.savearray; +#endif /* USE_THREADS */ + AvREAL_off(av); + av_clear(av); + } + else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ + AV* av; + int i; +#ifdef USE_THREADS + av = (AV*)PL_curpad[0]; +#else + av = GvAV(PL_defgv); +#endif + items = AvFILLp(av) + 1; + PL_stack_sp++; + EXTEND(PL_stack_sp, items); /* @_ could have been extended. */ + Copy(AvARRAY(av), PL_stack_sp, items, SV*); + PL_stack_sp += items; + } + if (cx->cx_type == CXt_SUB && + !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) + SvREFCNT_dec(cx->blk_sub.cv); + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + + /* Now do some callish stuff. */ + SAVETMPS; + if (CvXSUB(cv)) { + if (CvOLDSTYLE(cv)) { + I32 (*fp3)_((int,int,int)); + while (SP > mark) { + SP[1] = SP[0]; + SP--; + } + fp3 = (I32(*)_((int,int,int)))CvXSUB(cv); + items = (*fp3)(CvXSUBANY(cv).any_i32, + mark - PL_stack_base + 1, + items); + SP = PL_stack_base + items; + } + else { + SV **newsp; + I32 gimme; + + PL_stack_sp--; /* There is no cv arg. */ + /* Push a mark for the start of arglist */ + PUSHMARK(mark); + (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS); + /* Pop the current context like a decent sub should */ + POPBLOCK(cx, PL_curpm); + /* Do _not_ use PUTBACK, keep the XSUB's return stack! */ + } + LEAVE; + return pop_return(); + } + else { + AV* padlist = CvPADLIST(cv); + SV** svp = AvARRAY(padlist); + if (cx->cx_type == CXt_EVAL) { + PL_in_eval = cx->blk_eval.old_in_eval; + PL_eval_root = cx->blk_eval.old_eval_root; + cx->cx_type = CXt_SUB; + cx->blk_sub.hasargs = 0; + } + cx->blk_sub.cv = cv; + cx->blk_sub.olddepth = CvDEPTH(cv); + CvDEPTH(cv)++; + if (CvDEPTH(cv) < 2) + (void)SvREFCNT_inc(cv); + else { /* save temporaries on recursion? */ + if (CvDEPTH(cv) == 100 && PL_dowarn) + sub_crush_depth(cv); + if (CvDEPTH(cv) > AvFILLp(padlist)) { + AV *newpad = newAV(); + SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); + I32 ix = AvFILLp((AV*)svp[1]); + svp = AvARRAY(svp[0]); + for ( ;ix > 0; ix--) { + if (svp[ix] != &PL_sv_undef) { + char *name = SvPVX(svp[ix]); + if ((SvFLAGS(svp[ix]) & SVf_FAKE) + || *name == '&') + { + /* outer lexical or anon code */ + av_store(newpad, ix, + SvREFCNT_inc(oldpad[ix]) ); + } + else { /* our own lexical */ + if (*name == '@') + av_store(newpad, ix, sv = (SV*)newAV()); + else if (*name == '%') + av_store(newpad, ix, sv = (SV*)newHV()); + else + av_store(newpad, ix, sv = NEWSV(0,0)); + SvPADMY_on(sv); + } + } + else { + av_store(newpad, ix, sv = NEWSV(0,0)); + SvPADTMP_on(sv); + } + } + if (cx->blk_sub.hasargs) { + AV* av = newAV(); + av_extend(av, 0); + av_store(newpad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; + } + av_store(padlist, CvDEPTH(cv), (SV*)newpad); + AvFILLp(padlist) = CvDEPTH(cv); + svp = AvARRAY(padlist); + } + } +#ifdef USE_THREADS + if (!cx->blk_sub.hasargs) { + AV* av = (AV*)PL_curpad[0]; + + items = AvFILLp(av) + 1; + if (items) { + /* Mark is at the end of the stack. */ + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; + PUTBACK ; + } + } +#endif /* USE_THREADS */ + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); +#ifndef USE_THREADS + if (cx->blk_sub.hasargs) +#endif /* USE_THREADS */ + { + AV* av = (AV*)PL_curpad[0]; + SV** ary; + +#ifndef USE_THREADS + cx->blk_sub.savearray = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); +#endif /* USE_THREADS */ + cx->blk_sub.argarray = av; + ++mark; + + if (items >= AvMAX(av) + 1) { + ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (items >= AvMAX(av) + 1) { + AvMAX(av) = items - 1; + Renew(ary,items+1,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + } + } + Copy(mark,AvARRAY(av),items,SV*); + AvFILLp(av) = items - 1; + + while (items--) { + if (*mark) + SvTEMP_off(*mark); + mark++; + } + } + if (PERLDB_SUB) { /* Checking curstash breaks DProf. */ + /* + * We do not care about using sv to call CV; + * it's for informational purposes only. + */ + SV *sv = GvSV(PL_DBsub); + CV *gotocv; + + if (PERLDB_SUB_NN) { + SvIVX(sv) = (IV)cv; /* Already upgraded, saved */ + } else { + save_item(sv); + gv_efullname3(sv, CvGV(cv), Nullch); + } + if ( PERLDB_GOTO + && (gotocv = perl_get_cv("DB::goto", FALSE)) ) { + PUSHMARK( PL_stack_sp ); + perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG); + PL_stack_sp--; + } + } + RETURNOP(CvSTART(cv)); + } + } + else + label = SvPV(sv,PL_na); + } + else if (PL_op->op_flags & OPf_SPECIAL) { + if (! do_dump) + DIE("goto must have label"); + } + else + label = cPVOP->op_pv; + + if (label && *label) { + OP *gotoprobe = 0; + + /* find label */ + + PL_lastgotoprobe = 0; + *enterops = 0; + for (ix = cxstack_ix; ix >= 0; ix--) { + cx = &cxstack[ix]; + switch (cx->cx_type) { + case CXt_EVAL: + gotoprobe = PL_eval_root; /* XXX not good for nested eval */ + break; + case CXt_LOOP: + gotoprobe = cx->blk_oldcop->op_sibling; + break; + case CXt_SUBST: + continue; + case CXt_BLOCK: + if (ix) + gotoprobe = cx->blk_oldcop->op_sibling; + else + gotoprobe = PL_main_root; + break; + case CXt_SUB: + if (CvDEPTH(cx->blk_sub.cv)) { + gotoprobe = CvROOT(cx->blk_sub.cv); + break; + } + /* FALL THROUGH */ + case CXt_NULL: + DIE("Can't \"goto\" outside a block"); + default: + if (ix) + DIE("panic: goto"); + gotoprobe = PL_main_root; + break; + } + retop = dofindlabel(gotoprobe, label, + enterops, enterops + GOTO_DEPTH); + if (retop) + break; + PL_lastgotoprobe = gotoprobe; + } + if (!retop) + DIE("Can't find label %s", label); + + /* pop unwanted frames */ + + if (ix < cxstack_ix) { + I32 oldsave; + + if (ix < 0) + ix = 0; + dounwind(ix); + TOPBLOCK(cx); + oldsave = PL_scopestack[PL_scopestack_ix]; + LEAVE_SCOPE(oldsave); + } + + /* push wanted frames */ + + if (*enterops && enterops[1]) { + OP *oldop = PL_op; + for (ix = 1; enterops[ix]; ix++) { + PL_op = enterops[ix]; + /* Eventually we may want to stack the needed arguments + * for each op. For now, we punt on the hard ones. */ + if (PL_op->op_type == OP_ENTERITER) + DIE("Can't \"goto\" into the middle of a foreach loop", + label); + (CALLOP->op_ppaddr)(ARGS); + } + PL_op = oldop; + } + } + + if (do_dump) { +#ifdef VMS + if (!retop) retop = PL_main_start; +#endif + PL_restartop = retop; + PL_do_undump = TRUE; + + my_unexec(); + + PL_restartop = 0; /* hmm, must be GNU unexec().. */ + PL_do_undump = FALSE; + } + + if (PL_top_env->je_prev) { + PL_restartop = retop; + JMPENV_JUMP(3); + } + + RETURNOP(retop); +} + +PP(pp_exit) +{ + djSP; + I32 anum; + + if (MAXARG < 1) + anum = 0; + else { + anum = SvIVx(POPs); +#ifdef VMSISH_EXIT + if (anum == 1 && VMSISH_EXIT) + anum = 0; +#endif + } + my_exit(anum); + PUSHs(&PL_sv_undef); + RETURN; +} + +#ifdef NOTYET +PP(pp_nswitch) +{ + djSP; + double value = SvNVx(GvSV(cCOP->cop_gv)); + register I32 match = I_32(value); + + if (value < 0.0) { + if (((double)match) > value) + --match; /* was fractional--truncate other way */ + } + match -= cCOP->uop.scop.scop_offset; + if (match < 0) + match = 0; + else if (match > cCOP->uop.scop.scop_max) + match = cCOP->uop.scop.scop_max; + PL_op = cCOP->uop.scop.scop_next[match]; + RETURNOP(PL_op); +} + +PP(pp_cswitch) +{ + djSP; + register I32 match; + + if (PL_multiline) + PL_op = PL_op->op_next; /* can't assume anything */ + else { + match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255; + match -= cCOP->uop.scop.scop_offset; + if (match < 0) + match = 0; + else if (match > cCOP->uop.scop.scop_max) + match = cCOP->uop.scop.scop_max; + PL_op = cCOP->uop.scop.scop_next[match]; + } + RETURNOP(PL_op); +} +#endif + +/* Eval. */ + +STATIC void +save_lines(AV *array, SV *sv) +{ + register char *s = SvPVX(sv); + register char *send = SvPVX(sv) + SvCUR(sv); + register char *t; + register I32 line = 1; + + while (s && s < send) { + SV *tmpstr = NEWSV(85,0); + + sv_upgrade(tmpstr, SVt_PVMG); + t = strchr(s, '\n'); + if (t) + t++; + else + t = send; + + sv_setpvn(tmpstr, s, t - s); + av_store(array, line++, tmpstr); + s = t; + } +} + +STATIC OP * +docatch(OP *o) +{ + dTHR; + int ret; + OP *oldop = PL_op; + dJMPENV; + + PL_op = o; +#ifdef DEBUGGING + assert(CATCH_GET == TRUE); + DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, PL_top_env)); +#endif + JMPENV_PUSH(ret); + switch (ret) { + default: /* topmost level handles it */ + JMPENV_POP; + PL_op = oldop; + JMPENV_JUMP(ret); + /* NOTREACHED */ + case 3: + if (!PL_restartop) { + PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); + break; + } + PL_op = PL_restartop; + PL_restartop = 0; + /* FALL THROUGH */ + case 0: + CALLRUNOPS(); + break; + } + JMPENV_POP; + PL_op = oldop; + return Nullop; +} + +OP * +sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) +/* sv Text to convert to OP tree. */ +/* startop op_free() this to undo. */ +/* code Short string id of the caller. */ +{ + dSP; /* Make POPBLOCK work. */ + PERL_CONTEXT *cx; + SV **newsp; + I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */ + I32 optype; + OP dummy; + OP *oop = PL_op, *rop; + char tmpbuf[TYPE_DIGITS(long) + 12 + 10]; + char *safestr; + + ENTER; + lex_start(sv); + SAVETMPS; + /* switch to eval mode */ + + if (PL_curcop == &PL_compiling) { + SAVESPTR(PL_compiling.cop_stash); + PL_compiling.cop_stash = PL_curstash; + } + SAVESPTR(PL_compiling.cop_filegv); + SAVEI16(PL_compiling.cop_line); + sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); + PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + PL_compiling.cop_line = 1; + /* XXX For Cs within BEGIN {} blocks, this ends up + deleting the eval's FILEGV from the stash before gv_check() runs + (i.e. before run-time proper). To work around the coredump that + ensues, we always turn GvMULTI_on for any globals that were + introduced within evals. See force_ident(). GSAR 96-10-12 */ + safestr = savepv(tmpbuf); + SAVEDELETE(PL_defstash, safestr, strlen(safestr)); + SAVEHINTS(); +#ifdef OP_IN_REGISTER + PL_opsave = op; +#else + SAVEPPTR(PL_op); +#endif + PL_hints = 0; + + PL_op = &dummy; + PL_op->op_type = 0; /* Avoid uninit warning. */ + PL_op->op_flags = 0; /* Avoid uninit warning. */ + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + rop = doeval(G_SCALAR, startop); + POPBLOCK(cx,PL_curpm); + POPEVAL(cx); + + (*startop)->op_type = OP_NULL; + (*startop)->op_ppaddr = ppaddr[OP_NULL]; + lex_end(); + *avp = (AV*)SvREFCNT_inc(PL_comppad); + LEAVE; +#ifdef OP_IN_REGISTER + op = PL_opsave; +#endif + return rop; +} + +/* With USE_THREADS, eval_owner must be held on entry to doeval */ +STATIC OP * +doeval(int gimme, OP** startop) +{ + dSP; + OP *saveop = PL_op; + HV *newstash; + CV *caller; + AV* comppadlist; + I32 i; + + PL_in_eval = 1; + + PUSHMARK(SP); + + /* set up a scratch pad */ + + SAVEI32(PL_padix); + SAVESPTR(PL_curpad); + SAVESPTR(PL_comppad); + SAVESPTR(PL_comppad_name); + SAVEI32(PL_comppad_name_fill); + SAVEI32(PL_min_intro_pending); + SAVEI32(PL_max_intro_pending); + + caller = PL_compcv; + for (i = cxstack_ix; i >= 0; i--) { + PERL_CONTEXT *cx = &cxstack[i]; + if (cx->cx_type == CXt_EVAL) + break; + else if (cx->cx_type == CXt_SUB) { + caller = cx->blk_sub.cv; + break; + } + } + + SAVESPTR(PL_compcv); + PL_compcv = (CV*)NEWSV(1104,0); + sv_upgrade((SV *)PL_compcv, SVt_PVCV); + CvUNIQUE_on(PL_compcv); +#ifdef USE_THREADS + CvOWNER(PL_compcv) = 0; + New(666, CvMUTEXP(PL_compcv), 1, perl_mutex); + MUTEX_INIT(CvMUTEXP(PL_compcv)); +#endif /* USE_THREADS */ + + PL_comppad = newAV(); + av_push(PL_comppad, Nullsv); + PL_curpad = AvARRAY(PL_comppad); + PL_comppad_name = newAV(); + PL_comppad_name_fill = 0; + PL_min_intro_pending = 0; + PL_padix = 0; +#ifdef USE_THREADS + av_store(PL_comppad_name, 0, newSVpv("@_", 2)); + PL_curpad[0] = (SV*)newAV(); + SvPADMY_on(PL_curpad[0]); /* XXX Needed? */ +#endif /* USE_THREADS */ + + comppadlist = newAV(); + AvREAL_off(comppadlist); + av_store(comppadlist, 0, (SV*)PL_comppad_name); + av_store(comppadlist, 1, (SV*)PL_comppad); + CvPADLIST(PL_compcv) = comppadlist; + + if (!saveop || saveop->op_type != OP_REQUIRE) + CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller); + + SAVEFREESV(PL_compcv); + + /* make sure we compile in the right package */ + + newstash = PL_curcop->cop_stash; + if (PL_curstash != newstash) { + SAVESPTR(PL_curstash); + PL_curstash = newstash; + } + SAVESPTR(PL_beginav); + PL_beginav = newAV(); + SAVEFREESV(PL_beginav); + + /* try to compile it */ + + PL_eval_root = Nullop; + PL_error_count = 0; + PL_curcop = &PL_compiling; + PL_curcop->cop_arybase = 0; + SvREFCNT_dec(PL_rs); + PL_rs = newSVpv("\n", 1); + if (saveop && saveop->op_flags & OPf_SPECIAL) + PL_in_eval |= 4; + else + sv_setpv(ERRSV,""); + if (yyparse() || PL_error_count || !PL_eval_root) { + SV **newsp; + I32 gimme; + PERL_CONTEXT *cx; + I32 optype = 0; /* Might be reset by POPEVAL. */ + + PL_op = saveop; + if (PL_eval_root) { + op_free(PL_eval_root); + PL_eval_root = Nullop; + } + SP = PL_stack_base + POPMARK; /* pop original mark */ + if (!startop) { + POPBLOCK(cx,PL_curpm); + POPEVAL(cx); + pop_return(); + } + lex_end(); + LEAVE; + if (optype == OP_REQUIRE) { + char* msg = SvPVx(ERRSV, PL_na); + DIE("%s", *msg ? msg : "Compilation failed in require"); + } else if (startop) { + char* msg = SvPVx(ERRSV, PL_na); + + POPBLOCK(cx,PL_curpm); + POPEVAL(cx); + croak("%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n")); + } + SvREFCNT_dec(PL_rs); + PL_rs = SvREFCNT_inc(PL_nrs); +#ifdef USE_THREADS + MUTEX_LOCK(&PL_eval_mutex); + PL_eval_owner = 0; + COND_SIGNAL(&PL_eval_cond); + MUTEX_UNLOCK(&PL_eval_mutex); +#endif /* USE_THREADS */ + RETPUSHUNDEF; + } + SvREFCNT_dec(PL_rs); + PL_rs = SvREFCNT_inc(PL_nrs); + PL_compiling.cop_line = 0; + if (startop) { + *startop = PL_eval_root; + SvREFCNT_dec(CvOUTSIDE(PL_compcv)); + CvOUTSIDE(PL_compcv) = Nullcv; + } else + SAVEFREEOP(PL_eval_root); + if (gimme & G_VOID) + scalarvoid(PL_eval_root); + else if (gimme & G_ARRAY) + list(PL_eval_root); + else + scalar(PL_eval_root); + + DEBUG_x(dump_eval()); + + /* Register with debugger: */ + if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) { + CV *cv = perl_get_cv("DB::postponed", FALSE); + if (cv) { + dSP; + PUSHMARK(SP); + XPUSHs((SV*)PL_compiling.cop_filegv); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + } + } + + /* compiled okay, so do it */ + + CvDEPTH(PL_compcv) = 1; + SP = PL_stack_base + POPMARK; /* pop original mark */ + PL_op = saveop; /* The caller may need it. */ +#ifdef USE_THREADS + MUTEX_LOCK(&PL_eval_mutex); + PL_eval_owner = 0; + COND_SIGNAL(&PL_eval_cond); + MUTEX_UNLOCK(&PL_eval_mutex); +#endif /* USE_THREADS */ + + RETURNOP(PL_eval_start); +} + +PP(pp_require) +{ + djSP; + register PERL_CONTEXT *cx; + SV *sv; + char *name; + STRLEN len; + char *tryname; + SV *namesv = Nullsv; + SV** svp; + I32 gimme = G_SCALAR; + PerlIO *tryrsfp = 0; + + sv = POPs; + if (SvNIOKp(sv) && !SvPOKp(sv)) { + SET_NUMERIC_STANDARD(); + if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) + DIE("Perl %s required--this is only version %s, stopped", + SvPV(sv,PL_na),PL_patchlevel); + RETPUSHYES; + } + name = SvPV(sv, len); + if (!(name && len > 0 && *name)) + DIE("Null filename used"); + TAINT_PROPER("require"); + if (PL_op->op_type == OP_REQUIRE && + (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0)) && + *svp != &PL_sv_undef) + RETPUSHYES; + + /* prepare to compile file */ + + if (*name == '/' || + (*name == '.' && + (name[1] == '/' || + (name[1] == '.' && name[2] == '/'))) +#ifdef DOSISH + || (name[0] && name[1] == ':') +#endif +#ifdef WIN32 + || (name[0] == '\\' && name[1] == '\\') /* UNC path */ +#endif +#ifdef VMS + || (strchr(name,':') || ((*name == '[' || *name == '<') && + (isALNUM(name[1]) || strchr("$-_]>",name[1])))) +#endif + ) + { + tryname = name; + tryrsfp = PerlIO_open(name,PERL_SCRIPT_MODE); + } + else { + AV *ar = GvAVn(PL_incgv); + I32 i; +#ifdef VMS + char *unixname; + if ((unixname = tounixspec(name, Nullch)) != Nullch) +#endif + { + namesv = NEWSV(806, 0); + for (i = 0; i <= AvFILL(ar); i++) { + char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); +#ifdef VMS + char *unixdir; + if ((unixdir = tounixpath(dir, Nullch)) == Nullch) + continue; + sv_setpv(namesv, unixdir); + sv_catpv(namesv, unixname); +#else + sv_setpvf(namesv, "%s/%s", dir, name); +#endif + tryname = SvPVX(namesv); + tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE); + if (tryrsfp) { + if (tryname[0] == '.' && tryname[1] == '/') + tryname += 2; + break; + } + } + } + } + SAVESPTR(PL_compiling.cop_filegv); + PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); + SvREFCNT_dec(namesv); + if (!tryrsfp) { + if (PL_op->op_type == OP_REQUIRE) { + SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name)); + SV *dirmsgsv = NEWSV(0, 0); + AV *ar = GvAVn(PL_incgv); + I32 i; + if (instr(SvPVX(msg), ".h ")) + sv_catpv(msg, " (change .h to .ph maybe?)"); + if (instr(SvPVX(msg), ".ph ")) + sv_catpv(msg, " (did you run h2ph?)"); + sv_catpv(msg, " (@INC contains:"); + for (i = 0; i <= AvFILL(ar); i++) { + char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); + sv_setpvf(dirmsgsv, " %s", dir); + sv_catsv(msg, dirmsgsv); + } + sv_catpvn(msg, ")", 1); + SvREFCNT_dec(dirmsgsv); + DIE("%_", msg); + } + + RETPUSHUNDEF; + } + + /* Assume success here to prevent recursive requirement. */ + (void)hv_store(GvHVn(PL_incgv), name, strlen(name), + newSVsv(GvSV(PL_compiling.cop_filegv)), 0 ); + + ENTER; + SAVETMPS; + lex_start(sv_2mortal(newSVpv("",0))); + if (PL_rsfp_filters){ + save_aptr(&PL_rsfp_filters); + PL_rsfp_filters = NULL; + } + + PL_rsfp = tryrsfp; + name = savepv(name); + SAVEFREEPV(name); + SAVEHINTS(); + PL_hints = 0; + + /* switch to eval mode */ + + push_return(PL_op->op_next); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, name, PL_compiling.cop_filegv); + + PL_compiling.cop_line = 0; + + PUTBACK; +#ifdef USE_THREADS + MUTEX_LOCK(&PL_eval_mutex); + if (PL_eval_owner && PL_eval_owner != thr) + while (PL_eval_owner) + COND_WAIT(&PL_eval_cond, &PL_eval_mutex); + PL_eval_owner = thr; + MUTEX_UNLOCK(&PL_eval_mutex); +#endif /* USE_THREADS */ + return DOCATCH(doeval(G_SCALAR, NULL)); +} + +PP(pp_dofile) +{ + return pp_require(ARGS); +} + +PP(pp_entereval) +{ + djSP; + register PERL_CONTEXT *cx; + dPOPss; + I32 gimme = GIMME_V, was = PL_sub_generation; + char tmpbuf[TYPE_DIGITS(long) + 12]; + char *safestr; + STRLEN len; + OP *ret; + + if (!SvPV(sv,len) || !len) + RETPUSHUNDEF; + TAINT_PROPER("eval"); + + ENTER; + lex_start(sv); + SAVETMPS; + + /* switch to eval mode */ + + SAVESPTR(PL_compiling.cop_filegv); + sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); + PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + PL_compiling.cop_line = 1; + /* XXX For Cs within BEGIN {} blocks, this ends up + deleting the eval's FILEGV from the stash before gv_check() runs + (i.e. before run-time proper). To work around the coredump that + ensues, we always turn GvMULTI_on for any globals that were + introduced within evals. See force_ident(). GSAR 96-10-12 */ + safestr = savepv(tmpbuf); + SAVEDELETE(PL_defstash, safestr, strlen(safestr)); + SAVEHINTS(); + PL_hints = PL_op->op_targ; + + push_return(PL_op->op_next); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + + /* prepare to compile string */ + + if (PERLDB_LINE && PL_curstash != PL_debstash) + save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr); + PUTBACK; +#ifdef USE_THREADS + MUTEX_LOCK(&PL_eval_mutex); + if (PL_eval_owner && PL_eval_owner != thr) + while (PL_eval_owner) + COND_WAIT(&PL_eval_cond, &PL_eval_mutex); + PL_eval_owner = thr; + MUTEX_UNLOCK(&PL_eval_mutex); +#endif /* USE_THREADS */ + ret = doeval(gimme, NULL); + if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */ + && ret != PL_op->op_next) { /* Successive compilation. */ + strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ + } + return DOCATCH(ret); +} + +PP(pp_leaveeval) +{ + djSP; + register SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + register PERL_CONTEXT *cx; + OP *retop; + U8 save_flags = PL_op -> op_flags; + I32 optype; + + POPBLOCK(cx,newpm); + POPEVAL(cx); + retop = pop_return(); + + TAINT_NOT; + if (gimme == G_VOID) + MARK = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } + else { + MEXTEND(mark,0); + *MARK = &PL_sv_undef; + } + } + else { + /* in case LEAVE wipes old return values */ + for (mark = newsp + 1; mark <= SP; mark++) { + if (!(SvFLAGS(*mark) & SVs_TEMP)) { + *mark = sv_mortalcopy(*mark); + TAINT_NOT; /* Each item is independent */ + } + } + } + PL_curpm = newpm; /* Don't pop $1 et al till now */ + + /* + * Closures mentioned at top level of eval cannot be referenced + * again, and their presence indirectly causes a memory leak. + * (Note that the fact that compcv and friends are still set here + * is, AFAIK, an accident.) --Chip + */ + if (AvFILLp(PL_comppad_name) >= 0) { + SV **svp = AvARRAY(PL_comppad_name); + I32 ix; + for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { + SV *sv = svp[ix]; + if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { + SvREFCNT_dec(sv); + svp[ix] = &PL_sv_undef; + + sv = PL_curpad[ix]; + if (CvCLONE(sv)) { + SvREFCNT_dec(CvOUTSIDE(sv)); + CvOUTSIDE(sv) = Nullcv; + } + else { + SvREFCNT_dec(sv); + sv = NEWSV(0,0); + SvPADTMP_on(sv); + PL_curpad[ix] = sv; + } + } + } + } + +#ifdef DEBUGGING + assert(CvDEPTH(PL_compcv) == 1); +#endif + CvDEPTH(PL_compcv) = 0; + lex_end(); + + if (optype == OP_REQUIRE && + !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp)) + { + /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; + (void)hv_delete(GvHVn(PL_incgv), name, strlen(name), G_DISCARD); + retop = die("%s did not return a true value", name); + /* die_where() did LEAVE, or we won't be here */ + } + else { + LEAVE; + if (!(save_flags & OPf_SPECIAL)) + sv_setpv(ERRSV,""); + } + + RETURNOP(retop); +} + +PP(pp_entertry) +{ + djSP; + register PERL_CONTEXT *cx; + I32 gimme = GIMME_V; + + ENTER; + SAVETMPS; + + push_return(cLOGOP->op_other->op_next); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, 0, 0); + PL_eval_root = PL_op; /* Only needed so that goto works right. */ + + PL_in_eval = 1; + sv_setpv(ERRSV,""); + PUTBACK; + return DOCATCH(PL_op->op_next); +} + +PP(pp_leavetry) +{ + djSP; + register SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + register PERL_CONTEXT *cx; + I32 optype; + + POPBLOCK(cx,newpm); + POPEVAL(cx); + pop_return(); + + TAINT_NOT; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } + else { + MEXTEND(mark,0); + *MARK = &PL_sv_undef; + } + SP = MARK; + } + else { + /* in case LEAVE wipes old return values */ + for (mark = newsp + 1; mark <= SP; mark++) { + if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) { + *mark = sv_mortalcopy(*mark); + TAINT_NOT; /* Each item is independent */ + } + } + } + PL_curpm = newpm; /* Don't pop $1 et al till now */ + + LEAVE; + sv_setpv(ERRSV,""); + RETURN; +} + +STATIC void +doparseform(SV *sv) +{ + STRLEN len; + register char *s = SvPV_force(sv, len); + register char *send = s + len; + register char *base; + register I32 skipspaces = 0; + bool noblank; + bool repeat; + bool postspace = FALSE; + U16 *fops; + register U16 *fpc; + U16 *linepc; + register I32 arg; + bool ischop; + + if (len == 0) + croak("Null picture in formline"); + + New(804, fops, (send - s)*3+10, U16); /* Almost certainly too long... */ + fpc = fops; + + if (s < send) { + linepc = fpc; + *fpc++ = FF_LINEMARK; + noblank = repeat = FALSE; + base = s; + } + + while (s <= send) { + switch (*s++) { + default: + skipspaces = 0; + continue; + + case '~': + if (*s == '~') { + repeat = TRUE; + *s = ' '; + } + noblank = TRUE; + s[-1] = ' '; + /* FALL THROUGH */ + case ' ': case '\t': + skipspaces++; + continue; + + case '\n': case 0: + arg = s - base; + skipspaces++; + arg -= skipspaces; + if (arg) { + if (postspace) + *fpc++ = FF_SPACE; + *fpc++ = FF_LITERAL; + *fpc++ = arg; + } + postspace = FALSE; + if (s <= send) + skipspaces--; + if (skipspaces) { + *fpc++ = FF_SKIP; + *fpc++ = skipspaces; + } + skipspaces = 0; + if (s <= send) + *fpc++ = FF_NEWLINE; + if (noblank) { + *fpc++ = FF_BLANK; + if (repeat) + arg = fpc - linepc + 1; + else + arg = 0; + *fpc++ = arg; + } + if (s < send) { + linepc = fpc; + *fpc++ = FF_LINEMARK; + noblank = repeat = FALSE; + base = s; + } + else + s++; + continue; + + case '@': + case '^': + ischop = s[-1] == '^'; + + if (postspace) { + *fpc++ = FF_SPACE; + postspace = FALSE; + } + arg = (s - base) - 1; + if (arg) { + *fpc++ = FF_LITERAL; + *fpc++ = arg; + } + + base = s - 1; + *fpc++ = FF_FETCH; + if (*s == '*') { + s++; + *fpc++ = 0; + *fpc++ = FF_LINEGLOB; + } + else if (*s == '#' || (*s == '.' && s[1] == '#')) { + arg = ischop ? 512 : 0; + base = s - 1; + while (*s == '#') + s++; + if (*s == '.') { + char *f; + s++; + f = s; + while (*s == '#') + s++; + arg |= 256 + (s - f); + } + *fpc++ = s - base; /* fieldsize for FETCH */ + *fpc++ = FF_DECIMAL; + *fpc++ = arg; + } + else { + I32 prespace = 0; + bool ismore = FALSE; + + if (*s == '>') { + while (*++s == '>') ; + prespace = FF_SPACE; + } + else if (*s == '|') { + while (*++s == '|') ; + prespace = FF_HALFSPACE; + postspace = TRUE; + } + else { + if (*s == '<') + while (*++s == '<') ; + postspace = TRUE; + } + if (*s == '.' && s[1] == '.' && s[2] == '.') { + s += 3; + ismore = TRUE; + } + *fpc++ = s - base; /* fieldsize for FETCH */ + + *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL; + + if (prespace) + *fpc++ = prespace; + *fpc++ = FF_ITEM; + if (ismore) + *fpc++ = FF_MORE; + if (ischop) + *fpc++ = FF_CHOP; + } + base = s; + skipspaces = 0; + continue; + } + } + *fpc++ = FF_END; + + arg = fpc - fops; + { /* need to jump to the next word */ + int z; + z = WORD_ALIGN - SvCUR(sv) % WORD_ALIGN; + SvGROW(sv, SvCUR(sv) + z + arg * sizeof(U16) + 4); + s = SvPVX(sv) + SvCUR(sv) + z; + } + Copy(fops, s, arg, U16); + Safefree(fops); + sv_magic(sv, Nullsv, 'f', Nullch, 0); + SvCOMPILED_on(sv); +} + +/* + * The rest of this file was derived from source code contributed + * by Tom Horsley. + * + * NOTE: this code was derived from Tom Horsley's qsort replacement + * and should not be confused with the original code. + */ + +/* Copyright (C) Tom Horsley, 1997. All rights reserved. + + Permission granted to distribute under the same terms as perl which are + (briefly): + + This program is free software; you can redistribute it and/or modify + it under the terms of either: + + a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or + + b) the "Artistic License" which comes with this Kit. + + Details on the perl license can be found in the perl source code which + may be located via the www.perl.com web page. + + This is the most wonderfulest possible qsort I can come up with (and + still be mostly portable) My (limited) tests indicate it consistently + does about 20% fewer calls to compare than does the qsort in the Visual + C++ library, other vendors may vary. + + Some of the ideas in here can be found in "Algorithms" by Sedgewick, + others I invented myself (or more likely re-invented since they seemed + pretty obvious once I watched the algorithm operate for a while). + + Most of this code was written while watching the Marlins sweep the Giants + in the 1997 National League Playoffs - no Braves fans allowed to use this + code (just kidding :-). + + I realize that if I wanted to be true to the perl tradition, the only + comment in this file would be something like: + + ...they shuffled back towards the rear of the line. 'No, not at the + rear!' the slave-driver shouted. 'Three files up. And stay there... + + However, I really needed to violate that tradition just so I could keep + track of what happens myself, not to mention some poor fool trying to + understand this years from now :-). +*/ + +/* ********************************************************** Configuration */ + +#ifndef QSORT_ORDER_GUESS +#define QSORT_ORDER_GUESS 2 /* Select doubling version of the netBSD trick */ +#endif + +/* QSORT_MAX_STACK is the largest number of partitions that can be stacked up for + future processing - a good max upper bound is log base 2 of memory size + (32 on 32 bit machines, 64 on 64 bit machines, etc). In reality can + safely be smaller than that since the program is taking up some space and + most operating systems only let you grab some subset of contiguous + memory (not to mention that you are normally sorting data larger than + 1 byte element size :-). +*/ +#ifndef QSORT_MAX_STACK +#define QSORT_MAX_STACK 32 +#endif + +/* QSORT_BREAK_EVEN is the size of the largest partition we should insertion sort. + Anything bigger and we use qsort. If you make this too small, the qsort + will probably break (or become less efficient), because it doesn't expect + the middle element of a partition to be the same as the right or left - + you have been warned). +*/ +#ifndef QSORT_BREAK_EVEN +#define QSORT_BREAK_EVEN 6 +#endif + +/* ************************************************************* Data Types */ + +/* hold left and right index values of a partition waiting to be sorted (the + partition includes both left and right - right is NOT one past the end or + anything like that). +*/ +struct partition_stack_entry { + int left; + int right; +#ifdef QSORT_ORDER_GUESS + int qsort_break_even; +#endif +}; + +/* ******************************************************* Shorthand Macros */ + +/* Note that these macros will be used from inside the qsort function where + we happen to know that the variable 'elt_size' contains the size of an + array element and the variable 'temp' points to enough space to hold a + temp element and the variable 'array' points to the array being sorted + and 'compare' is the pointer to the compare routine. + + Also note that there are very many highly architecture specific ways + these might be sped up, but this is simply the most generally portable + code I could think of. +*/ + +/* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2 +*/ +#ifdef PERL_OBJECT +#define qsort_cmp(elt1, elt2) \ + ((this->*compare)(array[elt1], array[elt2])) +#else +#define qsort_cmp(elt1, elt2) \ + ((*compare)(array[elt1], array[elt2])) +#endif + +#ifdef QSORT_ORDER_GUESS +#define QSORT_NOTICE_SWAP swapped++; +#else +#define QSORT_NOTICE_SWAP +#endif + +/* swaps contents of array elements elt1, elt2. +*/ +#define qsort_swap(elt1, elt2) \ + STMT_START { \ + QSORT_NOTICE_SWAP \ + temp = array[elt1]; \ + array[elt1] = array[elt2]; \ + array[elt2] = temp; \ + } STMT_END + +/* rotate contents of elt1, elt2, elt3 such that elt1 gets elt2, elt2 gets + elt3 and elt3 gets elt1. +*/ +#define qsort_rotate(elt1, elt2, elt3) \ + STMT_START { \ + QSORT_NOTICE_SWAP \ + temp = array[elt1]; \ + array[elt1] = array[elt2]; \ + array[elt2] = array[elt3]; \ + array[elt3] = temp; \ + } STMT_END + +/* ************************************************************ Debug stuff */ + +#ifdef QSORT_DEBUG + +static void +break_here() +{ + return; /* good place to set a breakpoint */ +} + +#define qsort_assert(t) (void)( (t) || (break_here(), 0) ) + +static void +doqsort_all_asserts( + void * array, + size_t num_elts, + size_t elt_size, + int (*compare)(const void * elt1, const void * elt2), + int pc_left, int pc_right, int u_left, int u_right) +{ + int i; + + qsort_assert(pc_left <= pc_right); + qsort_assert(u_right < pc_left); + qsort_assert(pc_right < u_left); + for (i = u_right + 1; i < pc_left; ++i) { + qsort_assert(qsort_cmp(i, pc_left) < 0); + } + for (i = pc_left; i < pc_right; ++i) { + qsort_assert(qsort_cmp(i, pc_right) == 0); + } + for (i = pc_right + 1; i < u_left; ++i) { + qsort_assert(qsort_cmp(pc_right, i) < 0); + } +} + +#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) \ + doqsort_all_asserts(array, num_elts, elt_size, compare, \ + PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) + +#else + +#define qsort_assert(t) ((void)0) + +#define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) ((void)0) + +#endif + +/* ****************************************************************** qsort */ + +STATIC void +#ifdef PERL_OBJECT +qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare) +#else +qsortsv( + SV ** array, + size_t num_elts, + I32 (*compare)(SV *a, SV *b)) +#endif +{ + register SV * temp; + + struct partition_stack_entry partition_stack[QSORT_MAX_STACK]; + int next_stack_entry = 0; + + int part_left; + int part_right; +#ifdef QSORT_ORDER_GUESS + int qsort_break_even; + int swapped; +#endif + + /* Make sure we actually have work to do. + */ + if (num_elts <= 1) { + return; + } + + /* Setup the initial partition definition and fall into the sorting loop + */ + part_left = 0; + part_right = (int)(num_elts - 1); +#ifdef QSORT_ORDER_GUESS + qsort_break_even = QSORT_BREAK_EVEN; +#else +#define qsort_break_even QSORT_BREAK_EVEN +#endif + for ( ; ; ) { + if ((part_right - part_left) >= qsort_break_even) { + /* OK, this is gonna get hairy, so lets try to document all the + concepts and abbreviations and variables and what they keep + track of: + + pc: pivot chunk - the set of array elements we accumulate in the + middle of the partition, all equal in value to the original + pivot element selected. The pc is defined by: + + pc_left - the leftmost array index of the pc + pc_right - the rightmost array index of the pc + + we start with pc_left == pc_right and only one element + in the pivot chunk (but it can grow during the scan). + + u: uncompared elements - the set of elements in the partition + we have not yet compared to the pivot value. There are two + uncompared sets during the scan - one to the left of the pc + and one to the right. + + u_right - the rightmost index of the left side's uncompared set + u_left - the leftmost index of the right side's uncompared set + + The leftmost index of the left sides's uncompared set + doesn't need its own variable because it is always defined + by the leftmost edge of the whole partition (part_left). The + same goes for the rightmost edge of the right partition + (part_right). + + We know there are no uncompared elements on the left once we + get u_right < part_left and no uncompared elements on the + right once u_left > part_right. When both these conditions + are met, we have completed the scan of the partition. + + Any elements which are between the pivot chunk and the + uncompared elements should be less than the pivot value on + the left side and greater than the pivot value on the right + side (in fact, the goal of the whole algorithm is to arrange + for that to be true and make the groups of less-than and + greater-then elements into new partitions to sort again). + + As you marvel at the complexity of the code and wonder why it + has to be so confusing. Consider some of the things this level + of confusion brings: + + Once I do a compare, I squeeze every ounce of juice out of it. I + never do compare calls I don't have to do, and I certainly never + do redundant calls. + + I also never swap any elements unless I can prove there is a + good reason. Many sort algorithms will swap a known value with + an uncompared value just to get things in the right place (or + avoid complexity :-), but that uncompared value, once it gets + compared, may then have to be swapped again. A lot of the + complexity of this code is due to the fact that it never swaps + anything except compared values, and it only swaps them when the + compare shows they are out of position. + */ + int pc_left, pc_right; + int u_right, u_left; + + int s; + + pc_left = ((part_left + part_right) / 2); + pc_right = pc_left; + u_right = pc_left - 1; + u_left = pc_right + 1; + + /* Qsort works best when the pivot value is also the median value + in the partition (unfortunately you can't find the median value + without first sorting :-), so to give the algorithm a helping + hand, we pick 3 elements and sort them and use the median value + of that tiny set as the pivot value. + + Some versions of qsort like to use the left middle and right as + the 3 elements to sort so they can insure the ends of the + partition will contain values which will stop the scan in the + compare loop, but when you have to call an arbitrarily complex + routine to do a compare, its really better to just keep track of + array index values to know when you hit the edge of the + partition and avoid the extra compare. An even better reason to + avoid using a compare call is the fact that you can drop off the + edge of the array if someone foolishly provides you with an + unstable compare function that doesn't always provide consistent + results. + + So, since it is simpler for us to compare the three adjacent + elements in the middle of the partition, those are the ones we + pick here (conveniently pointed at by u_right, pc_left, and + u_left). The values of the left, center, and right elements + are refered to as l c and r in the following comments. + */ + +#ifdef QSORT_ORDER_GUESS + swapped = 0; +#endif + s = qsort_cmp(u_right, pc_left); + if (s < 0) { + /* l < c */ + s = qsort_cmp(pc_left, u_left); + /* if l < c, c < r - already in order - nothing to do */ + if (s == 0) { + /* l < c, c == r - already in order, pc grows */ + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s > 0) { + /* l < c, c > r - need to know more */ + s = qsort_cmp(u_right, u_left); + if (s < 0) { + /* l < c, c > r, l < r - swap c & r to get ordered */ + qsort_swap(pc_left, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l < c, c > r, l == r - swap c&r, grow pc */ + qsort_swap(pc_left, u_left); + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l < c, c > r, l > r - make lcr into rlc to get ordered */ + qsort_rotate(pc_left, u_right, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } + } else if (s == 0) { + /* l == c */ + s = qsort_cmp(pc_left, u_left); + if (s < 0) { + /* l == c, c < r - already in order, grow pc */ + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l == c, c == r - already in order, grow pc both ways */ + --pc_left; + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l == c, c > r - swap l & r, grow pc */ + qsort_swap(u_right, u_left); + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } else { + /* l > c */ + s = qsort_cmp(pc_left, u_left); + if (s < 0) { + /* l > c, c < r - need to know more */ + s = qsort_cmp(u_right, u_left); + if (s < 0) { + /* l > c, c < r, l < r - swap l & c to get ordered */ + qsort_swap(u_right, pc_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else if (s == 0) { + /* l > c, c < r, l == r - swap l & c, grow pc */ + qsort_swap(u_right, pc_left); + ++pc_right; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l > c, c < r, l > r - rotate lcr into crl to order */ + qsort_rotate(u_right, pc_left, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } else if (s == 0) { + /* l > c, c == r - swap ends, grow pc */ + qsort_swap(u_right, u_left); + --pc_left; + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } else { + /* l > c, c > r - swap ends to get in order */ + qsort_swap(u_right, u_left); + qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1); + } + } + /* We now know the 3 middle elements have been compared and + arranged in the desired order, so we can shrink the uncompared + sets on both sides + */ + --u_right; + ++u_left; + qsort_all_asserts(pc_left, pc_right, u_left, u_right); + + /* The above massive nested if was the simple part :-). We now have + the middle 3 elements ordered and we need to scan through the + uncompared sets on either side, swapping elements that are on + the wrong side or simply shuffling equal elements around to get + all equal elements into the pivot chunk. + */ + + for ( ; ; ) { + int still_work_on_left; + int still_work_on_right; + + /* Scan the uncompared values on the left. If I find a value + equal to the pivot value, move it over so it is adjacent to + the pivot chunk and expand the pivot chunk. If I find a value + less than the pivot value, then just leave it - its already + on the correct side of the partition. If I find a greater + value, then stop the scan. + */ + while (still_work_on_left = (u_right >= part_left)) { + s = qsort_cmp(u_right, pc_left); + if (s < 0) { + --u_right; + } else if (s == 0) { + --pc_left; + if (pc_left != u_right) { + qsort_swap(u_right, pc_left); + } + --u_right; + } else { + break; + } + qsort_assert(u_right < pc_left); + qsort_assert(pc_left <= pc_right); + qsort_assert(qsort_cmp(u_right + 1, pc_left) <= 0); + qsort_assert(qsort_cmp(pc_left, pc_right) == 0); + } + + /* Do a mirror image scan of uncompared values on the right + */ + while (still_work_on_right = (u_left <= part_right)) { + s = qsort_cmp(pc_right, u_left); + if (s < 0) { + ++u_left; + } else if (s == 0) { + ++pc_right; + if (pc_right != u_left) { + qsort_swap(pc_right, u_left); + } + ++u_left; + } else { + break; + } + qsort_assert(u_left > pc_right); + qsort_assert(pc_left <= pc_right); + qsort_assert(qsort_cmp(pc_right, u_left - 1) <= 0); + qsort_assert(qsort_cmp(pc_left, pc_right) == 0); + } + + if (still_work_on_left) { + /* I know I have a value on the left side which needs to be + on the right side, but I need to know more to decide + exactly the best thing to do with it. + */ + if (still_work_on_right) { + /* I know I have values on both side which are out of + position. This is a big win because I kill two birds + with one swap (so to speak). I can advance the + uncompared pointers on both sides after swapping both + of them into the right place. + */ + qsort_swap(u_right, u_left); + --u_right; + ++u_left; + qsort_all_asserts(pc_left, pc_right, u_left, u_right); + } else { + /* I have an out of position value on the left, but the + right is fully scanned, so I "slide" the pivot chunk + and any less-than values left one to make room for the + greater value over on the right. If the out of position + value is immediately adjacent to the pivot chunk (there + are no less-than values), I can do that with a swap, + otherwise, I have to rotate one of the less than values + into the former position of the out of position value + and the right end of the pivot chunk into the left end + (got all that?). + */ + --pc_left; + if (pc_left == u_right) { + qsort_swap(u_right, pc_right); + qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1); + } else { + qsort_rotate(u_right, pc_left, pc_right); + qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1); + } + --pc_right; + --u_right; + } + } else if (still_work_on_right) { + /* Mirror image of complex case above: I have an out of + position value on the right, but the left is fully + scanned, so I need to shuffle things around to make room + for the right value on the left. + */ + ++pc_right; + if (pc_right == u_left) { + qsort_swap(u_left, pc_left); + qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right); + } else { + qsort_rotate(pc_right, pc_left, u_left); + qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right); + } + ++pc_left; + ++u_left; + } else { + /* No more scanning required on either side of partition, + break out of loop and figure out next set of partitions + */ + break; + } + } + + /* The elements in the pivot chunk are now in the right place. They + will never move or be compared again. All I have to do is decide + what to do with the stuff to the left and right of the pivot + chunk. + + Notes on the QSORT_ORDER_GUESS ifdef code: + + 1. If I just built these partitions without swapping any (or + very many) elements, there is a chance that the elements are + already ordered properly (being properly ordered will + certainly result in no swapping, but the converse can't be + proved :-). + + 2. A (properly written) insertion sort will run faster on + already ordered data than qsort will. + + 3. Perhaps there is some way to make a good guess about + switching to an insertion sort earlier than partition size 6 + (for instance - we could save the partition size on the stack + and increase the size each time we find we didn't swap, thus + switching to insertion sort earlier for partitions with a + history of not swapping). + + 4. Naturally, if I just switch right away, it will make + artificial benchmarks with pure ascending (or descending) + data look really good, but is that a good reason in general? + Hard to say... + */ + +#ifdef QSORT_ORDER_GUESS + if (swapped < 3) { +#if QSORT_ORDER_GUESS == 1 + qsort_break_even = (part_right - part_left) + 1; +#endif +#if QSORT_ORDER_GUESS == 2 + qsort_break_even *= 2; +#endif +#if QSORT_ORDER_GUESS == 3 + int prev_break = qsort_break_even; + qsort_break_even *= qsort_break_even; + if (qsort_break_even < prev_break) { + qsort_break_even = (part_right - part_left) + 1; + } +#endif + } else { + qsort_break_even = QSORT_BREAK_EVEN; + } +#endif + + if (part_left < pc_left) { + /* There are elements on the left which need more processing. + Check the right as well before deciding what to do. + */ + if (pc_right < part_right) { + /* We have two partitions to be sorted. Stack the biggest one + and process the smallest one on the next iteration. This + minimizes the stack height by insuring that any additional + stack entries must come from the smallest partition which + (because it is smallest) will have the fewest + opportunities to generate additional stack entries. + */ + if ((part_right - pc_right) > (pc_left - part_left)) { + /* stack the right partition, process the left */ + partition_stack[next_stack_entry].left = pc_right + 1; + partition_stack[next_stack_entry].right = part_right; +#ifdef QSORT_ORDER_GUESS + partition_stack[next_stack_entry].qsort_break_even = qsort_break_even; +#endif + part_right = pc_left - 1; + } else { + /* stack the left partition, process the right */ + partition_stack[next_stack_entry].left = part_left; + partition_stack[next_stack_entry].right = pc_left - 1; +#ifdef QSORT_ORDER_GUESS + partition_stack[next_stack_entry].qsort_break_even = qsort_break_even; +#endif + part_left = pc_right + 1; + } + qsort_assert(next_stack_entry < QSORT_MAX_STACK); + ++next_stack_entry; + } else { + /* The elements on the left are the only remaining elements + that need sorting, arrange for them to be processed as the + next partition. + */ + part_right = pc_left - 1; + } + } else if (pc_right < part_right) { + /* There is only one chunk on the right to be sorted, make it + the new partition and loop back around. + */ + part_left = pc_right + 1; + } else { + /* This whole partition wound up in the pivot chunk, so + we need to get a new partition off the stack. + */ + if (next_stack_entry == 0) { + /* the stack is empty - we are done */ + break; + } + --next_stack_entry; + part_left = partition_stack[next_stack_entry].left; + part_right = partition_stack[next_stack_entry].right; +#ifdef QSORT_ORDER_GUESS + qsort_break_even = partition_stack[next_stack_entry].qsort_break_even; +#endif + } + } else { + /* This partition is too small to fool with qsort complexity, just + do an ordinary insertion sort to minimize overhead. + */ + int i; + /* Assume 1st element is in right place already, and start checking + at 2nd element to see where it should be inserted. + */ + for (i = part_left + 1; i <= part_right; ++i) { + int j; + /* Scan (backwards - just in case 'i' is already in right place) + through the elements already sorted to see if the ith element + belongs ahead of one of them. + */ + for (j = i - 1; j >= part_left; --j) { + if (qsort_cmp(i, j) >= 0) { + /* i belongs right after j + */ + break; + } + } + ++j; + if (j != i) { + /* Looks like we really need to move some things + */ + int k; + temp = array[i]; + for (k = i - 1; k >= j; --k) + array[k + 1] = array[k]; + array[j] = temp; + } + } + + /* That partition is now sorted, grab the next one, or get out + of the loop if there aren't any more. + */ + + if (next_stack_entry == 0) { + /* the stack is empty - we are done */ + break; + } + --next_stack_entry; + part_left = partition_stack[next_stack_entry].left; + part_right = partition_stack[next_stack_entry].right; +#ifdef QSORT_ORDER_GUESS + qsort_break_even = partition_stack[next_stack_entry].qsort_break_even; +#endif + } + } + + /* Believe it or not, the array is sorted at this point! */ +} diff --git a/contrib/perl5/pp_hot.c b/contrib/perl5/pp_hot.c new file mode 100644 index 00000000000..e82c0957cab --- /dev/null +++ b/contrib/perl5/pp_hot.c @@ -0,0 +1,2535 @@ +/* pp_hot.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * Then he heard Merry change the note, and up went the Horn-cry of Buckland, + * shaking the air. + * + * Awake! Awake! Fear, Fire, Foes! Awake! + * Fire, Foes! Awake! + */ + +#include "EXTERN.h" +#include "perl.h" + +#ifdef I_UNISTD +#include +#endif +#ifdef I_FCNTL +#include +#endif +#ifdef I_SYS_FILE +#include +#endif + +/* Hot code. */ + +#ifdef USE_THREADS +static void +unset_cvowner(void *cvarg) +{ + register CV* cv = (CV *) cvarg; +#ifdef DEBUGGING + dTHR; +#endif /* DEBUGGING */ + + DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", + thr, cv, SvPEEK((SV*)cv)))); + MUTEX_LOCK(CvMUTEXP(cv)); + DEBUG_S(if (CvDEPTH(cv) != 0) + PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", + CvDEPTH(cv));); + assert(thr == CvOWNER(cv)); + CvOWNER(cv) = 0; + MUTEX_UNLOCK(CvMUTEXP(cv)); + SvREFCNT_dec(cv); +} +#endif /* USE_THREADS */ + +PP(pp_const) +{ + djSP; + XPUSHs(cSVOP->op_sv); + RETURN; +} + +PP(pp_nextstate) +{ + PL_curcop = (COP*)PL_op; + TAINT_NOT; /* Each statement is presumed innocent */ + PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + FREETMPS; + return NORMAL; +} + +PP(pp_gvsv) +{ + djSP; + EXTEND(SP,1); + if (PL_op->op_private & OPpLVAL_INTRO) + PUSHs(save_scalar(cGVOP->op_gv)); + else + PUSHs(GvSV(cGVOP->op_gv)); + RETURN; +} + +PP(pp_null) +{ + return NORMAL; +} + +PP(pp_pushmark) +{ + PUSHMARK(PL_stack_sp); + return NORMAL; +} + +PP(pp_stringify) +{ + djSP; dTARGET; + STRLEN len; + char *s; + s = SvPV(TOPs,len); + sv_setpvn(TARG,s,len); + SETTARG; + RETURN; +} + +PP(pp_gv) +{ + djSP; + XPUSHs((SV*)cGVOP->op_gv); + RETURN; +} + +PP(pp_and) +{ + djSP; + if (!SvTRUE(TOPs)) + RETURN; + else { + --SP; + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_sassign) +{ + djSP; dPOPTOPssrl; + MAGIC *mg; + + if (PL_op->op_private & OPpASSIGN_BACKWARDS) { + SV *temp; + temp = left; left = right; right = temp; + } + if (PL_tainting && PL_tainted && !SvTAINTED(left)) + TAINT_NOT; + SvSetMagicSV(right, left); + SETs(right); + RETURN; +} + +PP(pp_cond_expr) +{ + djSP; + if (SvTRUEx(POPs)) + RETURNOP(cCONDOP->op_true); + else + RETURNOP(cCONDOP->op_false); +} + +PP(pp_unstack) +{ + I32 oldsave; + TAINT_NOT; /* Each statement is presumed innocent */ + PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + FREETMPS; + oldsave = PL_scopestack[PL_scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + return NORMAL; +} + +PP(pp_concat) +{ + djSP; dATARGET; tryAMAGICbin(concat,opASSIGN); + { + dPOPTOPssrl; + STRLEN len; + char *s; + if (TARG != left) { + s = SvPV(left,len); + sv_setpvn(TARG,s,len); + } + else if (SvGMAGICAL(TARG)) + mg_get(TARG); + else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) { + sv_setpv(TARG, ""); /* Suppress warning. */ + s = SvPV_force(TARG, len); + } + s = SvPV(right,len); + if (SvOK(TARG)) + sv_catpvn(TARG,s,len); + else + sv_setpvn(TARG,s,len); /* suppress warning */ + SETTARG; + RETURN; + } +} + +PP(pp_padsv) +{ + djSP; dTARGET; + XPUSHs(TARG); + if (PL_op->op_flags & OPf_MOD) { + if (PL_op->op_private & OPpLVAL_INTRO) + SAVECLEARSV(PL_curpad[PL_op->op_targ]); + else if (PL_op->op_private & OPpDEREF) { + PUTBACK; + vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF); + SPAGAIN; + } + } + RETURN; +} + +PP(pp_readline) +{ + PL_last_in_gv = (GV*)(*PL_stack_sp--); + return do_readline(); +} + +PP(pp_eq) +{ + djSP; tryAMAGICbinSET(eq,0); + { + dPOPnv; + SETs(boolSV(TOPn == value)); + RETURN; + } +} + +PP(pp_preinc) +{ + djSP; + if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + croak(no_modify); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MAX) + { + ++SvIVX(TOPs); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); + } + else + sv_inc(TOPs); + SvSETMAGIC(TOPs); + return NORMAL; +} + +PP(pp_or) +{ + djSP; + if (SvTRUE(TOPs)) + RETURN; + else { + --SP; + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_add) +{ + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + { + dPOPTOPnnrl_ul; + SETn( left + right ); + RETURN; + } +} + +PP(pp_aelemfast) +{ + djSP; + AV *av = GvAV((GV*)cSVOP->op_sv); + U32 lval = PL_op->op_flags & OPf_MOD; + SV** svp = av_fetch(av, PL_op->op_private, lval); + SV *sv = (svp ? *svp : &PL_sv_undef); + EXTEND(SP, 1); + if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ + sv = sv_mortalcopy(sv); + PUSHs(sv); + RETURN; +} + +PP(pp_join) +{ + djSP; dMARK; dTARGET; + MARK++; + do_join(TARG, *MARK, MARK, SP); + SP = MARK; + SETs(TARG); + RETURN; +} + +PP(pp_pushre) +{ + djSP; +#ifdef DEBUGGING + /* + * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs + * will be enough to hold an OP*. + */ + SV* sv = sv_newmortal(); + sv_upgrade(sv, SVt_PVLV); + LvTYPE(sv) = '/'; + Copy(&PL_op, &LvTARGOFF(sv), 1, OP*); + XPUSHs(sv); +#else + XPUSHs((SV*)PL_op); +#endif + RETURN; +} + +/* Oversized hot code. */ + +PP(pp_print) +{ + djSP; dMARK; dORIGMARK; + GV *gv; + IO *io; + register PerlIO *fp; + MAGIC *mg; + + if (PL_op->op_flags & OPf_STACKED) + gv = (GV*)*++MARK; + else + gv = PL_defoutgv; + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (MARK == ORIGMARK) { + /* If using default handle then we need to make space to + * pass object as 1st arg, so move other args up ... + */ + MEXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + PUSHMARK(MARK - 1); + *MARK = mg->mg_obj; + PUTBACK; + ENTER; + perl_call_method("PRINT", G_SCALAR); + LEAVE; + SPAGAIN; + MARK = ORIGMARK + 1; + *MARK = *SP; + SP = MARK; + RETURN; + } + if (!(io = GvIO(gv))) { + if (PL_dowarn) { + SV* sv = sv_newmortal(); + gv_fullname3(sv, gv, Nullch); + warn("Filehandle %s never opened", SvPV(sv,PL_na)); + } + + SETERRNO(EBADF,RMS$_IFI); + goto just_say_no; + } + else if (!(fp = IoOFP(io))) { + if (PL_dowarn) { + SV* sv = sv_newmortal(); + gv_fullname3(sv, gv, Nullch); + if (IoIFP(io)) + warn("Filehandle %s opened only for input", SvPV(sv,PL_na)); + else + warn("print on closed filehandle %s", SvPV(sv,PL_na)); + } + SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); + goto just_say_no; + } + else { + MARK++; + if (PL_ofslen) { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + if (MARK <= SP) { + if (PerlIO_write(fp, PL_ofs, PL_ofslen) == 0 || PerlIO_error(fp)) { + MARK--; + break; + } + } + } + } + else { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + } + } + if (MARK <= SP) + goto just_say_no; + else { + if (PL_orslen) + if (PerlIO_write(fp, PL_ors, PL_orslen) == 0 || PerlIO_error(fp)) + goto just_say_no; + + if (IoFLAGS(io) & IOf_FLUSH) + if (PerlIO_flush(fp) == EOF) + goto just_say_no; + } + } + SP = ORIGMARK; + PUSHs(&PL_sv_yes); + RETURN; + + just_say_no: + SP = ORIGMARK; + PUSHs(&PL_sv_undef); + RETURN; +} + +PP(pp_rv2av) +{ + djSP; dPOPss; + AV *av; + + if (SvROK(sv)) { + wasref: + av = (AV*)SvRV(sv); + if (SvTYPE(av) != SVt_PVAV) + DIE("Not an ARRAY reference"); + if (PL_op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + else { + if (SvTYPE(sv) == SVt_PVAV) { + av = (AV*)sv; + if (PL_op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + else { + GV *gv; + + if (SvTYPE(sv) != SVt_PVGV) { + char *sym; + + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (PL_op->op_flags & OPf_REF || + PL_op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "an ARRAY"); + if (PL_dowarn) + warn(warn_uninit); + if (GIMME == G_ARRAY) + RETURN; + RETPUSHUNDEF; + } + sym = SvPV(sv,PL_na); + if (PL_op->op_private & HINT_STRICT_REFS) + DIE(no_symref, sym, "an ARRAY"); + gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV); + } else { + gv = (GV*)sv; + } + av = GvAVn(gv); + if (PL_op->op_private & OPpLVAL_INTRO) + av = save_ary(gv); + if (PL_op->op_flags & OPf_REF) { + PUSHs((SV*)av); + RETURN; + } + } + } + + if (GIMME == G_ARRAY) { + I32 maxarg = AvFILL(av) + 1; + EXTEND(SP, maxarg); + if (SvRMAGICAL(av)) { + U32 i; + for (i=0; i < maxarg; i++) { + SV **svp = av_fetch(av, i, FALSE); + SP[i+1] = (svp) ? *svp : &PL_sv_undef; + } + } + else { + Copy(AvARRAY(av), SP+1, maxarg, SV*); + } + SP += maxarg; + } + else { + dTARGET; + I32 maxarg = AvFILL(av) + 1; + PUSHi(maxarg); + } + RETURN; +} + +PP(pp_rv2hv) +{ + djSP; dTOPss; + HV *hv; + + if (SvROK(sv)) { + wasref: + hv = (HV*)SvRV(sv); + if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) + DIE("Not a HASH reference"); + if (PL_op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + else { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) { + hv = (HV*)sv; + if (PL_op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + else { + GV *gv; + + if (SvTYPE(sv) != SVt_PVGV) { + char *sym; + + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvROK(sv)) + goto wasref; + } + if (!SvOK(sv)) { + if (PL_op->op_flags & OPf_REF || + PL_op->op_private & HINT_STRICT_REFS) + DIE(no_usym, "a HASH"); + if (PL_dowarn) + warn(warn_uninit); + if (GIMME == G_ARRAY) { + SP--; + RETURN; + } + RETSETUNDEF; + } + sym = SvPV(sv,PL_na); + if (PL_op->op_private & HINT_STRICT_REFS) + DIE(no_symref, sym, "a HASH"); + gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV); + } else { + gv = (GV*)sv; + } + hv = GvHVn(gv); + if (PL_op->op_private & OPpLVAL_INTRO) + hv = save_hash(gv); + if (PL_op->op_flags & OPf_REF) { + SETs((SV*)hv); + RETURN; + } + } + } + + if (GIMME == G_ARRAY) { /* array wanted */ + *PL_stack_sp = (SV*)hv; + return do_kv(ARGS); + } + else { + dTARGET; + if (SvTYPE(hv) == SVt_PVAV) + hv = avhv_keys((AV*)hv); + if (HvFILL(hv)) + sv_setpvf(TARG, "%ld/%ld", + (long)HvFILL(hv), (long)HvMAX(hv) + 1); + else + sv_setiv(TARG, 0); + + SETTARG; + RETURN; + } +} + +PP(pp_aassign) +{ + djSP; + SV **lastlelem = PL_stack_sp; + SV **lastrelem = PL_stack_base + POPMARK; + SV **firstrelem = PL_stack_base + POPMARK + 1; + SV **firstlelem = lastrelem + 1; + + register SV **relem; + register SV **lelem; + + register SV *sv; + register AV *ary; + + I32 gimme; + HV *hash; + I32 i; + int magic; + + PL_delaymagic = DM_DELAY; /* catch simultaneous items */ + + /* If there's a common identifier on both sides we have to take + * special care that assigning the identifier on the left doesn't + * clobber a value on the right that's used later in the list. + */ + if (PL_op->op_private & OPpASSIGN_COMMON) { + for (relem = firstrelem; relem <= lastrelem; relem++) { + /*SUPPRESS 560*/ + if (sv = *relem) { + TAINT_NOT; /* Each item is independent */ + *relem = sv_mortalcopy(sv); + } + } + } + + relem = firstrelem; + lelem = firstlelem; + ary = Null(AV*); + hash = Null(HV*); + while (lelem <= lastlelem) { + TAINT_NOT; /* Each item stands on its own, taintwise. */ + sv = *lelem++; + switch (SvTYPE(sv)) { + case SVt_PVAV: + ary = (AV*)sv; + magic = SvMAGICAL(ary) != 0; + + av_clear(ary); + av_extend(ary, lastrelem - relem); + i = 0; + while (relem <= lastrelem) { /* gobble up all the rest */ + SV **didstore; + sv = NEWSV(28,0); + assert(*relem); + sv_setsv(sv,*relem); + *(relem++) = sv; + didstore = av_store(ary,i++,sv); + if (magic) { + if (SvSMAGICAL(sv)) + mg_set(sv); + if (!didstore) + SvREFCNT_dec(sv); + } + TAINT_NOT; + } + break; + case SVt_PVHV: { + SV *tmpstr; + + hash = (HV*)sv; + magic = SvMAGICAL(hash) != 0; + hv_clear(hash); + + while (relem < lastrelem) { /* gobble up all the rest */ + HE *didstore; + if (*relem) + sv = *(relem++); + else + sv = &PL_sv_no, relem++; + tmpstr = NEWSV(29,0); + if (*relem) + sv_setsv(tmpstr,*relem); /* value */ + *(relem++) = tmpstr; + didstore = hv_store_ent(hash,sv,tmpstr,0); + if (magic) { + if (SvSMAGICAL(tmpstr)) + mg_set(tmpstr); + if (!didstore) + SvREFCNT_dec(tmpstr); + } + TAINT_NOT; + } + if (relem == lastrelem) { + if (*relem) { + HE *didstore; + if (PL_dowarn) { + if (relem == firstrelem && + SvROK(*relem) && + ( SvTYPE(SvRV(*relem)) == SVt_PVAV || + SvTYPE(SvRV(*relem)) == SVt_PVHV ) ) + warn("Reference found where even-sized list expected"); + else + warn("Odd number of elements in hash assignment"); + } + tmpstr = NEWSV(29,0); + didstore = hv_store_ent(hash,*relem,tmpstr,0); + if (magic) { + if (SvSMAGICAL(tmpstr)) + mg_set(tmpstr); + if (!didstore) + SvREFCNT_dec(tmpstr); + } + TAINT_NOT; + } + relem++; + } + } + break; + default: + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv) && PL_curcop != &PL_compiling) { + if (!SvIMMORTAL(sv)) + DIE(no_modify); + if (relem <= lastrelem) + relem++; + break; + } + if (SvROK(sv)) + sv_unref(sv); + } + if (relem <= lastrelem) { + sv_setsv(sv, *relem); + *(relem++) = sv; + } + else + sv_setsv(sv, &PL_sv_undef); + SvSETMAGIC(sv); + break; + } + } + if (PL_delaymagic & ~DM_DELAY) { + if (PL_delaymagic & DM_UID) { +#ifdef HAS_SETRESUID + (void)setresuid(PL_uid,PL_euid,(Uid_t)-1); +#else +# ifdef HAS_SETREUID + (void)setreuid(PL_uid,PL_euid); +# else +# ifdef HAS_SETRUID + if ((PL_delaymagic & DM_UID) == DM_RUID) { + (void)setruid(PL_uid); + PL_delaymagic &= ~DM_RUID; + } +# endif /* HAS_SETRUID */ +# ifdef HAS_SETEUID + if ((PL_delaymagic & DM_UID) == DM_EUID) { + (void)seteuid(PL_uid); + PL_delaymagic &= ~DM_EUID; + } +# endif /* HAS_SETEUID */ + if (PL_delaymagic & DM_UID) { + if (PL_uid != PL_euid) + DIE("No setreuid available"); + (void)PerlProc_setuid(PL_uid); + } +# endif /* HAS_SETREUID */ +#endif /* HAS_SETRESUID */ + PL_uid = (int)PerlProc_getuid(); + PL_euid = (int)PerlProc_geteuid(); + } + if (PL_delaymagic & DM_GID) { +#ifdef HAS_SETRESGID + (void)setresgid(PL_gid,PL_egid,(Gid_t)-1); +#else +# ifdef HAS_SETREGID + (void)setregid(PL_gid,PL_egid); +# else +# ifdef HAS_SETRGID + if ((PL_delaymagic & DM_GID) == DM_RGID) { + (void)setrgid(PL_gid); + PL_delaymagic &= ~DM_RGID; + } +# endif /* HAS_SETRGID */ +# ifdef HAS_SETEGID + if ((PL_delaymagic & DM_GID) == DM_EGID) { + (void)setegid(PL_gid); + PL_delaymagic &= ~DM_EGID; + } +# endif /* HAS_SETEGID */ + if (PL_delaymagic & DM_GID) { + if (PL_gid != PL_egid) + DIE("No setregid available"); + (void)PerlProc_setgid(PL_gid); + } +# endif /* HAS_SETREGID */ +#endif /* HAS_SETRESGID */ + PL_gid = (int)PerlProc_getgid(); + PL_egid = (int)PerlProc_getegid(); + } + PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); + } + PL_delaymagic = 0; + + gimme = GIMME_V; + if (gimme == G_VOID) + SP = firstrelem - 1; + else if (gimme == G_SCALAR) { + dTARGET; + SP = firstrelem; + SETi(lastrelem - firstrelem + 1); + } + else { + if (ary || hash) + SP = lastrelem; + else + SP = firstrelem + (lastlelem - firstlelem); + lelem = firstlelem + (relem - firstrelem); + while (relem <= SP) + *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef; + } + RETURN; +} + +PP(pp_qr) +{ + djSP; + register PMOP *pm = cPMOP; + SV *rv = sv_newmortal(); + SV *sv = newSVrv(rv, "Regexp"); + sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0); + RETURNX(PUSHs(rv)); +} + +PP(pp_match) +{ + djSP; dTARG; + register PMOP *pm = cPMOP; + register char *t; + register char *s; + char *strend; + I32 global; + I32 safebase; + char *truebase; + register REGEXP *rx = pm->op_pmregexp; + bool rxtainted; + I32 gimme = GIMME; + STRLEN len; + I32 minmatch = 0; + I32 oldsave = PL_savestack_ix; + I32 update_minmatch = 1; + SV *screamer; + + if (PL_op->op_flags & OPf_STACKED) + TARG = POPs; + else { + TARG = DEFSV; + EXTEND(SP,1); + } + PUTBACK; /* EVAL blocks need stack_sp. */ + s = SvPV(TARG, len); + strend = s + len; + if (!s) + DIE("panic: do_match"); + rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) || + (PL_tainted && (pm->op_pmflags & PMf_RETAINT))); + TAINT_NOT; + + if (pm->op_pmdynflags & PMdf_USED) { + failure: + if (gimme == G_ARRAY) + RETURN; + RETPUSHNO; + } + + if (!rx->prelen && PL_curpm) { + pm = PL_curpm; + rx = pm->op_pmregexp; + } + if (rx->minlen > len) goto failure; + + screamer = ( (SvSCREAM(TARG) && rx->check_substr + && SvTYPE(rx->check_substr) == SVt_PVBM + && SvVALID(rx->check_substr)) + ? TARG : Nullsv); + truebase = t = s; + if (global = pm->op_pmflags & PMf_GLOBAL) { + rx->startp[0] = 0; + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { + MAGIC* mg = mg_find(TARG, 'g'); + if (mg && mg->mg_len >= 0) { + rx->endp[0] = rx->startp[0] = s + mg->mg_len; + minmatch = (mg->mg_flags & MGf_MINMATCH); + update_minmatch = 0; + } + } + } + safebase = (((gimme == G_ARRAY) || global || !rx->nparens) + && !PL_sawampersand); + safebase = safebase ? 0 : REXEC_COPY_STR ; + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(PL_multiline); + PL_multiline = pm->op_pmflags & PMf_MULTILINE; + } + +play_it_again: + if (global && rx->startp[0]) { + t = s = rx->endp[0]; + if ((s + rx->minlen) > strend) + goto nope; + if (update_minmatch++) + minmatch = (s == rx->startp[0]); + } + if (rx->check_substr) { + if (!(rx->reganch & ROPT_NOSCAN)) { /* Floating checkstring. */ + if ( screamer ) { + I32 p = -1; + + if (PL_screamfirst[BmRARE(rx->check_substr)] < 0) + goto nope; + else if (!(s = screaminstr(TARG, rx->check_substr, + rx->check_offset_min, 0, &p, 0))) + goto nope; + else if ((rx->reganch & ROPT_CHECK_ALL) + && !PL_sawampersand && !SvTAIL(rx->check_substr)) + goto yup; + } + else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min, + (unsigned char*)strend, + rx->check_substr, 0))) + goto nope; + else if ((rx->reganch & ROPT_CHECK_ALL) && !PL_sawampersand) + goto yup; + if (s && rx->check_offset_max < s - t) { + ++BmUSEFUL(rx->check_substr); + s -= rx->check_offset_max; + } + else + s = t; + } + /* Now checkstring is fixed, i.e. at fixed offset from the + beginning of match, and the match is anchored at s. */ + else if (!PL_multiline) { /* Anchored near beginning of string. */ + I32 slen; + if (*SvPVX(rx->check_substr) != s[rx->check_offset_min] + || ((slen = SvCUR(rx->check_substr)) > 1 + && memNE(SvPVX(rx->check_substr), + s + rx->check_offset_min, slen))) + goto nope; + } + if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0 + && rx->check_substr == rx->float_substr) { + SvREFCNT_dec(rx->check_substr); + rx->check_substr = Nullsv; /* opt is being useless */ + rx->float_substr = Nullsv; + } + } + if (CALLREGEXEC(rx, s, strend, truebase, minmatch, + screamer, NULL, safebase)) + { + PL_curpm = pm; + if (pm->op_pmflags & PMf_ONCE) + pm->op_pmdynflags |= PMdf_USED; + goto gotcha; + } + else + goto ret_no; + /*NOTREACHED*/ + + gotcha: + if (rxtainted) + RX_MATCH_TAINTED_on(rx); + TAINT_IF(RX_MATCH_TAINTED(rx)); + if (gimme == G_ARRAY) { + I32 iters, i, len; + + iters = rx->nparens; + if (global && !iters) + i = 1; + else + i = 0; + SPAGAIN; /* EVAL blocks could move the stack. */ + EXTEND(SP, iters + i); + EXTEND_MORTAL(iters + i); + for (i = !i; i <= iters; i++) { + PUSHs(sv_newmortal()); + /*SUPPRESS 560*/ + if ((s = rx->startp[i]) && rx->endp[i] ) { + len = rx->endp[i] - s; + sv_setpvn(*SP, s, len); + } + } + if (global) { + truebase = rx->subbeg; + strend = rx->subend; + if (rx->startp[0] && rx->startp[0] == rx->endp[0]) + ++rx->endp[0]; + PUTBACK; /* EVAL blocks may use stack */ + goto play_it_again; + } + else if (!iters) + XPUSHs(&PL_sv_yes); + LEAVE_SCOPE(oldsave); + RETURN; + } + else { + if (global) { + MAGIC* mg = 0; + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) + mg = mg_find(TARG, 'g'); + if (!mg) { + sv_magic(TARG, (SV*)0, 'g', Nullch, 0); + mg = mg_find(TARG, 'g'); + } + if (rx->startp[0]) { + mg->mg_len = rx->endp[0] - rx->subbeg; + if (rx->startp[0] == rx->endp[0]) + mg->mg_flags |= MGf_MINMATCH; + else + mg->mg_flags &= ~MGf_MINMATCH; + } + } + LEAVE_SCOPE(oldsave); + RETPUSHYES; + } + +yup: /* Confirmed by check_substr */ + if (rxtainted) + RX_MATCH_TAINTED_on(rx); + TAINT_IF(RX_MATCH_TAINTED(rx)); + ++BmUSEFUL(rx->check_substr); + PL_curpm = pm; + if (pm->op_pmflags & PMf_ONCE) + pm->op_pmdynflags |= PMdf_USED; + Safefree(rx->subbase); + rx->subbase = Nullch; + if (global) { + rx->subbeg = truebase; + rx->subend = strend; + rx->startp[0] = s; + rx->endp[0] = s + SvCUR(rx->check_substr); + goto gotcha; + } + if (PL_sawampersand) { + char *tmps; + + tmps = rx->subbase = savepvn(t, strend-t); + rx->subbeg = tmps; + rx->subend = tmps + (strend-t); + tmps = rx->startp[0] = tmps + (s - t); + rx->endp[0] = tmps + SvCUR(rx->check_substr); + } + LEAVE_SCOPE(oldsave); + RETPUSHYES; + +nope: + if (rx->check_substr) + ++BmUSEFUL(rx->check_substr); + +ret_no: + if (global && !(pm->op_pmflags & PMf_CONTINUE)) { + if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { + MAGIC* mg = mg_find(TARG, 'g'); + if (mg) + mg->mg_len = -1; + } + } + LEAVE_SCOPE(oldsave); + if (gimme == G_ARRAY) + RETURN; + RETPUSHNO; +} + +OP * +do_readline(void) +{ + dSP; dTARGETSTACKED; + register SV *sv; + STRLEN tmplen = 0; + STRLEN offset; + PerlIO *fp; + register IO *io = GvIO(PL_last_in_gv); + register I32 type = PL_op->op_type; + I32 gimme = GIMME_V; + MAGIC *mg; + + if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + perl_call_method("READLINE", gimme); + LEAVE; + SPAGAIN; + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); + RETURN; + } + fp = Nullfp; + if (io) { + fp = IoIFP(io); + if (!fp) { + if (IoFLAGS(io) & IOf_ARGV) { + if (IoFLAGS(io) & IOf_START) { + IoFLAGS(io) &= ~IOf_START; + IoLINES(io) = 0; + if (av_len(GvAVn(PL_last_in_gv)) < 0) { + do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp); + sv_setpvn(GvSV(PL_last_in_gv), "-", 1); + SvSETMAGIC(GvSV(PL_last_in_gv)); + fp = IoIFP(io); + goto have_fp; + } + } + fp = nextargv(PL_last_in_gv); + if (!fp) { /* Note: fp != IoIFP(io) */ + (void)do_close(PL_last_in_gv, FALSE); /* now it does*/ + IoFLAGS(io) |= IOf_START; + } + } + else if (type == OP_GLOB) { + SV *tmpcmd = NEWSV(55, 0); + SV *tmpglob = POPs; + ENTER; + SAVEFREESV(tmpcmd); +#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */ + /* since spawning off a process is a real performance hit */ + { +#include +#include +#include +#include + char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'}; + char vmsspec[NAM$C_MAXRSS+1]; + char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp; + char tmpfnam[L_tmpnam] = "SYS$SCRATCH:"; + $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;"); + PerlIO *tmpfp; + STRLEN i; + struct dsc$descriptor_s wilddsc + = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct dsc$descriptor_vs rsdsc + = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt}; + unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0; + + /* We could find out if there's an explicit dev/dir or version + by peeking into lib$find_file's internal context at + ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb + but that's unsupported, so I don't want to do it now and + have it bite someone in the future. */ + strcat(tmpfnam,PerlLIO_tmpnam(NULL)); + cp = SvPV(tmpglob,i); + for (; i; i--) { + if (cp[i] == ';') hasver = 1; + if (cp[i] == '.') { + if (sts) hasver = 1; + else sts = 1; + } + if (cp[i] == '/') { + hasdir = isunix = 1; + break; + } + if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') { + hasdir = 1; + break; + } + } + if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) { + Stat_t st; + if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode)) + ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL); + else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); + if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); + while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt, + &dfltdsc,NULL,NULL,NULL))&1)) { + end = rstr + (unsigned long int) *rslt; + if (!hasver) while (*end != ';') end--; + *(end++) = '\n'; *end = '\0'; + for (cp = rstr; *cp; cp++) *cp = _tolower(*cp); + if (hasdir) { + if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1); + begin = rstr; + } + else { + begin = end; + while (*(--begin) != ']' && *begin != '>') ; + ++begin; + } + ok = (PerlIO_puts(tmpfp,begin) != EOF); + } + if (cxt) (void)lib$find_file_end(&cxt); + if (ok && sts != RMS$_NMF && + sts != RMS$_DNF && sts != RMS$_FNF) ok = 0; + if (!ok) { + if (!(sts & 1)) { + SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts); + } + PerlIO_close(tmpfp); + fp = NULL; + } + else { + PerlIO_rewind(tmpfp); + IoTYPE(io) = '<'; + IoIFP(io) = fp = tmpfp; + IoFLAGS(io) &= ~IOf_UNTAINT; /* maybe redundant */ + } + } + } +#else /* !VMS */ +#ifdef DOSISH +#ifdef OS2 + sv_setpv(tmpcmd, "for a in "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |"); +#else +#ifdef DJGPP + sv_setpv(tmpcmd, "/dev/dosglob/"); /* File System Extension */ + sv_catsv(tmpcmd, tmpglob); +#else + sv_setpv(tmpcmd, "perlglob "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, " |"); +#endif /* !DJGPP */ +#endif /* !OS2 */ +#else /* !DOSISH */ +#if defined(CSH) + sv_setpvn(tmpcmd, PL_cshname, PL_cshlen); + sv_catpv(tmpcmd, " -cf 'set nonomatch; glob "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, "' 2>/dev/null |"); +#else + sv_setpv(tmpcmd, "echo "); + sv_catsv(tmpcmd, tmpglob); +#if 'z' - 'a' == 25 + sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); +#else + sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|"); +#endif +#endif /* !CSH */ +#endif /* !DOSISH */ + (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd), + FALSE, O_RDONLY, 0, Nullfp); + fp = IoIFP(io); +#endif /* !VMS */ + LEAVE; + } + } + else if (type == OP_GLOB) + SP--; + } + if (!fp) { + if (PL_dowarn && io && !(IoFLAGS(io) & IOf_START)) + warn("Read on closed filehandle <%s>", GvENAME(PL_last_in_gv)); + if (gimme == G_SCALAR) { + (void)SvOK_off(TARG); + PUSHTARG; + } + RETURN; + } + have_fp: + if (gimme == G_SCALAR) { + sv = TARG; + if (SvROK(sv)) + sv_unref(sv); + (void)SvUPGRADE(sv, SVt_PV); + tmplen = SvLEN(sv); /* remember if already alloced */ + if (!tmplen) + Sv_Grow(sv, 80); /* try short-buffering it */ + if (type == OP_RCATLINE) + offset = SvCUR(sv); + else + offset = 0; + } + else { + sv = sv_2mortal(NEWSV(57, 80)); + offset = 0; + } + for (;;) { + if (!sv_gets(sv, fp, offset)) { + PerlIO_clearerr(fp); + if (IoFLAGS(io) & IOf_ARGV) { + fp = nextargv(PL_last_in_gv); + if (fp) + continue; + (void)do_close(PL_last_in_gv, FALSE); + IoFLAGS(io) |= IOf_START; + } + else if (type == OP_GLOB) { + if (!do_close(PL_last_in_gv, FALSE)) + warn("internal error: glob failed"); + } + if (gimme == G_SCALAR) { + (void)SvOK_off(TARG); + PUSHTARG; + } + RETURN; + } + /* This should not be marked tainted if the fp is marked clean */ + if (!(IoFLAGS(io) & IOf_UNTAINT)) { + TAINT; + SvTAINTED_on(sv); + } + IoLINES(io)++; + SvSETMAGIC(sv); + XPUSHs(sv); + if (type == OP_GLOB) { + char *tmps; + + if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) { + tmps = SvEND(sv) - 1; + if (*tmps == *SvPVX(PL_rs)) { + *tmps = '\0'; + SvCUR(sv)--; + } + } + for (tmps = SvPVX(sv); *tmps; tmps++) + if (!isALPHA(*tmps) && !isDIGIT(*tmps) && + strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) + break; + if (*tmps && PerlLIO_stat(SvPVX(sv), &PL_statbuf) < 0) { + (void)POPs; /* Unmatched wildcard? Chuck it... */ + continue; + } + } + if (gimme == G_ARRAY) { + if (SvLEN(sv) - SvCUR(sv) > 20) { + SvLEN_set(sv, SvCUR(sv)+1); + Renew(SvPVX(sv), SvLEN(sv), char); + } + sv = sv_2mortal(NEWSV(58, 80)); + continue; + } + else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) { + /* try to reclaim a bit of scalar space (only on 1st alloc) */ + if (SvCUR(sv) < 60) + SvLEN_set(sv, 80); + else + SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */ + Renew(SvPVX(sv), SvLEN(sv), char); + } + RETURN; + } +} + +PP(pp_enter) +{ + djSP; + register PERL_CONTEXT *cx; + I32 gimme = OP_GIMME(PL_op, -1); + + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } + + ENTER; + + SAVETMPS; + PUSHBLOCK(cx, CXt_BLOCK, SP); + + RETURN; +} + +PP(pp_helem) +{ + djSP; + HE* he; + SV **svp; + SV *keysv = POPs; + HV *hv = (HV*)POPs; + U32 lval = PL_op->op_flags & OPf_MOD; + U32 defer = PL_op->op_private & OPpLVAL_DEFER; + SV *sv; + + if (SvTYPE(hv) == SVt_PVHV) { + he = hv_fetch_ent(hv, keysv, lval && !defer, 0); + svp = he ? &HeVAL(he) : 0; + } + else if (SvTYPE(hv) == SVt_PVAV) { + if (PL_op->op_private & OPpLVAL_INTRO) + DIE("Can't localize pseudo-hash element"); + svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0); + } + else { + RETPUSHUNDEF; + } + if (lval) { + if (!svp || *svp == &PL_sv_undef) { + SV* lv; + SV* key2; + if (!defer) + DIE(no_helem, SvPV(keysv, PL_na)); + lv = sv_newmortal(); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0); + SvREFCNT_dec(key2); /* sv_magic() increments refcount */ + LvTARG(lv) = SvREFCNT_inc(hv); + LvTARGLEN(lv) = 1; + PUSHs(lv); + RETURN; + } + if (PL_op->op_private & OPpLVAL_INTRO) { + if (HvNAME(hv) && isGV(*svp)) + save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL)); + else + save_helem(hv, keysv, svp); + } + else if (PL_op->op_private & OPpDEREF) + vivify_ref(*svp, PL_op->op_private & OPpDEREF); + } + sv = (svp ? *svp : &PL_sv_undef); + /* This makes C possible. + * Pushing the magical RHS on to the stack is useless, since + * that magic is soon destined to be misled by the local(), + * and thus the later pp_sassign() will fail to mg_get() the + * old value. This should also cure problems with delayed + * mg_get()s. GSAR 98-07-03 */ + if (!lval && SvGMAGICAL(sv)) + sv = sv_mortalcopy(sv); + PUSHs(sv); + RETURN; +} + +PP(pp_leave) +{ + djSP; + register PERL_CONTEXT *cx; + register SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + + if (PL_op->op_flags & OPf_SPECIAL) { + cx = &cxstack[cxstack_ix]; + cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */ + } + + POPBLOCK(cx,newpm); + + gimme = OP_GIMME(PL_op, -1); + if (gimme == -1) { + if (cxstack_ix >= 0) + gimme = cxstack[cxstack_ix].blk_gimme; + else + gimme = G_SCALAR; + } + + TAINT_NOT; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + else { + MEXTEND(mark,0); + *MARK = &PL_sv_undef; + } + SP = MARK; + } + else if (gimme == G_ARRAY) { + /* in case LEAVE wipes old return values */ + for (mark = newsp + 1; mark <= SP; mark++) { + if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) { + *mark = sv_mortalcopy(*mark); + TAINT_NOT; /* Each item is independent */ + } + } + } + PL_curpm = newpm; /* Don't pop $1 et al till now */ + + LEAVE; + + RETURN; +} + +PP(pp_iter) +{ + djSP; + register PERL_CONTEXT *cx; + SV* sv; + AV* av; + + EXTEND(SP, 1); + cx = &cxstack[cxstack_ix]; + if (cx->cx_type != CXt_LOOP) + DIE("panic: pp_iter"); + + av = cx->blk_loop.iterary; + if (SvTYPE(av) != SVt_PVAV) { + /* iterate ($min .. $max) */ + if (cx->blk_loop.iterlval) { + /* string increment */ + register SV* cur = cx->blk_loop.iterlval; + STRLEN maxlen; + char *max = SvPV((SV*)av, maxlen); + if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { +#ifndef USE_THREADS /* don't risk potential race */ + if (SvREFCNT(*cx->blk_loop.itervar) == 1 + && !SvMAGICAL(*cx->blk_loop.itervar)) + { + /* safe to reuse old SV */ + sv_setsv(*cx->blk_loop.itervar, cur); + } + else +#endif + { + /* we need a fresh SV every time so that loop body sees a + * completely new SV for closures/references to work as + * they used to */ + SvREFCNT_dec(*cx->blk_loop.itervar); + *cx->blk_loop.itervar = newSVsv(cur); + } + if (strEQ(SvPVX(cur), max)) + sv_setiv(cur, 0); /* terminate next time */ + else + sv_inc(cur); + RETPUSHYES; + } + RETPUSHNO; + } + /* integer increment */ + if (cx->blk_loop.iterix > cx->blk_loop.itermax) + RETPUSHNO; + +#ifndef USE_THREADS /* don't risk potential race */ + if (SvREFCNT(*cx->blk_loop.itervar) == 1 + && !SvMAGICAL(*cx->blk_loop.itervar)) + { + /* safe to reuse old SV */ + sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); + } + else +#endif + { + /* we need a fresh SV every time so that loop body sees a + * completely new SV for closures/references to work as they + * used to */ + SvREFCNT_dec(*cx->blk_loop.itervar); + *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++); + } + RETPUSHYES; + } + + /* iterate array */ + if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av))) + RETPUSHNO; + + SvREFCNT_dec(*cx->blk_loop.itervar); + + if (sv = (SvMAGICAL(av)) + ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) + : AvARRAY(av)[++cx->blk_loop.iterix]) + SvTEMP_off(sv); + else + sv = &PL_sv_undef; + if (av != PL_curstack && SvIMMORTAL(sv)) { + SV *lv = cx->blk_loop.iterlval; + if (lv && SvREFCNT(lv) > 1) { + SvREFCNT_dec(lv); + lv = Nullsv; + } + if (lv) + SvREFCNT_dec(LvTARG(lv)); + else { + lv = cx->blk_loop.iterlval = NEWSV(26, 0); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, Nullsv, 'y', Nullch, 0); + } + LvTARG(lv) = SvREFCNT_inc(av); + LvTARGOFF(lv) = cx->blk_loop.iterix; + LvTARGLEN(lv) = (UV) -1; + sv = (SV*)lv; + } + + *cx->blk_loop.itervar = SvREFCNT_inc(sv); + RETPUSHYES; +} + +PP(pp_subst) +{ + djSP; dTARG; + register PMOP *pm = cPMOP; + PMOP *rpm = pm; + register SV *dstr; + register char *s; + char *strend; + register char *m; + char *c; + register char *d; + STRLEN clen; + I32 iters = 0; + I32 maxiters; + register I32 i; + bool once; + bool rxtainted; + char *orig; + I32 safebase; + register REGEXP *rx = pm->op_pmregexp; + STRLEN len; + int force_on_match = 0; + I32 oldsave = PL_savestack_ix; + I32 update_minmatch = 1; + SV *screamer; + + /* known replacement string? */ + dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv; + if (PL_op->op_flags & OPf_STACKED) + TARG = POPs; + else { + TARG = DEFSV; + EXTEND(SP,1); + } + if (SvREADONLY(TARG) + || (SvTYPE(TARG) > SVt_PVLV + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))) + croak(no_modify); + PUTBACK; + + s = SvPV(TARG, len); + if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV) + force_on_match = 1; + rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) || + (PL_tainted && (pm->op_pmflags & PMf_RETAINT))); + if (PL_tainted) + rxtainted |= 2; + TAINT_NOT; + + force_it: + if (!pm || !s) + DIE("panic: do_subst"); + + strend = s + len; + maxiters = 2*(strend - s) + 10; /* We can match twice at each + position, once with zero-length, + second time with non-zero. */ + + if (!rx->prelen && PL_curpm) { + pm = PL_curpm; + rx = pm->op_pmregexp; + } + screamer = ( (SvSCREAM(TARG) && rx->check_substr + && SvTYPE(rx->check_substr) == SVt_PVBM + && SvVALID(rx->check_substr)) + ? TARG : Nullsv); + safebase = (!rx->nparens && !PL_sawampersand) ? 0 : REXEC_COPY_STR; + if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + SAVEINT(PL_multiline); + PL_multiline = pm->op_pmflags & PMf_MULTILINE; + } + orig = m = s; + if (rx->check_substr) { + if (!(rx->reganch & ROPT_NOSCAN)) { /* It floats. */ + if (screamer) { + I32 p = -1; + + if (PL_screamfirst[BmRARE(rx->check_substr)] < 0) + goto nope; + else if (!(s = screaminstr(TARG, rx->check_substr, rx->check_offset_min, 0, &p, 0))) + goto nope; + } + else if (!(s = fbm_instr((unsigned char*)s + rx->check_offset_min, + (unsigned char*)strend, + rx->check_substr, 0))) + goto nope; + if (s && rx->check_offset_max < s - m) { + ++BmUSEFUL(rx->check_substr); + s -= rx->check_offset_max; + } + else + s = m; + } + /* Now checkstring is fixed, i.e. at fixed offset from the + beginning of match, and the match is anchored at s. */ + else if (!PL_multiline) { /* Anchored at beginning of string. */ + I32 slen; + if (*SvPVX(rx->check_substr) != s[rx->check_offset_min] + || ((slen = SvCUR(rx->check_substr)) > 1 + && memNE(SvPVX(rx->check_substr), + s + rx->check_offset_min, slen))) + goto nope; + } + if (!rx->naughty && --BmUSEFUL(rx->check_substr) < 0 + && rx->check_substr == rx->float_substr) { + SvREFCNT_dec(rx->check_substr); + rx->check_substr = Nullsv; /* opt is being useless */ + rx->float_substr = Nullsv; + } + } + + /* only replace once? */ + once = !(rpm->op_pmflags & PMf_GLOBAL); + + /* known replacement string? */ + c = dstr ? SvPV(dstr, clen) : Nullch; + + /* can do inplace substitution? */ + if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR)) + && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) { + if (!CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) { + SPAGAIN; + PUSHs(&PL_sv_no); + LEAVE_SCOPE(oldsave); + RETURN; + } + if (force_on_match) { + force_on_match = 0; + s = SvPV_force(TARG, len); + goto force_it; + } + d = s; + PL_curpm = pm; + SvSCREAM_off(TARG); /* disable possible screamer */ + if (once) { + rxtainted |= RX_MATCH_TAINTED(rx); + if (rx->subbase) { + m = orig + (rx->startp[0] - rx->subbase); + d = orig + (rx->endp[0] - rx->subbase); + } else { + m = rx->startp[0]; + d = rx->endp[0]; + } + s = orig; + if (m - s > strend - d) { /* faster to shorten from end */ + if (clen) { + Copy(c, m, clen, char); + m += clen; + } + i = strend - d; + if (i > 0) { + Move(d, m, i, char); + m += i; + } + *m = '\0'; + SvCUR_set(TARG, m - s); + } + /*SUPPRESS 560*/ + else if (i = m - s) { /* faster from front */ + d -= clen; + m = d; + sv_chop(TARG, d-i); + s += i; + while (i--) + *--d = *--s; + if (clen) + Copy(c, m, clen, char); + } + else if (clen) { + d -= clen; + sv_chop(TARG, d); + Copy(c, d, clen, char); + } + else { + sv_chop(TARG, d); + } + TAINT_IF(rxtainted & 1); + SPAGAIN; + PUSHs(&PL_sv_yes); + } + else { + do { + if (iters++ > maxiters) + DIE("Substitution loop"); + rxtainted |= RX_MATCH_TAINTED(rx); + m = rx->startp[0]; + /*SUPPRESS 560*/ + if (i = m - s) { + if (s != d) + Move(s, d, i, char); + d += i; + } + if (clen) { + Copy(c, d, clen, char); + d += clen; + } + s = rx->endp[0]; + } while (CALLREGEXEC(rx, s, strend, orig, s == m, + Nullsv, NULL, 0)); /* don't match same null twice */ + if (s != d) { + i = strend - s; + SvCUR_set(TARG, d - SvPVX(TARG) + i); + Move(s, d, i+1, char); /* include the NUL */ + } + TAINT_IF(rxtainted & 1); + SPAGAIN; + PUSHs(sv_2mortal(newSViv((I32)iters))); + } + (void)SvPOK_only(TARG); + TAINT_IF(rxtainted); + if (SvSMAGICAL(TARG)) { + PUTBACK; + mg_set(TARG); + SPAGAIN; + } + SvTAINT(TARG); + LEAVE_SCOPE(oldsave); + RETURN; + } + + if (CALLREGEXEC(rx, s, strend, orig, 0, screamer, NULL, safebase)) { + if (force_on_match) { + force_on_match = 0; + s = SvPV_force(TARG, len); + goto force_it; + } + rxtainted |= RX_MATCH_TAINTED(rx); + dstr = NEWSV(25, len); + sv_setpvn(dstr, m, s-m); + PL_curpm = pm; + if (!c) { + register PERL_CONTEXT *cx; + SPAGAIN; + PUSHSUBST(cx); + RETURNOP(cPMOP->op_pmreplroot); + } + do { + if (iters++ > maxiters) + DIE("Substitution loop"); + rxtainted |= RX_MATCH_TAINTED(rx); + if (rx->subbase && rx->subbase != orig) { + m = s; + s = orig; + orig = rx->subbase; + s = orig + (m - s); + strend = s + (strend - m); + } + m = rx->startp[0]; + sv_catpvn(dstr, s, m-s); + s = rx->endp[0]; + if (clen) + sv_catpvn(dstr, c, clen); + if (once) + break; + } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, safebase)); + sv_catpvn(dstr, s, strend - s); + + (void)SvOOK_off(TARG); + Safefree(SvPVX(TARG)); + SvPVX(TARG) = SvPVX(dstr); + SvCUR_set(TARG, SvCUR(dstr)); + SvLEN_set(TARG, SvLEN(dstr)); + SvPVX(dstr) = 0; + sv_free(dstr); + + TAINT_IF(rxtainted & 1); + SPAGAIN; + PUSHs(sv_2mortal(newSViv((I32)iters))); + + (void)SvPOK_only(TARG); + TAINT_IF(rxtainted); + SvSETMAGIC(TARG); + SvTAINT(TARG); + LEAVE_SCOPE(oldsave); + RETURN; + } + goto ret_no; + +nope: + ++BmUSEFUL(rx->check_substr); + +ret_no: + SPAGAIN; + PUSHs(&PL_sv_no); + LEAVE_SCOPE(oldsave); + RETURN; +} + +PP(pp_grepwhile) +{ + djSP; + + if (SvTRUEx(POPs)) + PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr]; + ++*PL_markstack_ptr; + LEAVE; /* exit inner scope */ + + /* All done yet? */ + if (PL_stack_base + *PL_markstack_ptr > SP) { + I32 items; + I32 gimme = GIMME_V; + + LEAVE; /* exit outer scope */ + (void)POPMARK; /* pop src */ + items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; + (void)POPMARK; /* pop dst */ + SP = PL_stack_base + POPMARK; /* pop original mark */ + if (gimme == G_SCALAR) { + dTARGET; + XPUSHi(items); + } + else if (gimme == G_ARRAY) + SP += items; + RETURN; + } + else { + SV *src; + + ENTER; /* enter inner scope */ + SAVESPTR(PL_curpm); + + src = PL_stack_base[*PL_markstack_ptr]; + SvTEMP_off(src); + DEFSV = src; + + RETURNOP(cLOGOP->op_other); + } +} + +PP(pp_leavesub) +{ + djSP; + SV **mark; + SV **newsp; + PMOP *newpm; + I32 gimme; + register PERL_CONTEXT *cx; + struct block_sub cxsub; + + POPBLOCK(cx,newpm); + POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ + + TAINT_NOT; + if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (SvTEMP(TOPs)) { + *MARK = SvREFCNT_inc(TOPs); + FREETMPS; + sv_2mortal(*MARK); + } else { + FREETMPS; + *MARK = sv_mortalcopy(TOPs); + } + } else + *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs); + } else { + MEXTEND(MARK, 0); + *MARK = &PL_sv_undef; + } + SP = MARK; + } + else if (gimme == G_ARRAY) { + for (MARK = newsp + 1; MARK <= SP; MARK++) { + if (!SvTEMP(*MARK)) { + *MARK = sv_mortalcopy(*MARK); + TAINT_NOT; /* Each item is independent */ + } + } + } + PUTBACK; + + POPSUB2(); /* Stack values are safe: release CV and @_ ... */ + PL_curpm = newpm; /* ... and pop $1 et al */ + + LEAVE; + return pop_return(); +} + +STATIC CV * +get_db_sub(SV **svp, CV *cv) +{ + dTHR; + SV *dbsv = GvSV(PL_DBsub); + + if (!PERLDB_SUB_NN) { + GV *gv = CvGV(cv); + + save_item(dbsv); + if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) + || strEQ(GvNAME(gv), "END") + || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ + !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) + && (gv = (GV*)*svp) ))) { + /* Use GV from the stack as a fallback. */ + /* GV is potentially non-unique, or contain different CV. */ + sv_setsv(dbsv, newRV((SV*)cv)); + } + else { + gv_efullname3(dbsv, gv, Nullch); + } + } + else { + SvUPGRADE(dbsv, SVt_PVIV); + SvIOK_on(dbsv); + SAVEIV(SvIVX(dbsv)); + SvIVX(dbsv) = (IV)cv; /* Do it the quickest way */ + } + + if (CvXSUB(cv)) + PL_curcopdb = PL_curcop; + cv = GvCV(PL_DBsub); + return cv; +} + +PP(pp_entersub) +{ + djSP; dPOPss; + GV *gv; + HV *stash; + register CV *cv; + register PERL_CONTEXT *cx; + I32 gimme; + bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0; + + if (!sv) + DIE("Not a CODE reference"); + switch (SvTYPE(sv)) { + default: + if (!SvROK(sv)) { + char *sym; + + if (sv == &PL_sv_yes) { /* unfound import, ignore */ + if (hasargs) + SP = PL_stack_base + POPMARK; + RETURN; + } + if (SvGMAGICAL(sv)) { + mg_get(sv); + sym = SvPOKp(sv) ? SvPVX(sv) : Nullch; + } + else + sym = SvPV(sv, PL_na); + if (!sym) + DIE(no_usym, "a subroutine"); + if (PL_op->op_private & HINT_STRICT_REFS) + DIE(no_symref, sym, "a subroutine"); + cv = perl_get_cv(sym, TRUE); + break; + } + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) == SVt_PVCV) + break; + /* FALL THROUGH */ + case SVt_PVHV: + case SVt_PVAV: + DIE("Not a CODE reference"); + case SVt_PVCV: + cv = (CV*)sv; + break; + case SVt_PVGV: + if (!(cv = GvCVu((GV*)sv))) + cv = sv_2cv(sv, &stash, &gv, TRUE); + break; + } + + ENTER; + SAVETMPS; + + retry: + if (!cv) + DIE("Not a CODE reference"); + + if (!CvROOT(cv) && !CvXSUB(cv)) { + GV* autogv; + SV* sub_name; + + /* anonymous or undef'd function leaves us no recourse */ + if (CvANON(cv) || !(gv = CvGV(cv))) + DIE("Undefined subroutine called"); + /* autoloaded stub? */ + if (cv != GvCV(gv)) { + cv = GvCV(gv); + goto retry; + } + /* should call AUTOLOAD now? */ + if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + FALSE))) + { + cv = GvCV(autogv); + goto retry; + } + /* sorry */ + sub_name = sv_newmortal(); + gv_efullname3(sub_name, gv, Nullch); + DIE("Undefined subroutine &%s called", SvPVX(sub_name)); + } + + gimme = GIMME_V; + if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) + cv = get_db_sub(&sv, cv); + if (!cv) + DIE("No DBsub routine"); + +#ifdef USE_THREADS + /* + * First we need to check if the sub or method requires locking. + * If so, we gain a lock on the CV, the first argument or the + * stash (for static methods), as appropriate. This has to be + * inline because for FAKE_THREADS, COND_WAIT inlines code to + * reschedule by returning a new op. + */ + MUTEX_LOCK(CvMUTEXP(cv)); + if (CvFLAGS(cv) & CVf_LOCKED) { + MAGIC *mg; + if (CvFLAGS(cv) & CVf_METHOD) { + if (SP > PL_stack_base + TOPMARK) + sv = *(PL_stack_base + TOPMARK + 1); + else { + MUTEX_UNLOCK(CvMUTEXP(cv)); + croak("no argument for locked method call"); + } + if (SvROK(sv)) + sv = SvRV(sv); + else { + STRLEN len; + char *stashname = SvPV(sv, len); + sv = (SV*)gv_stashpvn(stashname, len, TRUE); + } + } + else { + sv = (SV*)cv; + } + MUTEX_UNLOCK(CvMUTEXP(cv)); + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", + thr, sv);) + MUTEX_UNLOCK(MgMUTEXP(mg)); + SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */ + save_destructor(unlock_condpair, sv); + } + MUTEX_LOCK(CvMUTEXP(cv)); + } + /* + * Now we have permission to enter the sub, we must distinguish + * four cases. (0) It's an XSUB (in which case we don't care + * about ownership); (1) it's ours already (and we're recursing); + * (2) it's free (but we may already be using a cached clone); + * (3) another thread owns it. Case (1) is easy: we just use it. + * Case (2) means we look for a clone--if we have one, use it + * otherwise grab ownership of cv. Case (3) means we look for a + * clone (for non-XSUBs) and have to create one if we don't + * already have one. + * Why look for a clone in case (2) when we could just grab + * ownership of cv straight away? Well, we could be recursing, + * i.e. we originally tried to enter cv while another thread + * owned it (hence we used a clone) but it has been freed up + * and we're now recursing into it. It may or may not be "better" + * to use the clone but at least CvDEPTH can be trusted. + */ + if (CvOWNER(cv) == thr || CvXSUB(cv)) + MUTEX_UNLOCK(CvMUTEXP(cv)); + else { + /* Case (2) or (3) */ + SV **svp; + + /* + * XXX Might it be better to release CvMUTEXP(cv) while we + * do the hv_fetch? We might find someone has pinched it + * when we look again, in which case we would be in case + * (3) instead of (2) so we'd have to clone. Would the fact + * that we released the mutex more quickly make up for this? + */ + if (PL_threadnum && + (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE))) + { + /* We already have a clone to use */ + MUTEX_UNLOCK(CvMUTEXP(cv)); + cv = *(CV**)svp; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "entersub: %p already has clone %p:%s\n", + thr, cv, SvPEEK((SV*)cv))); + CvOWNER(cv) = thr; + SvREFCNT_inc(cv); + if (CvDEPTH(cv) == 0) + SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + } + else { + /* (2) => grab ownership of cv. (3) => make clone */ + if (!CvOWNER(cv)) { + CvOWNER(cv) = thr; + SvREFCNT_inc(cv); + MUTEX_UNLOCK(CvMUTEXP(cv)); + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "entersub: %p grabbing %p:%s in stash %s\n", + thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? + HvNAME(CvSTASH(cv)) : "(none)")); + } else { + /* Make a new clone. */ + CV *clonecv; + SvREFCNT_inc(cv); /* don't let it vanish from under us */ + MUTEX_UNLOCK(CvMUTEXP(cv)); + DEBUG_S((PerlIO_printf(PerlIO_stderr(), + "entersub: %p cloning %p:%s\n", + thr, cv, SvPEEK((SV*)cv)))); + /* + * We're creating a new clone so there's no race + * between the original MUTEX_UNLOCK and the + * SvREFCNT_inc since no one will be trying to undef + * it out from underneath us. At least, I don't think + * there's a race... + */ + clonecv = cv_clone(cv); + SvREFCNT_dec(cv); /* finished with this */ + hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0); + CvOWNER(clonecv) = thr; + cv = clonecv; + SvREFCNT_inc(cv); + } + DEBUG_S(if (CvDEPTH(cv) != 0) + PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", + CvDEPTH(cv));); + SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + } + } +#endif /* USE_THREADS */ + + if (CvXSUB(cv)) { + if (CvOLDSTYLE(cv)) { + I32 (*fp3)_((int,int,int)); + dMARK; + register I32 items = SP - MARK; + /* We dont worry to copy from @_. */ + while (SP > mark) { + SP[1] = SP[0]; + SP--; + } + PL_stack_sp = mark + 1; + fp3 = (I32(*)_((int,int,int)))CvXSUB(cv); + items = (*fp3)(CvXSUBANY(cv).any_i32, + MARK - PL_stack_base + 1, + items); + PL_stack_sp = PL_stack_base + items; + } + else { + I32 markix = TOPMARK; + + PUTBACK; + + if (!hasargs) { + /* Need to copy @_ to stack. Alternative may be to + * switch stack to @_, and copy return values + * back. This would allow popping @_ in XSUB, e.g.. XXXX */ + AV* av; + I32 items; +#ifdef USE_THREADS + av = (AV*)PL_curpad[0]; +#else + av = GvAV(PL_defgv); +#endif /* USE_THREADS */ + items = AvFILLp(av) + 1; /* @_ is not tieable */ + + if (items) { + /* Mark is at the end of the stack. */ + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; + PUTBACK ; + } + } + if (PL_curcopdb) { /* We assume that the first + XSUB in &DB::sub is the + called one. */ + SAVESPTR(PL_curcop); + PL_curcop = PL_curcopdb; + PL_curcopdb = NULL; + } + /* Do we need to open block here? XXXX */ + (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS); + + /* Enforce some sanity in scalar context. */ + if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) { + if (markix > PL_stack_sp - PL_stack_base) + *(PL_stack_base + markix) = &PL_sv_undef; + else + *(PL_stack_base + markix) = *PL_stack_sp; + PL_stack_sp = PL_stack_base + markix; + } + } + LEAVE; + return NORMAL; + } + else { + dMARK; + register I32 items = SP - MARK; + AV* padlist = CvPADLIST(cv); + SV** svp = AvARRAY(padlist); + push_return(PL_op->op_next); + PUSHBLOCK(cx, CXt_SUB, MARK); + PUSHSUB(cx); + CvDEPTH(cv)++; + if (CvDEPTH(cv) < 2) + (void)SvREFCNT_inc(cv); + else { /* save temporaries on recursion? */ + if (CvDEPTH(cv) == 100 && PL_dowarn + && !(PERLDB_SUB && cv == GvCV(PL_DBsub))) + sub_crush_depth(cv); + if (CvDEPTH(cv) > AvFILLp(padlist)) { + AV *av; + AV *newpad = newAV(); + SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); + I32 ix = AvFILLp((AV*)svp[1]); + svp = AvARRAY(svp[0]); + for ( ;ix > 0; ix--) { + if (svp[ix] != &PL_sv_undef) { + char *name = SvPVX(svp[ix]); + if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */ + || *name == '&') /* anonymous code? */ + { + av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); + } + else { /* our own lexical */ + if (*name == '@') + av_store(newpad, ix, sv = (SV*)newAV()); + else if (*name == '%') + av_store(newpad, ix, sv = (SV*)newHV()); + else + av_store(newpad, ix, sv = NEWSV(0,0)); + SvPADMY_on(sv); + } + } + else { + av_store(newpad, ix, sv = NEWSV(0,0)); + SvPADTMP_on(sv); + } + } + av = newAV(); /* will be @_ */ + av_extend(av, 0); + av_store(newpad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; + av_store(padlist, CvDEPTH(cv), (SV*)newpad); + AvFILLp(padlist) = CvDEPTH(cv); + svp = AvARRAY(padlist); + } + } +#ifdef USE_THREADS + if (!hasargs) { + AV* av = (AV*)PL_curpad[0]; + + items = AvFILLp(av) + 1; + if (items) { + /* Mark is at the end of the stack. */ + EXTEND(SP, items); + Copy(AvARRAY(av), SP + 1, items, SV*); + SP += items; + PUTBACK ; + } + } +#endif /* USE_THREADS */ + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); +#ifndef USE_THREADS + if (hasargs) +#endif /* USE_THREADS */ + { + AV* av; + SV** ary; + +#if 0 + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p entersub preparing @_\n", thr)); +#endif + av = (AV*)PL_curpad[0]; + if (AvREAL(av)) { + av_clear(av); + AvREAL_off(av); + } +#ifndef USE_THREADS + cx->blk_sub.savearray = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); +#endif /* USE_THREADS */ + cx->blk_sub.argarray = av; + ++MARK; + + if (items > AvMAX(av) + 1) { + ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (items > AvMAX(av) + 1) { + AvMAX(av) = items - 1; + Renew(ary,items,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + } + } + Copy(MARK,AvARRAY(av),items,SV*); + AvFILLp(av) = items - 1; + + while (items--) { + if (*MARK) + SvTEMP_off(*MARK); + MARK++; + } + } +#if 0 + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "%p entersub returning %p\n", thr, CvSTART(cv))); +#endif + RETURNOP(CvSTART(cv)); + } +} + +void +sub_crush_depth(CV *cv) +{ + if (CvANON(cv)) + warn("Deep recursion on anonymous subroutine"); + else { + SV* tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, CvGV(cv), Nullch); + warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr)); + } +} + +PP(pp_aelem) +{ + djSP; + SV** svp; + I32 elem = POPi; + AV* av = (AV*)POPs; + U32 lval = PL_op->op_flags & OPf_MOD; + U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av)); + SV *sv; + + if (elem > 0) + elem -= PL_curcop->cop_arybase; + if (SvTYPE(av) != SVt_PVAV) + RETPUSHUNDEF; + svp = av_fetch(av, elem, lval && !defer); + if (lval) { + if (!svp || *svp == &PL_sv_undef) { + SV* lv; + if (!defer) + DIE(no_aelem, elem); + lv = sv_newmortal(); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, Nullsv, 'y', Nullch, 0); + LvTARG(lv) = SvREFCNT_inc(av); + LvTARGOFF(lv) = elem; + LvTARGLEN(lv) = 1; + PUSHs(lv); + RETURN; + } + if (PL_op->op_private & OPpLVAL_INTRO) + save_aelem(av, elem, svp); + else if (PL_op->op_private & OPpDEREF) + vivify_ref(*svp, PL_op->op_private & OPpDEREF); + } + sv = (svp ? *svp : &PL_sv_undef); + if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */ + sv = sv_mortalcopy(sv); + PUSHs(sv); + RETURN; +} + +void +vivify_ref(SV *sv, U32 to_what) +{ + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvOK(sv)) { + if (SvREADONLY(sv)) + croak(no_modify); + if (SvTYPE(sv) < SVt_RV) + sv_upgrade(sv, SVt_RV); + else if (SvTYPE(sv) >= SVt_PV) { + (void)SvOOK_off(sv); + Safefree(SvPVX(sv)); + SvLEN(sv) = SvCUR(sv) = 0; + } + switch (to_what) { + case OPpDEREF_SV: + SvRV(sv) = NEWSV(355,0); + break; + case OPpDEREF_AV: + SvRV(sv) = (SV*)newAV(); + break; + case OPpDEREF_HV: + SvRV(sv) = (SV*)newHV(); + break; + } + SvROK_on(sv); + SvSETMAGIC(sv); + } +} + +PP(pp_method) +{ + djSP; + SV* sv; + SV* ob; + GV* gv; + HV* stash; + char* name; + char* packname; + STRLEN packlen; + + if (SvROK(TOPs)) { + sv = SvRV(TOPs); + if (SvTYPE(sv) == SVt_PVCV) { + SETs(sv); + RETURN; + } + } + + name = SvPV(TOPs, PL_na); + sv = *(PL_stack_base + TOPMARK + 1); + + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvROK(sv)) + ob = (SV*)SvRV(sv); + else { + GV* iogv; + + packname = Nullch; + if (!SvOK(sv) || + !(packname = SvPV(sv, packlen)) || + !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) || + !(ob=(SV*)GvIO(iogv))) + { + if (!packname || !isIDFIRST(*packname)) + DIE("Can't call method \"%s\" %s", name, + SvOK(sv)? "without a package or object reference" + : "on an undefined value"); + stash = gv_stashpvn(packname, packlen, TRUE); + goto fetch; + } + *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv)); + } + + if (!ob || !SvOBJECT(ob)) + DIE("Can't call method \"%s\" on unblessed reference", name); + + stash = SvSTASH(ob); + + fetch: + gv = gv_fetchmethod(stash, name); + if (!gv) { + char* leaf = name; + char* sep = Nullch; + char* p; + + for (p = name; *p; p++) { + if (*p == '\'') + sep = p, leaf = p + 1; + else if (*p == ':' && *(p + 1) == ':') + sep = p, leaf = p + 2; + } + if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) { + packname = HvNAME(sep ? PL_curcop->cop_stash : stash); + packlen = strlen(packname); + } + else { + packname = name; + packlen = sep - name; + } + DIE("Can't locate object method \"%s\" via package \"%.*s\"", + leaf, (int)packlen, packname); + } + SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv); + RETURN; +} + diff --git a/contrib/perl5/pp_proto.h b/contrib/perl5/pp_proto.h new file mode 100644 index 00000000000..ad82696849b --- /dev/null +++ b/contrib/perl5/pp_proto.h @@ -0,0 +1,344 @@ +PPDEF(pp_null) +PPDEF(pp_stub) +PPDEF(pp_scalar) +PPDEF(pp_pushmark) +PPDEF(pp_wantarray) +PPDEF(pp_const) +PPDEF(pp_gvsv) +PPDEF(pp_gv) +PPDEF(pp_gelem) +PPDEF(pp_padsv) +PPDEF(pp_padav) +PPDEF(pp_padhv) +PPDEF(pp_padany) +PPDEF(pp_pushre) +PPDEF(pp_rv2gv) +PPDEF(pp_rv2sv) +PPDEF(pp_av2arylen) +PPDEF(pp_rv2cv) +PPDEF(pp_anoncode) +PPDEF(pp_prototype) +PPDEF(pp_refgen) +PPDEF(pp_srefgen) +PPDEF(pp_ref) +PPDEF(pp_bless) +PPDEF(pp_backtick) +PPDEF(pp_glob) +PPDEF(pp_readline) +PPDEF(pp_rcatline) +PPDEF(pp_regcmaybe) +PPDEF(pp_regcreset) +PPDEF(pp_regcomp) +PPDEF(pp_match) +PPDEF(pp_qr) +PPDEF(pp_subst) +PPDEF(pp_substcont) +PPDEF(pp_trans) +PPDEF(pp_sassign) +PPDEF(pp_aassign) +PPDEF(pp_chop) +PPDEF(pp_schop) +PPDEF(pp_chomp) +PPDEF(pp_schomp) +PPDEF(pp_defined) +PPDEF(pp_undef) +PPDEF(pp_study) +PPDEF(pp_pos) +PPDEF(pp_preinc) +PPDEF(pp_predec) +PPDEF(pp_postinc) +PPDEF(pp_postdec) +PPDEF(pp_pow) +PPDEF(pp_multiply) +PPDEF(pp_i_multiply) +PPDEF(pp_divide) +PPDEF(pp_i_divide) +PPDEF(pp_modulo) +PPDEF(pp_i_modulo) +PPDEF(pp_repeat) +PPDEF(pp_add) +PPDEF(pp_i_add) +PPDEF(pp_subtract) +PPDEF(pp_i_subtract) +PPDEF(pp_concat) +PPDEF(pp_stringify) +PPDEF(pp_left_shift) +PPDEF(pp_right_shift) +PPDEF(pp_lt) +PPDEF(pp_i_lt) +PPDEF(pp_gt) +PPDEF(pp_i_gt) +PPDEF(pp_le) +PPDEF(pp_i_le) +PPDEF(pp_ge) +PPDEF(pp_i_ge) +PPDEF(pp_eq) +PPDEF(pp_i_eq) +PPDEF(pp_ne) +PPDEF(pp_i_ne) +PPDEF(pp_ncmp) +PPDEF(pp_i_ncmp) +PPDEF(pp_slt) +PPDEF(pp_sgt) +PPDEF(pp_sle) +PPDEF(pp_sge) +PPDEF(pp_seq) +PPDEF(pp_sne) +PPDEF(pp_scmp) +PPDEF(pp_bit_and) +PPDEF(pp_bit_xor) +PPDEF(pp_bit_or) +PPDEF(pp_negate) +PPDEF(pp_i_negate) +PPDEF(pp_not) +PPDEF(pp_complement) +PPDEF(pp_atan2) +PPDEF(pp_sin) +PPDEF(pp_cos) +PPDEF(pp_rand) +PPDEF(pp_srand) +PPDEF(pp_exp) +PPDEF(pp_log) +PPDEF(pp_sqrt) +PPDEF(pp_int) +PPDEF(pp_hex) +PPDEF(pp_oct) +PPDEF(pp_abs) +PPDEF(pp_length) +PPDEF(pp_substr) +PPDEF(pp_vec) +PPDEF(pp_index) +PPDEF(pp_rindex) +PPDEF(pp_sprintf) +PPDEF(pp_formline) +PPDEF(pp_ord) +PPDEF(pp_chr) +PPDEF(pp_crypt) +PPDEF(pp_ucfirst) +PPDEF(pp_lcfirst) +PPDEF(pp_uc) +PPDEF(pp_lc) +PPDEF(pp_quotemeta) +PPDEF(pp_rv2av) +PPDEF(pp_aelemfast) +PPDEF(pp_aelem) +PPDEF(pp_aslice) +PPDEF(pp_each) +PPDEF(pp_values) +PPDEF(pp_keys) +PPDEF(pp_delete) +PPDEF(pp_exists) +PPDEF(pp_rv2hv) +PPDEF(pp_helem) +PPDEF(pp_hslice) +PPDEF(pp_unpack) +PPDEF(pp_pack) +PPDEF(pp_split) +PPDEF(pp_join) +PPDEF(pp_list) +PPDEF(pp_lslice) +PPDEF(pp_anonlist) +PPDEF(pp_anonhash) +PPDEF(pp_splice) +PPDEF(pp_push) +PPDEF(pp_pop) +PPDEF(pp_shift) +PPDEF(pp_unshift) +PPDEF(pp_sort) +PPDEF(pp_reverse) +PPDEF(pp_grepstart) +PPDEF(pp_grepwhile) +PPDEF(pp_mapstart) +PPDEF(pp_mapwhile) +PPDEF(pp_range) +PPDEF(pp_flip) +PPDEF(pp_flop) +PPDEF(pp_and) +PPDEF(pp_or) +PPDEF(pp_xor) +PPDEF(pp_cond_expr) +PPDEF(pp_andassign) +PPDEF(pp_orassign) +PPDEF(pp_method) +PPDEF(pp_entersub) +PPDEF(pp_leavesub) +PPDEF(pp_caller) +PPDEF(pp_warn) +PPDEF(pp_die) +PPDEF(pp_reset) +PPDEF(pp_lineseq) +PPDEF(pp_nextstate) +PPDEF(pp_dbstate) +PPDEF(pp_unstack) +PPDEF(pp_enter) +PPDEF(pp_leave) +PPDEF(pp_scope) +PPDEF(pp_enteriter) +PPDEF(pp_iter) +PPDEF(pp_enterloop) +PPDEF(pp_leaveloop) +PPDEF(pp_return) +PPDEF(pp_last) +PPDEF(pp_next) +PPDEF(pp_redo) +PPDEF(pp_dump) +PPDEF(pp_goto) +PPDEF(pp_exit) +PPDEF(pp_open) +PPDEF(pp_close) +PPDEF(pp_pipe_op) +PPDEF(pp_fileno) +PPDEF(pp_umask) +PPDEF(pp_binmode) +PPDEF(pp_tie) +PPDEF(pp_untie) +PPDEF(pp_tied) +PPDEF(pp_dbmopen) +PPDEF(pp_dbmclose) +PPDEF(pp_sselect) +PPDEF(pp_select) +PPDEF(pp_getc) +PPDEF(pp_read) +PPDEF(pp_enterwrite) +PPDEF(pp_leavewrite) +PPDEF(pp_prtf) +PPDEF(pp_print) +PPDEF(pp_sysopen) +PPDEF(pp_sysseek) +PPDEF(pp_sysread) +PPDEF(pp_syswrite) +PPDEF(pp_send) +PPDEF(pp_recv) +PPDEF(pp_eof) +PPDEF(pp_tell) +PPDEF(pp_seek) +PPDEF(pp_truncate) +PPDEF(pp_fcntl) +PPDEF(pp_ioctl) +PPDEF(pp_flock) +PPDEF(pp_socket) +PPDEF(pp_sockpair) +PPDEF(pp_bind) +PPDEF(pp_connect) +PPDEF(pp_listen) +PPDEF(pp_accept) +PPDEF(pp_shutdown) +PPDEF(pp_gsockopt) +PPDEF(pp_ssockopt) +PPDEF(pp_getsockname) +PPDEF(pp_getpeername) +PPDEF(pp_lstat) +PPDEF(pp_stat) +PPDEF(pp_ftrread) +PPDEF(pp_ftrwrite) +PPDEF(pp_ftrexec) +PPDEF(pp_fteread) +PPDEF(pp_ftewrite) +PPDEF(pp_fteexec) +PPDEF(pp_ftis) +PPDEF(pp_fteowned) +PPDEF(pp_ftrowned) +PPDEF(pp_ftzero) +PPDEF(pp_ftsize) +PPDEF(pp_ftmtime) +PPDEF(pp_ftatime) +PPDEF(pp_ftctime) +PPDEF(pp_ftsock) +PPDEF(pp_ftchr) +PPDEF(pp_ftblk) +PPDEF(pp_ftfile) +PPDEF(pp_ftdir) +PPDEF(pp_ftpipe) +PPDEF(pp_ftlink) +PPDEF(pp_ftsuid) +PPDEF(pp_ftsgid) +PPDEF(pp_ftsvtx) +PPDEF(pp_fttty) +PPDEF(pp_fttext) +PPDEF(pp_ftbinary) +PPDEF(pp_chdir) +PPDEF(pp_chown) +PPDEF(pp_chroot) +PPDEF(pp_unlink) +PPDEF(pp_chmod) +PPDEF(pp_utime) +PPDEF(pp_rename) +PPDEF(pp_link) +PPDEF(pp_symlink) +PPDEF(pp_readlink) +PPDEF(pp_mkdir) +PPDEF(pp_rmdir) +PPDEF(pp_open_dir) +PPDEF(pp_readdir) +PPDEF(pp_telldir) +PPDEF(pp_seekdir) +PPDEF(pp_rewinddir) +PPDEF(pp_closedir) +PPDEF(pp_fork) +PPDEF(pp_wait) +PPDEF(pp_waitpid) +PPDEF(pp_system) +PPDEF(pp_exec) +PPDEF(pp_kill) +PPDEF(pp_getppid) +PPDEF(pp_getpgrp) +PPDEF(pp_setpgrp) +PPDEF(pp_getpriority) +PPDEF(pp_setpriority) +PPDEF(pp_time) +PPDEF(pp_tms) +PPDEF(pp_localtime) +PPDEF(pp_gmtime) +PPDEF(pp_alarm) +PPDEF(pp_sleep) +PPDEF(pp_shmget) +PPDEF(pp_shmctl) +PPDEF(pp_shmread) +PPDEF(pp_shmwrite) +PPDEF(pp_msgget) +PPDEF(pp_msgctl) +PPDEF(pp_msgsnd) +PPDEF(pp_msgrcv) +PPDEF(pp_semget) +PPDEF(pp_semctl) +PPDEF(pp_semop) +PPDEF(pp_require) +PPDEF(pp_dofile) +PPDEF(pp_entereval) +PPDEF(pp_leaveeval) +PPDEF(pp_entertry) +PPDEF(pp_leavetry) +PPDEF(pp_ghbyname) +PPDEF(pp_ghbyaddr) +PPDEF(pp_ghostent) +PPDEF(pp_gnbyname) +PPDEF(pp_gnbyaddr) +PPDEF(pp_gnetent) +PPDEF(pp_gpbyname) +PPDEF(pp_gpbynumber) +PPDEF(pp_gprotoent) +PPDEF(pp_gsbyname) +PPDEF(pp_gsbyport) +PPDEF(pp_gservent) +PPDEF(pp_shostent) +PPDEF(pp_snetent) +PPDEF(pp_sprotoent) +PPDEF(pp_sservent) +PPDEF(pp_ehostent) +PPDEF(pp_enetent) +PPDEF(pp_eprotoent) +PPDEF(pp_eservent) +PPDEF(pp_gpwnam) +PPDEF(pp_gpwuid) +PPDEF(pp_gpwent) +PPDEF(pp_spwent) +PPDEF(pp_epwent) +PPDEF(pp_ggrnam) +PPDEF(pp_ggrgid) +PPDEF(pp_ggrent) +PPDEF(pp_sgrent) +PPDEF(pp_egrent) +PPDEF(pp_getlogin) +PPDEF(pp_syscall) +PPDEF(pp_lock) +PPDEF(pp_threadsv) diff --git a/contrib/perl5/pp_sys.c b/contrib/perl5/pp_sys.c new file mode 100644 index 00000000000..2630e050b88 --- /dev/null +++ b/contrib/perl5/pp_sys.c @@ -0,0 +1,4595 @@ +/* pp_sys.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * But only a short way ahead its floor and the walls on either side were + * cloven by a great fissure, out of which the red glare came, now leaping + * up, now dying down into darkness; and all the while far below there was + * a rumour and a trouble as of great engines throbbing and labouring. + */ + +#include "EXTERN.h" +#include "perl.h" + +/* XXX If this causes problems, set i_unistd=undef in the hint file. */ +#ifdef I_UNISTD +# include +#endif + +#ifdef HAS_SYSCALL +#ifdef __cplusplus +extern "C" int syscall(unsigned long,...); +#endif +#endif + +#ifdef I_SYS_WAIT +# include +#endif + +#ifdef I_SYS_RESOURCE +# include +#endif + +#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */ +# include +# ifdef I_NETDB +# include +# endif +# ifndef ENOTSOCK +# ifdef I_NET_ERRNO +# include +# endif +# endif +#endif + +#ifdef HAS_SELECT +#ifdef I_SYS_SELECT +#include +#endif +#endif + +/* XXX Configure test needed. + h_errno might not be a simple 'int', especially for multi-threaded + applications. HOST_NOT_FOUND is typically defined in . +*/ +#if defined(HOST_NOT_FOUND) && !defined(h_errno) +extern int h_errno; +#endif + +#ifdef HAS_PASSWD +# ifdef I_PWD +# include +# else + struct passwd *getpwnam _((char *)); + struct passwd *getpwuid _((Uid_t)); +# endif +# ifdef HAS_GETPWENT + struct passwd *getpwent _((void)); +# endif +#endif + +#ifdef HAS_GROUP +# ifdef I_GRP +# include +# else + struct group *getgrnam _((char *)); + struct group *getgrgid _((Gid_t)); +# endif +# ifdef HAS_GETGRENT + struct group *getgrent _((void)); +# endif +#endif + +#ifdef I_UTIME +# if defined(_MSC_VER) || defined(__MINGW32__) +# include +# else +# include +# endif +#endif +#ifdef I_FCNTL +#include +#endif +#ifdef I_SYS_FILE +#include +#endif + +/* Put this after #includes because fork and vfork prototypes may conflict. */ +#ifndef HAS_VFORK +# define vfork fork +#endif + +/* Put this after #includes because defines _XOPEN_*. */ +#ifndef Sock_size_t +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) +# define Sock_size_t Size_t +# else +# define Sock_size_t int +# endif +#endif + +#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +static int dooneliner _((char *cmd, char *filename)); +#endif + +#ifdef HAS_CHSIZE +# ifdef my_chsize /* Probably #defined to Perl_my_chsize in embed.h */ +# undef my_chsize +# endif +# define my_chsize PerlLIO_chsize +#endif + +#ifdef HAS_FLOCK +# define FLOCK flock +#else /* no flock() */ + + /* fcntl.h might not have been included, even if it exists, because + the current Configure only sets I_FCNTL if it's needed to pick up + the *_OK constants. Make sure it has been included before testing + the fcntl() locking constants. */ +# if defined(HAS_FCNTL) && !defined(I_FCNTL) +# include +# endif + +# if defined(HAS_FCNTL) && defined(F_SETLK) && defined (F_SETLKW) +# define FLOCK fcntl_emulate_flock +# define FCNTL_EMULATE_FLOCK +# else /* no flock() or fcntl(F_SETLK,...) */ +# ifdef HAS_LOCKF +# define FLOCK lockf_emulate_flock +# define LOCKF_EMULATE_FLOCK +# endif /* lockf */ +# endif /* no flock() or fcntl(F_SETLK,...) */ + +# ifdef FLOCK + static int FLOCK _((int, int)); + + /* + * These are the flock() constants. Since this sytems doesn't have + * flock(), the values of the constants are probably not available. + */ +# ifndef LOCK_SH +# define LOCK_SH 1 +# endif +# ifndef LOCK_EX +# define LOCK_EX 2 +# endif +# ifndef LOCK_NB +# define LOCK_NB 4 +# endif +# ifndef LOCK_UN +# define LOCK_UN 8 +# endif +# endif /* emulating flock() */ + +#endif /* no flock() */ + +#ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN 1024 +# endif +#endif + +#define ZBTLEN 10 +static char zero_but_true[ZBTLEN + 1] = "0 but true"; + +/* Pushy I/O. */ + +PP(pp_backtick) +{ + djSP; dTARGET; + PerlIO *fp; + char *tmps = POPp; + I32 gimme = GIMME_V; + + TAINT_PROPER("``"); + fp = PerlProc_popen(tmps, "r"); + if (fp) { + if (gimme == G_VOID) { + char tmpbuf[256]; + while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0) + /*SUPPRESS 530*/ + ; + } + else if (gimme == G_SCALAR) { + sv_setpv(TARG, ""); /* note that this preserves previous buffer */ + while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch) + /*SUPPRESS 530*/ + ; + XPUSHs(TARG); + SvTAINTED_on(TARG); + } + else { + SV *sv; + + for (;;) { + sv = NEWSV(56, 79); + if (sv_gets(sv, fp, 0) == Nullch) { + SvREFCNT_dec(sv); + break; + } + XPUSHs(sv_2mortal(sv)); + if (SvLEN(sv) - SvCUR(sv) > 20) { + SvLEN_set(sv, SvCUR(sv)+1); + Renew(SvPVX(sv), SvLEN(sv), char); + } + SvTAINTED_on(sv); + } + } + STATUS_NATIVE_SET(PerlProc_pclose(fp)); + TAINT; /* "I believe that this is not gratuitous!" */ + } + else { + STATUS_NATIVE_SET(-1); + if (gimme == G_SCALAR) + RETPUSHUNDEF; + } + + RETURN; +} + +PP(pp_glob) +{ + OP *result; + ENTER; + +#ifndef VMS + if (PL_tainting) { + /* + * The external globbing program may use things we can't control, + * so for security reasons we must assume the worst. + */ + TAINT; + taint_proper(no_security, "glob"); + } +#endif /* !VMS */ + + SAVESPTR(PL_last_in_gv); /* We don't want this to be permanent. */ + PL_last_in_gv = (GV*)*PL_stack_sp--; + + SAVESPTR(PL_rs); /* This is not permanent, either. */ + PL_rs = sv_2mortal(newSVpv("", 1)); +#ifndef DOSISH +#ifndef CSH + *SvPVX(PL_rs) = '\n'; +#endif /* !CSH */ +#endif /* !DOSISH */ + + result = do_readline(); + LEAVE; + return result; +} + +#if 0 /* XXX never used! */ +PP(pp_indread) +{ + PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO); + return do_readline(); +} +#endif + +PP(pp_rcatline) +{ + PL_last_in_gv = cGVOP->op_gv; + return do_readline(); +} + +PP(pp_warn) +{ + djSP; dMARK; + char *tmps; + if (SP - MARK != 1) { + dTARGET; + do_join(TARG, &PL_sv_no, MARK, SP); + tmps = SvPV(TARG, PL_na); + SP = MARK + 1; + } + else { + tmps = SvPV(TOPs, PL_na); + } + if (!tmps || !*tmps) { + SV *error = ERRSV; + (void)SvUPGRADE(error, SVt_PV); + if (SvPOK(error) && SvCUR(error)) + sv_catpv(error, "\t...caught"); + tmps = SvPV(error, PL_na); + } + if (!tmps || !*tmps) + tmps = "Warning: something's wrong"; + warn("%s", tmps); + RETSETYES; +} + +PP(pp_die) +{ + djSP; dMARK; + char *tmps; + SV *tmpsv = Nullsv; + char *pat = "%s"; + if (SP - MARK != 1) { + dTARGET; + do_join(TARG, &PL_sv_no, MARK, SP); + tmps = SvPV(TARG, PL_na); + SP = MARK + 1; + } + else { + tmpsv = TOPs; + tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, PL_na); + } + if (!tmps || !*tmps) { + SV *error = ERRSV; + (void)SvUPGRADE(error, SVt_PV); + if(tmpsv ? SvROK(tmpsv) : SvROK(error)) { + if(tmpsv) + SvSetSV(error,tmpsv); + else if(sv_isobject(error)) { + HV *stash = SvSTASH(SvRV(error)); + GV *gv = gv_fetchmethod(stash, "PROPAGATE"); + if (gv) { + SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv))); + SV *line = sv_2mortal(newSViv(PL_curcop->cop_line)); + EXTEND(SP, 3); + PUSHMARK(SP); + PUSHs(error); + PUSHs(file); + PUSHs(line); + PUTBACK; + perl_call_sv((SV*)GvCV(gv), + G_SCALAR|G_EVAL|G_KEEPERR); + sv_setsv(error,*PL_stack_sp--); + } + } + pat = Nullch; + } + else { + if (SvPOK(error) && SvCUR(error)) + sv_catpv(error, "\t...propagated"); + tmps = SvPV(error, PL_na); + } + } + if (!tmps || !*tmps) + tmps = "Died"; + DIE(pat, tmps); +} + +/* I/O. */ + +PP(pp_open) +{ + djSP; dTARGET; + GV *gv; + SV *sv; + char *tmps; + STRLEN len; + + if (MAXARG > 1) + sv = POPs; + if (!isGV(TOPs)) + DIE(no_usym, "filehandle"); + if (MAXARG <= 1) + sv = GvSV(TOPs); + gv = (GV*)POPs; + if (!isGV(gv)) + DIE(no_usym, "filehandle"); + if (GvIOp(gv)) + IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; + tmps = SvPV(sv, len); + if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp)) + PUSHi( (I32)PL_forkprocess ); + else if (PL_forkprocess == 0) /* we are a new child */ + PUSHi(0); + else + RETPUSHUNDEF; + RETURN; +} + +PP(pp_close) +{ + djSP; + GV *gv; + MAGIC *mg; + + if (MAXARG == 0) + gv = PL_defoutgv; + else + gv = (GV*)POPs; + + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + perl_call_method("CLOSE", G_SCALAR); + LEAVE; + SPAGAIN; + RETURN; + } + EXTEND(SP, 1); + PUSHs(boolSV(do_close(gv, TRUE))); + RETURN; +} + +PP(pp_pipe_op) +{ + djSP; +#ifdef HAS_PIPE + GV *rgv; + GV *wgv; + register IO *rstio; + register IO *wstio; + int fd[2]; + + wgv = (GV*)POPs; + rgv = (GV*)POPs; + + if (!rgv || !wgv) + goto badexit; + + if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV) + DIE(no_usym, "filehandle"); + rstio = GvIOn(rgv); + wstio = GvIOn(wgv); + + if (IoIFP(rstio)) + do_close(rgv, FALSE); + if (IoIFP(wstio)) + do_close(wgv, FALSE); + + if (PerlProc_pipe(fd) < 0) + goto badexit; + + IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); + IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoIFP(wstio) = IoOFP(wstio); + IoTYPE(rstio) = '<'; + IoTYPE(wstio) = '>'; + + if (!IoIFP(rstio) || !IoOFP(wstio)) { + if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio)); + else PerlLIO_close(fd[0]); + if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio)); + else PerlLIO_close(fd[1]); + goto badexit; + } + + RETPUSHYES; + +badexit: + RETPUSHUNDEF; +#else + DIE(no_func, "pipe"); +#endif +} + +PP(pp_fileno) +{ + djSP; dTARGET; + GV *gv; + IO *io; + PerlIO *fp; + if (MAXARG < 1) + RETPUSHUNDEF; + gv = (GV*)POPs; + if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) + RETPUSHUNDEF; + PUSHi(PerlIO_fileno(fp)); + RETURN; +} + +PP(pp_umask) +{ + djSP; dTARGET; + int anum; + +#ifdef HAS_UMASK + if (MAXARG < 1) { + anum = PerlLIO_umask(0); + (void)PerlLIO_umask(anum); + } + else + anum = PerlLIO_umask(POPi); + TAINT_PROPER("umask"); + XPUSHi(anum); +#else + /* Only DIE if trying to restrict permissions on `user' (self). + * Otherwise it's harmless and more useful to just return undef + * since 'group' and 'other' concepts probably don't exist here. */ + if (MAXARG >= 1 && (POPi & 0700)) + DIE("umask not implemented"); + XPUSHs(&PL_sv_undef); +#endif + RETURN; +} + +PP(pp_binmode) +{ + djSP; + GV *gv; + IO *io; + PerlIO *fp; + + if (MAXARG < 1) + RETPUSHUNDEF; + + gv = (GV*)POPs; + + EXTEND(SP, 1); + if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) + RETPUSHUNDEF; + + if (do_binmode(fp,IoTYPE(io),TRUE)) + RETPUSHYES; + else + RETPUSHUNDEF; +} + + +PP(pp_tie) +{ + djSP; + dMARK; + SV *varsv; + HV* stash; + GV *gv; + SV *sv; + I32 markoff = MARK - PL_stack_base; + char *methname; + int how = 'P'; + U32 items; + + varsv = *++MARK; + switch(SvTYPE(varsv)) { + case SVt_PVHV: + methname = "TIEHASH"; + break; + case SVt_PVAV: + methname = "TIEARRAY"; + break; + case SVt_PVGV: + methname = "TIEHANDLE"; + how = 'q'; + break; + default: + methname = "TIESCALAR"; + how = 'q'; + break; + } + items = SP - MARK++; + if (sv_isobject(*MARK)) { + ENTER; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,items); + while (items--) + PUSHs(*MARK++); + PUTBACK; + perl_call_method(methname, G_SCALAR); + } + else { + /* Not clear why we don't call perl_call_method here too. + * perhaps to get different error message ? + */ + stash = gv_stashsv(*MARK, FALSE); + if (!stash || !(gv = gv_fetchmethod(stash, methname))) { + DIE("Can't locate object method \"%s\" via package \"%s\"", + methname, SvPV(*MARK,PL_na)); + } + ENTER; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,items); + while (items--) + PUSHs(*MARK++); + PUTBACK; + perl_call_sv((SV*)GvCV(gv), G_SCALAR); + } + SPAGAIN; + + sv = TOPs; + POPSTACK; + if (sv_isobject(sv)) { + sv_unmagic(varsv, how); + sv_magic(varsv, sv, how, Nullch, 0); + } + LEAVE; + SP = PL_stack_base + markoff; + PUSHs(sv); + RETURN; +} + +PP(pp_untie) +{ + djSP; + SV * sv ; + + sv = POPs; + + if (PL_dowarn) { + MAGIC * mg ; + if (SvMAGICAL(sv)) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + mg = mg_find(sv, 'P') ; + else + mg = mg_find(sv, 'q') ; + + if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) + warn("untie attempted while %lu inner references still exist", + (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; + } + } + + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + sv_unmagic(sv, 'P'); + else + sv_unmagic(sv, 'q'); + RETPUSHYES; +} + +PP(pp_tied) +{ + djSP; + SV * sv ; + MAGIC * mg ; + + sv = POPs; + if (SvMAGICAL(sv)) { + if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + mg = mg_find(sv, 'P') ; + else + mg = mg_find(sv, 'q') ; + + if (mg) { + PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; + RETURN ; + } + } + RETPUSHUNDEF; +} + +PP(pp_dbmopen) +{ + djSP; + HV *hv; + dPOPPOPssrl; + HV* stash; + GV *gv; + SV *sv; + + hv = (HV*)POPs; + + sv = sv_mortalcopy(&PL_sv_no); + sv_setpv(sv, "AnyDBM_File"); + stash = gv_stashsv(sv, FALSE); + if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) { + PUTBACK; + perl_require_pv("AnyDBM_File.pm"); + SPAGAIN; + if (!(gv = gv_fetchmethod(stash, "TIEHASH"))) + DIE("No dbm on this machine"); + } + + ENTER; + PUSHMARK(SP); + + EXTEND(SP, 5); + PUSHs(sv); + PUSHs(left); + if (SvIV(right)) + PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT))); + else + PUSHs(sv_2mortal(newSViv(O_RDWR))); + PUSHs(right); + PUTBACK; + perl_call_sv((SV*)GvCV(gv), G_SCALAR); + SPAGAIN; + + if (!sv_isobject(TOPs)) { + SP--; + PUSHMARK(SP); + PUSHs(sv); + PUSHs(left); + PUSHs(sv_2mortal(newSViv(O_RDONLY))); + PUSHs(right); + PUTBACK; + perl_call_sv((SV*)GvCV(gv), G_SCALAR); + SPAGAIN; + } + + if (sv_isobject(TOPs)) { + sv_unmagic((SV *) hv, 'P'); + sv_magic((SV*)hv, TOPs, 'P', Nullch, 0); + } + LEAVE; + RETURN; +} + +PP(pp_dbmclose) +{ + return pp_untie(ARGS); +} + +PP(pp_sselect) +{ + djSP; dTARGET; +#ifdef HAS_SELECT + register I32 i; + register I32 j; + register char *s; + register SV *sv; + double value; + I32 maxlen = 0; + I32 nfound; + struct timeval timebuf; + struct timeval *tbuf = &timebuf; + I32 growsize; + char *fd_sets[4]; +#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 + I32 masksize; + I32 offset; + I32 k; + +# if BYTEORDER & 0xf0000 +# define ORDERBYTE (0x88888888 - BYTEORDER) +# else +# define ORDERBYTE (0x4444 - BYTEORDER) +# endif + +#endif + + SP -= 4; + for (i = 1; i <= 3; i++) { + if (!SvPOK(SP[i])) + continue; + j = SvCUR(SP[i]); + if (maxlen < j) + maxlen = j; + } + +#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 +/* XXX Configure test needed. */ +#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun) + growsize = sizeof(fd_set); +#else + growsize = maxlen; /* little endians can use vecs directly */ +#endif +#else +#ifdef NFDBITS + +#ifndef NBBY +#define NBBY 8 +#endif + + masksize = NFDBITS / NBBY; +#else + masksize = sizeof(long); /* documented int, everyone seems to use long */ +#endif + growsize = maxlen + (masksize - (maxlen % masksize)); + Zero(&fd_sets[0], 4, char*); +#endif + + sv = SP[4]; + if (SvOK(sv)) { + value = SvNV(sv); + if (value < 0.0) + value = 0.0; + timebuf.tv_sec = (long)value; + value -= (double)timebuf.tv_sec; + timebuf.tv_usec = (long)(value * 1000000.0); + } + else + tbuf = Null(struct timeval*); + + for (i = 1; i <= 3; i++) { + sv = SP[i]; + if (!SvOK(sv)) { + fd_sets[i] = 0; + continue; + } + else if (!SvPOK(sv)) + SvPV_force(sv,PL_na); /* force string conversion */ + j = SvLEN(sv); + if (j < growsize) { + Sv_Grow(sv, growsize); + } + j = SvCUR(sv); + s = SvPVX(sv) + j; + while (++j <= growsize) { + *s++ = '\0'; + } + +#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 + s = SvPVX(sv); + New(403, fd_sets[i], growsize, char); + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + fd_sets[i][j+offset] = s[(k % masksize) + offset]; + } +#else + fd_sets[i] = SvPVX(sv); +#endif + } + + nfound = PerlSock_select( + maxlen * 8, + (Select_fd_set_t) fd_sets[1], + (Select_fd_set_t) fd_sets[2], + (Select_fd_set_t) fd_sets[3], + tbuf); + for (i = 1; i <= 3; i++) { + if (fd_sets[i]) { + sv = SP[i]; +#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 + s = SvPVX(sv); + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + s[(k % masksize) + offset] = fd_sets[i][j+offset]; + } + Safefree(fd_sets[i]); +#endif + SvSETMAGIC(sv); + } + } + + PUSHi(nfound); + if (GIMME == G_ARRAY && tbuf) { + value = (double)(timebuf.tv_sec) + + (double)(timebuf.tv_usec) / 1000000.0; + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setnv(sv, value); + } + RETURN; +#else + DIE("select not implemented"); +#endif +} + +void +setdefout(GV *gv) +{ + dTHR; + if (gv) + (void)SvREFCNT_inc(gv); + if (PL_defoutgv) + SvREFCNT_dec(PL_defoutgv); + PL_defoutgv = gv; +} + +PP(pp_select) +{ + djSP; dTARGET; + GV *newdefout, *egv; + HV *hv; + + newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL; + + egv = GvEGV(PL_defoutgv); + if (!egv) + egv = PL_defoutgv; + hv = GvSTASH(egv); + if (! hv) + XPUSHs(&PL_sv_undef); + else { + GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE); + if (gvp && *gvp == egv) { + gv_efullname3(TARG, PL_defoutgv, Nullch); + XPUSHTARG; + } + else { + XPUSHs(sv_2mortal(newRV((SV*)egv))); + } + } + + if (newdefout) { + if (!GvIO(newdefout)) + gv_IOadd(newdefout); + setdefout(newdefout); + } + + RETURN; +} + +PP(pp_getc) +{ + djSP; dTARGET; + GV *gv; + MAGIC *mg; + + if (MAXARG <= 0) + gv = PL_stdingv; + else + gv = (GV*)POPs; + if (!gv) + gv = PL_argvgv; + + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + I32 gimme = GIMME_V; + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + perl_call_method("GETC", gimme); + LEAVE; + SPAGAIN; + if (gimme == G_SCALAR) + SvSetMagicSV_nosteal(TARG, TOPs); + RETURN; + } + if (!gv || do_eof(gv)) /* make sure we have fp with something */ + RETPUSHUNDEF; + TAINT; + sv_setpv(TARG, " "); + *SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */ + PUSHTARG; + RETURN; +} + +PP(pp_read) +{ + return pp_sysread(ARGS); +} + +STATIC OP * +doform(CV *cv, GV *gv, OP *retop) +{ + dTHR; + register PERL_CONTEXT *cx; + I32 gimme = GIMME_V; + AV* padlist = CvPADLIST(cv); + SV** svp = AvARRAY(padlist); + + ENTER; + SAVETMPS; + + push_return(retop); + PUSHBLOCK(cx, CXt_SUB, PL_stack_sp); + PUSHFORMAT(cx); + SAVESPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)svp[1]); + + setdefout(gv); /* locally select filehandle so $% et al work */ + return CvSTART(cv); +} + +PP(pp_enterwrite) +{ + djSP; + register GV *gv; + register IO *io; + GV *fgv; + CV *cv; + + if (MAXARG == 0) + gv = PL_defoutgv; + else { + gv = (GV*)POPs; + if (!gv) + gv = PL_defoutgv; + } + EXTEND(SP, 1); + io = GvIO(gv); + if (!io) { + RETPUSHNO; + } + if (IoFMT_GV(io)) + fgv = IoFMT_GV(io); + else + fgv = gv; + + cv = GvFORM(fgv); + if (!cv) { + if (fgv) { + SV *tmpsv = sv_newmortal(); + gv_efullname3(tmpsv, fgv, Nullch); + DIE("Undefined format \"%s\" called",SvPVX(tmpsv)); + } + DIE("Not a format reference"); + } + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + + IoFLAGS(io) &= ~IOf_DIDTOP; + return doform(cv,gv,PL_op->op_next); +} + +PP(pp_leavewrite) +{ + djSP; + GV *gv = cxstack[cxstack_ix].blk_sub.gv; + register IO *io = GvIOp(gv); + PerlIO *ofp = IoOFP(io); + PerlIO *fp; + SV **newsp; + I32 gimme; + register PERL_CONTEXT *cx; + + DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n", + (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget))); + if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) && + PL_formtarget != PL_toptarget) + { + GV *fgv; + CV *cv; + if (!IoTOP_GV(io)) { + GV *topgv; + SV *topname; + + if (!IoTOP_NAME(io)) { + if (!IoFMT_NAME(io)) + IoFMT_NAME(io) = savepv(GvNAME(gv)); + topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io))); + topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM); + if ((topgv && GvFORM(topgv)) || + !gv_fetchpv("top",FALSE,SVt_PVFM)) + IoTOP_NAME(io) = savepv(SvPVX(topname)); + else + IoTOP_NAME(io) = savepv("top"); + } + topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM); + if (!topgv || !GvFORM(topgv)) { + IoLINES_LEFT(io) = 100000000; + goto forget_top; + } + IoTOP_GV(io) = topgv; + } + if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */ + I32 lines = IoLINES_LEFT(io); + char *s = SvPVX(PL_formtarget); + if (lines <= 0) /* Yow, header didn't even fit!!! */ + goto forget_top; + while (lines-- > 0) { + s = strchr(s, '\n'); + if (!s) + break; + s++; + } + if (s) { + PerlIO_write(ofp, SvPVX(PL_formtarget), s - SvPVX(PL_formtarget)); + sv_chop(PL_formtarget, s); + FmLINES(PL_formtarget) -= IoLINES_LEFT(io); + } + } + if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0) + PerlIO_write(ofp, SvPVX(PL_formfeed), SvCUR(PL_formfeed)); + IoLINES_LEFT(io) = IoPAGE_LEN(io); + IoPAGE(io)++; + PL_formtarget = PL_toptarget; + IoFLAGS(io) |= IOf_DIDTOP; + fgv = IoTOP_GV(io); + if (!fgv) + DIE("bad top format reference"); + cv = GvFORM(fgv); + if (!cv) { + SV *tmpsv = sv_newmortal(); + gv_efullname3(tmpsv, fgv, Nullch); + DIE("Undefined top format \"%s\" called",SvPVX(tmpsv)); + } + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + return doform(cv,gv,PL_op); + } + + forget_top: + POPBLOCK(cx,PL_curpm); + POPFORMAT(cx); + LEAVE; + + fp = IoOFP(io); + if (!fp) { + if (PL_dowarn) { + if (IoIFP(io)) + warn("Filehandle only opened for input"); + else + warn("Write on closed filehandle"); + } + PUSHs(&PL_sv_no); + } + else { + if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) { + if (PL_dowarn) + warn("page overflow"); + } + if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) || + PerlIO_error(fp)) + PUSHs(&PL_sv_no); + else { + FmLINES(PL_formtarget) = 0; + SvCUR_set(PL_formtarget, 0); + *SvEND(PL_formtarget) = '\0'; + if (IoFLAGS(io) & IOf_FLUSH) + (void)PerlIO_flush(fp); + PUSHs(&PL_sv_yes); + } + } + PL_formtarget = PL_bodytarget; + PUTBACK; + return pop_return(); +} + +PP(pp_prtf) +{ + djSP; dMARK; dORIGMARK; + GV *gv; + IO *io; + PerlIO *fp; + SV *sv; + MAGIC *mg; + + if (PL_op->op_flags & OPf_STACKED) + gv = (GV*)*++MARK; + else + gv = PL_defoutgv; + + if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) { + if (MARK == ORIGMARK) { + MEXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + PUSHMARK(MARK - 1); + *MARK = mg->mg_obj; + PUTBACK; + ENTER; + perl_call_method("PRINTF", G_SCALAR); + LEAVE; + SPAGAIN; + MARK = ORIGMARK + 1; + *MARK = *SP; + SP = MARK; + RETURN; + } + + sv = NEWSV(0,0); + if (!(io = GvIO(gv))) { + if (PL_dowarn) { + gv_fullname3(sv, gv, Nullch); + warn("Filehandle %s never opened", SvPV(sv,PL_na)); + } + SETERRNO(EBADF,RMS$_IFI); + goto just_say_no; + } + else if (!(fp = IoOFP(io))) { + if (PL_dowarn) { + gv_fullname3(sv, gv, Nullch); + if (IoIFP(io)) + warn("Filehandle %s opened only for input", SvPV(sv,PL_na)); + else + warn("printf on closed filehandle %s", SvPV(sv,PL_na)); + } + SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); + goto just_say_no; + } + else { +#ifdef USE_LOCALE_NUMERIC + if (PL_op->op_private & OPpLOCALE) + SET_NUMERIC_LOCAL(); + else + SET_NUMERIC_STANDARD(); +#endif + do_sprintf(sv, SP - MARK, MARK + 1); + if (!do_print(sv, fp)) + goto just_say_no; + + if (IoFLAGS(io) & IOf_FLUSH) + if (PerlIO_flush(fp) == EOF) + goto just_say_no; + } + SvREFCNT_dec(sv); + SP = ORIGMARK; + PUSHs(&PL_sv_yes); + RETURN; + + just_say_no: + SvREFCNT_dec(sv); + SP = ORIGMARK; + PUSHs(&PL_sv_undef); + RETURN; +} + +PP(pp_sysopen) +{ + djSP; + GV *gv; + SV *sv; + char *tmps; + STRLEN len; + int mode, perm; + + if (MAXARG > 3) + perm = POPi; + else + perm = 0666; + mode = POPi; + sv = POPs; + gv = (GV *)POPs; + + tmps = SvPV(sv, len); + if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) { + IoLINES(GvIOp(gv)) = 0; + PUSHs(&PL_sv_yes); + } + else { + PUSHs(&PL_sv_undef); + } + RETURN; +} + +PP(pp_sysread) +{ + djSP; dMARK; dORIGMARK; dTARGET; + int offset; + GV *gv; + IO *io; + char *buffer; + SSize_t length; + Sock_size_t bufsize; + SV *bufsv; + STRLEN blen; + MAGIC *mg; + + gv = (GV*)*++MARK; + if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && + SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) + { + SV *sv; + + PUSHMARK(MARK-1); + *MARK = mg->mg_obj; + ENTER; + perl_call_method("READ", G_SCALAR); + LEAVE; + SPAGAIN; + sv = POPs; + SP = ORIGMARK; + PUSHs(sv); + RETURN; + } + + if (!gv) + goto say_undef; + bufsv = *++MARK; + if (! SvOK(bufsv)) + sv_setpvn(bufsv, "", 0); + buffer = SvPV_force(bufsv, blen); + length = SvIVx(*++MARK); + if (length < 0) + DIE("Negative length"); + SETERRNO(0,0); + if (MARK < SP) + offset = SvIVx(*++MARK); + else + offset = 0; + io = GvIO(gv); + if (!io || !IoIFP(io)) + goto say_undef; +#ifdef HAS_SOCKET + if (PL_op->op_type == OP_RECV) { + char namebuf[MAXPATHLEN]; +#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) + bufsize = sizeof (struct sockaddr_in); +#else + bufsize = sizeof namebuf; +#endif + buffer = SvGROW(bufsv, length+1); + /* 'offset' means 'flags' here */ + length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + (struct sockaddr *)namebuf, &bufsize); + if (length < 0) + RETPUSHUNDEF; + SvCUR_set(bufsv, length); + *SvEND(bufsv) = '\0'; + (void)SvPOK_only(bufsv); + SvSETMAGIC(bufsv); + /* This should not be marked tainted if the fp is marked clean */ + if (!(IoFLAGS(io) & IOf_UNTAINT)) + SvTAINTED_on(bufsv); + SP = ORIGMARK; + sv_setpvn(TARG, namebuf, bufsize); + PUSHs(TARG); + RETURN; + } +#else + if (PL_op->op_type == OP_RECV) + DIE(no_sock_func, "recv"); +#endif + if (offset < 0) { + if (-offset > blen) + DIE("Offset outside string"); + offset += blen; + } + bufsize = SvCUR(bufsv); + buffer = SvGROW(bufsv, length+offset+1); + if (offset > bufsize) { /* Zero any newly allocated space */ + Zero(buffer+bufsize, offset-bufsize, char); + } + if (PL_op->op_type == OP_SYSREAD) { + length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length); + } + else +#ifdef HAS_SOCKET__bad_code_maybe + if (IoTYPE(io) == 's') { + char namebuf[MAXPATHLEN]; +#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS) + bufsize = sizeof (struct sockaddr_in); +#else + bufsize = sizeof namebuf; +#endif + length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0, + (struct sockaddr *)namebuf, &bufsize); + } + else +#endif + { + length = PerlIO_read(IoIFP(io), buffer+offset, length); + /* fread() returns 0 on both error and EOF */ + if (length == 0 && PerlIO_error(IoIFP(io))) + length = -1; + } + if (length < 0) + goto say_undef; + SvCUR_set(bufsv, length+offset); + *SvEND(bufsv) = '\0'; + (void)SvPOK_only(bufsv); + SvSETMAGIC(bufsv); + /* This should not be marked tainted if the fp is marked clean */ + if (!(IoFLAGS(io) & IOf_UNTAINT)) + SvTAINTED_on(bufsv); + SP = ORIGMARK; + PUSHi(length); + RETURN; + + say_undef: + SP = ORIGMARK; + RETPUSHUNDEF; +} + +PP(pp_syswrite) +{ + return pp_send(ARGS); +} + +PP(pp_send) +{ + djSP; dMARK; dORIGMARK; dTARGET; + GV *gv; + IO *io; + int offset; + SV *bufsv; + char *buffer; + int length; + STRLEN blen; + MAGIC *mg; + + gv = (GV*)*++MARK; + if (PL_op->op_type == OP_SYSWRITE && + SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) + { + SV *sv; + + PUSHMARK(MARK-1); + *MARK = mg->mg_obj; + ENTER; + perl_call_method("WRITE", G_SCALAR); + LEAVE; + SPAGAIN; + sv = POPs; + SP = ORIGMARK; + PUSHs(sv); + RETURN; + } + if (!gv) + goto say_undef; + bufsv = *++MARK; + buffer = SvPV(bufsv, blen); + length = SvIVx(*++MARK); + if (length < 0) + DIE("Negative length"); + SETERRNO(0,0); + io = GvIO(gv); + if (!io || !IoIFP(io)) { + length = -1; + if (PL_dowarn) { + if (PL_op->op_type == OP_SYSWRITE) + warn("Syswrite on closed filehandle"); + else + warn("Send on closed socket"); + } + } + else if (PL_op->op_type == OP_SYSWRITE) { + if (MARK < SP) { + offset = SvIVx(*++MARK); + if (offset < 0) { + if (-offset > blen) + DIE("Offset outside string"); + offset += blen; + } else if (offset >= blen && blen > 0) + DIE("Offset outside string"); + } else + offset = 0; + if (length > blen - offset) + length = blen - offset; + length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length); + } +#ifdef HAS_SOCKET + else if (SP > MARK) { + char *sockbuf; + STRLEN mlen; + sockbuf = SvPVx(*++MARK, mlen); + length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length, + (struct sockaddr *)sockbuf, mlen); + } + else + length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length); + +#else + else + DIE(no_sock_func, "send"); +#endif + if (length < 0) + goto say_undef; + SP = ORIGMARK; + PUSHi(length); + RETURN; + + say_undef: + SP = ORIGMARK; + RETPUSHUNDEF; +} + +PP(pp_recv) +{ + return pp_sysread(ARGS); +} + +PP(pp_eof) +{ + djSP; + GV *gv; + + if (MAXARG <= 0) + gv = PL_last_in_gv; + else + gv = PL_last_in_gv = (GV*)POPs; + PUSHs(boolSV(!gv || do_eof(gv))); + RETURN; +} + +PP(pp_tell) +{ + djSP; dTARGET; + GV *gv; + + if (MAXARG <= 0) + gv = PL_last_in_gv; + else + gv = PL_last_in_gv = (GV*)POPs; + PUSHi( do_tell(gv) ); + RETURN; +} + +PP(pp_seek) +{ + return pp_sysseek(ARGS); +} + +PP(pp_sysseek) +{ + djSP; + GV *gv; + int whence = POPi; + long offset = POPl; + + gv = PL_last_in_gv = (GV*)POPs; + if (PL_op->op_type == OP_SEEK) + PUSHs(boolSV(do_seek(gv, offset, whence))); + else { + long n = do_sysseek(gv, offset, whence); + PUSHs((n < 0) ? &PL_sv_undef + : sv_2mortal(n ? newSViv((IV)n) + : newSVpv(zero_but_true, ZBTLEN))); + } + RETURN; +} + +PP(pp_truncate) +{ + djSP; + Off_t len = (Off_t)POPn; + int result = 1; + GV *tmpgv; + + SETERRNO(0,0); +#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) + if (PL_op->op_flags & OPf_SPECIAL) { + tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO); + do_ftruncate: + TAINT_PROPER("truncate"); + if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || +#ifdef HAS_TRUNCATE + ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) +#else + my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) +#endif + result = 0; + } + else { + SV *sv = POPs; + char *name; + + if (SvTYPE(sv) == SVt_PVGV) { + tmpgv = (GV*)sv; /* *main::FRED for example */ + goto do_ftruncate; + } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { + tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */ + goto do_ftruncate; + } + + name = SvPV(sv, PL_na); + TAINT_PROPER("truncate"); +#ifdef HAS_TRUNCATE + if (truncate(name, len) < 0) + result = 0; +#else + { + int tmpfd; + if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0) + result = 0; + else { + if (my_chsize(tmpfd, len) < 0) + result = 0; + PerlLIO_close(tmpfd); + } + } +#endif + } + + if (result) + RETPUSHYES; + if (!errno) + SETERRNO(EBADF,RMS$_IFI); + RETPUSHUNDEF; +#else + DIE("truncate not implemented"); +#endif +} + +PP(pp_fcntl) +{ + return pp_ioctl(ARGS); +} + +PP(pp_ioctl) +{ + djSP; dTARGET; + SV *argsv = POPs; + unsigned int func = U_I(POPn); + int optype = PL_op->op_type; + char *s; + IV retval; + GV *gv = (GV*)POPs; + IO *io = GvIOn(gv); + + if (!io || !argsv || !IoIFP(io)) { + SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */ + RETPUSHUNDEF; + } + + if (SvPOK(argsv) || !SvNIOK(argsv)) { + STRLEN len; + STRLEN need; + s = SvPV_force(argsv, len); + need = IOCPARM_LEN(func); + if (len < need) { + s = Sv_Grow(argsv, need + 1); + SvCUR_set(argsv, need); + } + + s[SvCUR(argsv)] = 17; /* a little sanity check here */ + } + else { + retval = SvIV(argsv); + s = (char*)retval; /* ouch */ + } + + TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl"); + + if (optype == OP_IOCTL) +#ifdef HAS_IOCTL + retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s); +#else + DIE("ioctl is not implemented"); +#endif + else +#ifdef HAS_FCNTL +#if defined(OS2) && defined(__EMX__) + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s); +#else + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s); +#endif +#else + DIE("fcntl is not implemented"); +#endif + + if (SvPOK(argsv)) { + if (s[SvCUR(argsv)] != 17) + DIE("Possible memory corruption: %s overflowed 3rd argument", + op_name[optype]); + s[SvCUR(argsv)] = 0; /* put our null back */ + SvSETMAGIC(argsv); /* Assume it has changed */ + } + + if (retval == -1) + RETPUSHUNDEF; + if (retval != 0) { + PUSHi(retval); + } + else { + PUSHp(zero_but_true, ZBTLEN); + } + RETURN; +} + +PP(pp_flock) +{ + djSP; dTARGET; + I32 value; + int argtype; + GV *gv; + PerlIO *fp; + +#ifdef FLOCK + argtype = POPi; + if (MAXARG <= 0) + gv = PL_last_in_gv; + else + gv = (GV*)POPs; + if (gv && GvIO(gv)) + fp = IoIFP(GvIOp(gv)); + else + fp = Nullfp; + if (fp) { + (void)PerlIO_flush(fp); + value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); + } + else + value = 0; + PUSHi(value); + RETURN; +#else + DIE(no_func, "flock()"); +#endif +} + +/* Sockets. */ + +PP(pp_socket) +{ + djSP; +#ifdef HAS_SOCKET + GV *gv; + register IO *io; + int protocol = POPi; + int type = POPi; + int domain = POPi; + int fd; + + gv = (GV*)POPs; + + if (!gv) { + SETERRNO(EBADF,LIB$_INVARG); + RETPUSHUNDEF; + } + + io = GvIOn(gv); + if (IoIFP(io)) + do_close(gv, FALSE); + + TAINT_PROPER("socket"); + fd = PerlSock_socket(domain, type, protocol); + if (fd < 0) + RETPUSHUNDEF; + IoIFP(io) = PerlIO_fdopen(fd, "r"); /* stdio gets confused about sockets */ + IoOFP(io) = PerlIO_fdopen(fd, "w"); + IoTYPE(io) = 's'; + if (!IoIFP(io) || !IoOFP(io)) { + if (IoIFP(io)) PerlIO_close(IoIFP(io)); + if (IoOFP(io)) PerlIO_close(IoOFP(io)); + if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); + RETPUSHUNDEF; + } + + RETPUSHYES; +#else + DIE(no_sock_func, "socket"); +#endif +} + +PP(pp_sockpair) +{ + djSP; +#ifdef HAS_SOCKETPAIR + GV *gv1; + GV *gv2; + register IO *io1; + register IO *io2; + int protocol = POPi; + int type = POPi; + int domain = POPi; + int fd[2]; + + gv2 = (GV*)POPs; + gv1 = (GV*)POPs; + if (!gv1 || !gv2) + RETPUSHUNDEF; + + io1 = GvIOn(gv1); + io2 = GvIOn(gv2); + if (IoIFP(io1)) + do_close(gv1, FALSE); + if (IoIFP(io2)) + do_close(gv2, FALSE); + + TAINT_PROPER("socketpair"); + if (PerlSock_socketpair(domain, type, protocol, fd) < 0) + RETPUSHUNDEF; + IoIFP(io1) = PerlIO_fdopen(fd[0], "r"); + IoOFP(io1) = PerlIO_fdopen(fd[0], "w"); + IoTYPE(io1) = 's'; + IoIFP(io2) = PerlIO_fdopen(fd[1], "r"); + IoOFP(io2) = PerlIO_fdopen(fd[1], "w"); + IoTYPE(io2) = 's'; + if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) { + if (IoIFP(io1)) PerlIO_close(IoIFP(io1)); + if (IoOFP(io1)) PerlIO_close(IoOFP(io1)); + if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]); + if (IoIFP(io2)) PerlIO_close(IoIFP(io2)); + if (IoOFP(io2)) PerlIO_close(IoOFP(io2)); + if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); + RETPUSHUNDEF; + } + + RETPUSHYES; +#else + DIE(no_sock_func, "socketpair"); +#endif +} + +PP(pp_bind) +{ + djSP; +#ifdef HAS_SOCKET +#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */ + extern GETPRIVMODE(); + extern GETUSERMODE(); +#endif + SV *addrsv = POPs; + char *addr; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + STRLEN len; + int bind_ok = 0; +#ifdef MPE + int mpeprivmode = 0; +#endif + + if (!io || !IoIFP(io)) + goto nuts; + + addr = SvPV(addrsv, len); + TAINT_PROPER("bind"); +#ifdef MPE /* Deal with MPE bind() peculiarities */ + if (((struct sockaddr *)addr)->sa_family == AF_INET) { + /* The address *MUST* stupidly be zero. */ + ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY; + /* PRIV mode is required to bind() to ports < 1024. */ + if (((struct sockaddr_in *)addr)->sin_port < 1024 && + ((struct sockaddr_in *)addr)->sin_port > 0) { + GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */ + mpeprivmode = 1; + } + } +#endif /* MPE */ + if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), + (struct sockaddr *)addr, len) >= 0) + bind_ok = 1; + +#ifdef MPE /* Switch back to USER mode */ + if (mpeprivmode) + GETUSERMODE(); +#endif /* MPE */ + + if (bind_ok) + RETPUSHYES; + else + RETPUSHUNDEF; + +nuts: + if (PL_dowarn) + warn("bind() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); + RETPUSHUNDEF; +#else + DIE(no_sock_func, "bind"); +#endif +} + +PP(pp_connect) +{ + djSP; +#ifdef HAS_SOCKET + SV *addrsv = POPs; + char *addr; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + STRLEN len; + + if (!io || !IoIFP(io)) + goto nuts; + + addr = SvPV(addrsv, len); + TAINT_PROPER("connect"); + if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) + RETPUSHYES; + else + RETPUSHUNDEF; + +nuts: + if (PL_dowarn) + warn("connect() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); + RETPUSHUNDEF; +#else + DIE(no_sock_func, "connect"); +#endif +} + +PP(pp_listen) +{ + djSP; +#ifdef HAS_SOCKET + int backlog = POPi; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoIFP(io)) + goto nuts; + + if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0) + RETPUSHYES; + else + RETPUSHUNDEF; + +nuts: + if (PL_dowarn) + warn("listen() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); + RETPUSHUNDEF; +#else + DIE(no_sock_func, "listen"); +#endif +} + +PP(pp_accept) +{ + djSP; dTARGET; +#ifdef HAS_SOCKET + GV *ngv; + GV *ggv; + register IO *nstio; + register IO *gstio; + struct sockaddr saddr; /* use a struct to avoid alignment problems */ + Sock_size_t len = sizeof saddr; + int fd; + + ggv = (GV*)POPs; + ngv = (GV*)POPs; + + if (!ngv) + goto badexit; + if (!ggv) + goto nuts; + + gstio = GvIO(ggv); + if (!gstio || !IoIFP(gstio)) + goto nuts; + + nstio = GvIOn(ngv); + if (IoIFP(nstio)) + do_close(ngv, FALSE); + + fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len); + if (fd < 0) + goto badexit; + IoIFP(nstio) = PerlIO_fdopen(fd, "r"); + IoOFP(nstio) = PerlIO_fdopen(fd, "w"); + IoTYPE(nstio) = 's'; + if (!IoIFP(nstio) || !IoOFP(nstio)) { + if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio)); + if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio)); + if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); + goto badexit; + } + + PUSHp((char *)&saddr, len); + RETURN; + +nuts: + if (PL_dowarn) + warn("accept() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); + +badexit: + RETPUSHUNDEF; + +#else + DIE(no_sock_func, "accept"); +#endif +} + +PP(pp_shutdown) +{ + djSP; dTARGET; +#ifdef HAS_SOCKET + int how = POPi; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoIFP(io)) + goto nuts; + + PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 ); + RETURN; + +nuts: + if (PL_dowarn) + warn("shutdown() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); + RETPUSHUNDEF; +#else + DIE(no_sock_func, "shutdown"); +#endif +} + +PP(pp_gsockopt) +{ +#ifdef HAS_SOCKET + return pp_ssockopt(ARGS); +#else + DIE(no_sock_func, "getsockopt"); +#endif +} + +PP(pp_ssockopt) +{ + djSP; +#ifdef HAS_SOCKET + int optype = PL_op->op_type; + SV *sv; + int fd; + unsigned int optname; + unsigned int lvl; + GV *gv; + register IO *io; + Sock_size_t len; + + if (optype == OP_GSOCKOPT) + sv = sv_2mortal(NEWSV(22, 257)); + else + sv = POPs; + optname = (unsigned int) POPi; + lvl = (unsigned int) POPi; + + gv = (GV*)POPs; + io = GvIOn(gv); + if (!io || !IoIFP(io)) + goto nuts; + + fd = PerlIO_fileno(IoIFP(io)); + switch (optype) { + case OP_GSOCKOPT: + SvGROW(sv, 257); + (void)SvPOK_only(sv); + SvCUR_set(sv,256); + *SvEND(sv) ='\0'; + len = SvCUR(sv); + if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0) + goto nuts2; + SvCUR_set(sv, len); + *SvEND(sv) ='\0'; + PUSHs(sv); + break; + case OP_SSOCKOPT: { + char *buf; + int aint; + if (SvPOKp(sv)) { + buf = SvPV(sv, PL_na); + len = PL_na; + } + else { + aint = (int)SvIV(sv); + buf = (char*)&aint; + len = sizeof(int); + } + if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0) + goto nuts2; + PUSHs(&PL_sv_yes); + } + break; + } + RETURN; + +nuts: + if (PL_dowarn) + warn("[gs]etsockopt() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); +nuts2: + RETPUSHUNDEF; + +#else + DIE(no_sock_func, "setsockopt"); +#endif +} + +PP(pp_getsockname) +{ +#ifdef HAS_SOCKET + return pp_getpeername(ARGS); +#else + DIE(no_sock_func, "getsockname"); +#endif +} + +PP(pp_getpeername) +{ + djSP; +#ifdef HAS_SOCKET + int optype = PL_op->op_type; + SV *sv; + int fd; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + Sock_size_t len; + + if (!io || !IoIFP(io)) + goto nuts; + + sv = sv_2mortal(NEWSV(22, 257)); + (void)SvPOK_only(sv); + len = 256; + SvCUR_set(sv, len); + *SvEND(sv) ='\0'; + fd = PerlIO_fileno(IoIFP(io)); + switch (optype) { + case OP_GETSOCKNAME: + if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) + goto nuts2; + break; + case OP_GETPEERNAME: + if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) + goto nuts2; +#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS) + { + static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; + /* If the call succeeded, make sure we don't have a zeroed port/addr */ + if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET && + !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere, + sizeof(u_short) + sizeof(struct in_addr))) { + goto nuts2; + } + } +#endif + break; + } +#ifdef BOGUS_GETNAME_RETURN + /* Interactive Unix, getpeername() and getsockname() + does not return valid namelen */ + if (len == BOGUS_GETNAME_RETURN) + len = sizeof(struct sockaddr); +#endif + SvCUR_set(sv, len); + *SvEND(sv) ='\0'; + PUSHs(sv); + RETURN; + +nuts: + if (PL_dowarn) + warn("get{sock, peer}name() on closed fd"); + SETERRNO(EBADF,SS$_IVCHAN); +nuts2: + RETPUSHUNDEF; + +#else + DIE(no_sock_func, "getpeername"); +#endif +} + +/* Stat calls. */ + +PP(pp_lstat) +{ + return pp_stat(ARGS); +} + +PP(pp_stat) +{ + djSP; + GV *tmpgv; + I32 gimme; + I32 max = 13; + + if (PL_op->op_flags & OPf_REF) { + tmpgv = cGVOP->op_gv; + do_fstat: + if (tmpgv != PL_defgv) { + PL_laststype = OP_STAT; + PL_statgv = tmpgv; + sv_setpv(PL_statname, ""); + PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv)) + ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1); + } + if (PL_laststatval < 0) + max = 0; + } + else { + SV* sv = POPs; + if (SvTYPE(sv) == SVt_PVGV) { + tmpgv = (GV*)sv; + goto do_fstat; + } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { + tmpgv = (GV*)SvRV(sv); + goto do_fstat; + } + sv_setpv(PL_statname, SvPV(sv,PL_na)); + PL_statgv = Nullgv; +#ifdef HAS_LSTAT + PL_laststype = PL_op->op_type; + if (PL_op->op_type == OP_LSTAT) + PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, PL_na), &PL_statcache); + else +#endif + PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache); + if (PL_laststatval < 0) { + if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n')) + warn(warn_nl, "stat"); + max = 0; + } + } + + gimme = GIMME_V; + if (gimme != G_ARRAY) { + if (gimme != G_VOID) + XPUSHs(boolSV(max)); + RETURN; + } + if (max) { + EXTEND(SP, max); + EXTEND_MORTAL(max); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_dev))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ino))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mode))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_nlink))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_uid))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_gid))); +#ifdef USE_STAT_RDEV + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_rdev))); +#else + PUSHs(sv_2mortal(newSVpv("", 0))); +#endif + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size))); +#ifdef BIG_TIME + PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime))); + PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime))); + PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime))); +#else + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ctime))); +#endif +#ifdef USE_STAT_BLOCKS + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blksize))); + PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blocks))); +#else + PUSHs(sv_2mortal(newSVpv("", 0))); + PUSHs(sv_2mortal(newSVpv("", 0))); +#endif + } + RETURN; +} + +PP(pp_ftrread) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IRUSR, 0, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftrwrite) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IWUSR, 0, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftrexec) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IXUSR, 0, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_fteread) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IRUSR, 1, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftewrite) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IWUSR, 1, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_fteexec) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (cando(S_IXUSR, 1, &PL_statcache)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftis) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + RETPUSHYES; +} + +PP(pp_fteowned) +{ + return pp_ftrowned(ARGS); +} + +PP(pp_ftrowned) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) ) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftzero) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (!PL_statcache.st_size) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftsize) +{ + I32 result = my_stat(ARGS); + djSP; dTARGET; + if (result < 0) + RETPUSHUNDEF; + PUSHi(PL_statcache.st_size); + RETURN; +} + +PP(pp_ftmtime) +{ + I32 result = my_stat(ARGS); + djSP; dTARGET; + if (result < 0) + RETPUSHUNDEF; + PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_mtime) / 86400.0 ); + RETURN; +} + +PP(pp_ftatime) +{ + I32 result = my_stat(ARGS); + djSP; dTARGET; + if (result < 0) + RETPUSHUNDEF; + PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_atime) / 86400.0 ); + RETURN; +} + +PP(pp_ftctime) +{ + I32 result = my_stat(ARGS); + djSP; dTARGET; + if (result < 0) + RETPUSHUNDEF; + PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_ctime) / 86400.0 ); + RETURN; +} + +PP(pp_ftsock) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISSOCK(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftchr) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISCHR(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftblk) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISBLK(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftfile) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISREG(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftdir) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISDIR(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftpipe) +{ + I32 result = my_stat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISFIFO(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftlink) +{ + I32 result = my_lstat(ARGS); + djSP; + if (result < 0) + RETPUSHUNDEF; + if (S_ISLNK(PL_statcache.st_mode)) + RETPUSHYES; + RETPUSHNO; +} + +PP(pp_ftsuid) +{ + djSP; +#ifdef S_ISUID + I32 result = my_stat(ARGS); + SPAGAIN; + if (result < 0) + RETPUSHUNDEF; + if (PL_statcache.st_mode & S_ISUID) + RETPUSHYES; +#endif + RETPUSHNO; +} + +PP(pp_ftsgid) +{ + djSP; +#ifdef S_ISGID + I32 result = my_stat(ARGS); + SPAGAIN; + if (result < 0) + RETPUSHUNDEF; + if (PL_statcache.st_mode & S_ISGID) + RETPUSHYES; +#endif + RETPUSHNO; +} + +PP(pp_ftsvtx) +{ + djSP; +#ifdef S_ISVTX + I32 result = my_stat(ARGS); + SPAGAIN; + if (result < 0) + RETPUSHUNDEF; + if (PL_statcache.st_mode & S_ISVTX) + RETPUSHYES; +#endif + RETPUSHNO; +} + +PP(pp_fttty) +{ + djSP; + int fd; + GV *gv; + char *tmps = Nullch; + + if (PL_op->op_flags & OPf_REF) + gv = cGVOP->op_gv; + else if (isGV(TOPs)) + gv = (GV*)POPs; + else if (SvROK(TOPs) && isGV(SvRV(TOPs))) + gv = (GV*)SvRV(POPs); + else + gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO); + + if (GvIO(gv) && IoIFP(GvIOp(gv))) + fd = PerlIO_fileno(IoIFP(GvIOp(gv))); + else if (tmps && isDIGIT(*tmps)) + fd = atoi(tmps); + else + RETPUSHUNDEF; + if (PerlLIO_isatty(fd)) + RETPUSHYES; + RETPUSHNO; +} + +#if defined(atarist) /* this will work with atariST. Configure will + make guesses for other systems. */ +# define FILE_base(f) ((f)->_base) +# define FILE_ptr(f) ((f)->_ptr) +# define FILE_cnt(f) ((f)->_cnt) +# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base)) +#endif + +PP(pp_fttext) +{ + djSP; + I32 i; + I32 len; + I32 odd = 0; + STDCHAR tbuf[512]; + register STDCHAR *s; + register IO *io; + register SV *sv; + GV *gv; + + if (PL_op->op_flags & OPf_REF) + gv = cGVOP->op_gv; + else if (isGV(TOPs)) + gv = (GV*)POPs; + else if (SvROK(TOPs) && isGV(SvRV(TOPs))) + gv = (GV*)SvRV(POPs); + else + gv = Nullgv; + + if (gv) { + EXTEND(SP, 1); + if (gv == PL_defgv) { + if (PL_statgv) + io = GvIO(PL_statgv); + else { + sv = PL_statname; + goto really_filename; + } + } + else { + PL_statgv = gv; + PL_laststatval = -1; + sv_setpv(PL_statname, ""); + io = GvIO(PL_statgv); + } + if (io && IoIFP(io)) { + if (! PerlIO_has_base(IoIFP(io))) + DIE("-T and -B not implemented on filehandles"); + PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + if (PL_laststatval < 0) + RETPUSHUNDEF; + if (S_ISDIR(PL_statcache.st_mode)) /* handle NFS glitch */ + if (PL_op->op_type == OP_FTTEXT) + RETPUSHNO; + else + RETPUSHYES; + if (PerlIO_get_cnt(IoIFP(io)) <= 0) { + i = PerlIO_getc(IoIFP(io)); + if (i != EOF) + (void)PerlIO_ungetc(IoIFP(io),i); + } + if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */ + RETPUSHYES; + len = PerlIO_get_bufsiz(IoIFP(io)); + s = (STDCHAR *) PerlIO_get_base(IoIFP(io)); + /* sfio can have large buffers - limit to 512 */ + if (len > 512) + len = 512; + } + else { + if (PL_dowarn) + warn("Test on unopened file <%s>", + GvENAME(cGVOP->op_gv)); + SETERRNO(EBADF,RMS$_IFI); + RETPUSHUNDEF; + } + } + else { + sv = POPs; + really_filename: + PL_statgv = Nullgv; + PL_laststatval = -1; + sv_setpv(PL_statname, SvPV(sv, PL_na)); +#ifdef HAS_OPEN3 + i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0); +#else + i = PerlLIO_open(SvPV(sv, PL_na), 0); +#endif + if (i < 0) { + if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n')) + warn(warn_nl, "open"); + RETPUSHUNDEF; + } + PL_laststatval = PerlLIO_fstat(i, &PL_statcache); + if (PL_laststatval < 0) + RETPUSHUNDEF; + len = PerlLIO_read(i, tbuf, 512); + (void)PerlLIO_close(i); + if (len <= 0) { + if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT) + RETPUSHNO; /* special case NFS directories */ + RETPUSHYES; /* null file is anything */ + } + s = tbuf; + } + + /* now scan s to look for textiness */ + /* XXX ASCII dependent code */ + + for (i = 0; i < len; i++, s++) { + if (!*s) { /* null never allowed in text */ + odd += len; + break; + } +#ifdef EBCDIC + else if (!(isPRINT(*s) || isSPACE(*s))) + odd++; +#else + else if (*s & 128) + odd++; + else if (*s < 32 && + *s != '\n' && *s != '\r' && *s != '\b' && + *s != '\t' && *s != '\f' && *s != 27) + odd++; +#endif + } + + if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */ + RETPUSHNO; + else + RETPUSHYES; +} + +PP(pp_ftbinary) +{ + return pp_fttext(ARGS); +} + +/* File calls. */ + +PP(pp_chdir) +{ + djSP; dTARGET; + char *tmps; + SV **svp; + + if (MAXARG < 1) + tmps = Nullch; + else + tmps = POPp; + if (!tmps || !*tmps) { + svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE); + if (svp) + tmps = SvPV(*svp, PL_na); + } + if (!tmps || !*tmps) { + svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE); + if (svp) + tmps = SvPV(*svp, PL_na); + } +#ifdef VMS + if (!tmps || !*tmps) { + svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE); + if (svp) + tmps = SvPV(*svp, PL_na); + } +#endif + TAINT_PROPER("chdir"); + PUSHi( PerlDir_chdir(tmps) >= 0 ); +#ifdef VMS + /* Clear the DEFAULT element of ENV so we'll get the new value + * in the future. */ + hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); +#endif + RETURN; +} + +PP(pp_chown) +{ + djSP; dMARK; dTARGET; + I32 value; +#ifdef HAS_CHOWN + value = (I32)apply(PL_op->op_type, MARK, SP); + SP = MARK; + PUSHi(value); + RETURN; +#else + DIE(no_func, "Unsupported function chown"); +#endif +} + +PP(pp_chroot) +{ + djSP; dTARGET; + char *tmps; +#ifdef HAS_CHROOT + tmps = POPp; + TAINT_PROPER("chroot"); + PUSHi( chroot(tmps) >= 0 ); + RETURN; +#else + DIE(no_func, "chroot"); +#endif +} + +PP(pp_unlink) +{ + djSP; dMARK; dTARGET; + I32 value; + value = (I32)apply(PL_op->op_type, MARK, SP); + SP = MARK; + PUSHi(value); + RETURN; +} + +PP(pp_chmod) +{ + djSP; dMARK; dTARGET; + I32 value; + value = (I32)apply(PL_op->op_type, MARK, SP); + SP = MARK; + PUSHi(value); + RETURN; +} + +PP(pp_utime) +{ + djSP; dMARK; dTARGET; + I32 value; + value = (I32)apply(PL_op->op_type, MARK, SP); + SP = MARK; + PUSHi(value); + RETURN; +} + +PP(pp_rename) +{ + djSP; dTARGET; + int anum; + + char *tmps2 = POPp; + char *tmps = SvPV(TOPs, PL_na); + TAINT_PROPER("rename"); +#ifdef HAS_RENAME + anum = PerlLIO_rename(tmps, tmps2); +#else + if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) { + if (same_dirent(tmps2, tmps)) /* can always rename to same name */ + anum = 1; + else { + if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode)) + (void)UNLINK(tmps2); + if (!(anum = link(tmps, tmps2))) + anum = UNLINK(tmps); + } + } +#endif + SETi( anum >= 0 ); + RETURN; +} + +PP(pp_link) +{ + djSP; dTARGET; +#ifdef HAS_LINK + char *tmps2 = POPp; + char *tmps = SvPV(TOPs, PL_na); + TAINT_PROPER("link"); + SETi( link(tmps, tmps2) >= 0 ); +#else + DIE(no_func, "Unsupported function link"); +#endif + RETURN; +} + +PP(pp_symlink) +{ + djSP; dTARGET; +#ifdef HAS_SYMLINK + char *tmps2 = POPp; + char *tmps = SvPV(TOPs, PL_na); + TAINT_PROPER("symlink"); + SETi( symlink(tmps, tmps2) >= 0 ); + RETURN; +#else + DIE(no_func, "symlink"); +#endif +} + +PP(pp_readlink) +{ + djSP; dTARGET; +#ifdef HAS_SYMLINK + char *tmps; + char buf[MAXPATHLEN]; + int len; + +#ifndef INCOMPLETE_TAINTS + TAINT; +#endif + tmps = POPp; + len = readlink(tmps, buf, sizeof buf); + EXTEND(SP, 1); + if (len < 0) + RETPUSHUNDEF; + PUSHp(buf, len); + RETURN; +#else + EXTEND(SP, 1); + RETSETUNDEF; /* just pretend it's a normal file */ +#endif +} + +#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +static int +dooneliner(cmd, filename) +char *cmd; +char *filename; +{ + char *save_filename = filename; + char *cmdline; + char *s; + PerlIO *myfp; + int anum = 1; + + New(666, cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char); + strcpy(cmdline, cmd); + strcat(cmdline, " "); + for (s = cmdline + strlen(cmdline); *filename; ) { + *s++ = '\\'; + *s++ = *filename++; + } + strcpy(s, " 2>&1"); + myfp = PerlProc_popen(cmdline, "r"); + Safefree(cmdline); + + if (myfp) { + SV *tmpsv = sv_newmortal(); + /* Need to save/restore 'PL_rs' ?? */ + s = sv_gets(tmpsv, myfp, 0); + (void)PerlProc_pclose(myfp); + if (s != Nullch) { + int e; + for (e = 1; +#ifdef HAS_SYS_ERRLIST + e <= sys_nerr +#endif + ; e++) + { + /* you don't see this */ + char *errmsg = +#ifdef HAS_SYS_ERRLIST + sys_errlist[e] +#else + strerror(e) +#endif + ; + if (!errmsg) + break; + if (instr(s, errmsg)) { + SETERRNO(e,0); + return 0; + } + } + SETERRNO(0,0); +#ifndef EACCES +#define EACCES EPERM +#endif + if (instr(s, "cannot make")) + SETERRNO(EEXIST,RMS$_FEX); + else if (instr(s, "existing file")) + SETERRNO(EEXIST,RMS$_FEX); + else if (instr(s, "ile exists")) + SETERRNO(EEXIST,RMS$_FEX); + else if (instr(s, "non-exist")) + SETERRNO(ENOENT,RMS$_FNF); + else if (instr(s, "does not exist")) + SETERRNO(ENOENT,RMS$_FNF); + else if (instr(s, "not empty")) + SETERRNO(EBUSY,SS$_DEVOFFLINE); + else if (instr(s, "cannot access")) + SETERRNO(EACCES,RMS$_PRV); + else + SETERRNO(EPERM,RMS$_PRV); + return 0; + } + else { /* some mkdirs return no failure indication */ + anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0); + if (PL_op->op_type == OP_RMDIR) + anum = !anum; + if (anum) + SETERRNO(0,0); + else + SETERRNO(EACCES,RMS$_PRV); /* a guess */ + } + return anum; + } + else + return 0; +} +#endif + +PP(pp_mkdir) +{ + djSP; dTARGET; + int mode = POPi; +#ifndef HAS_MKDIR + int oldumask; +#endif + char *tmps = SvPV(TOPs, PL_na); + + TAINT_PROPER("mkdir"); +#ifdef HAS_MKDIR + SETi( PerlDir_mkdir(tmps, mode) >= 0 ); +#else + SETi( dooneliner("mkdir", tmps) ); + oldumask = PerlLIO_umask(0); + PerlLIO_umask(oldumask); + PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777); +#endif + RETURN; +} + +PP(pp_rmdir) +{ + djSP; dTARGET; + char *tmps; + + tmps = POPp; + TAINT_PROPER("rmdir"); +#ifdef HAS_RMDIR + XPUSHi( PerlDir_rmdir(tmps) >= 0 ); +#else + XPUSHi( dooneliner("rmdir", tmps) ); +#endif + RETURN; +} + +/* Directory calls. */ + +PP(pp_open_dir) +{ + djSP; +#if defined(Direntry_t) && defined(HAS_READDIR) + char *dirname = POPp; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io) + goto nope; + + if (IoDIRP(io)) + PerlDir_close(IoDIRP(io)); + if (!(IoDIRP(io) = PerlDir_open(dirname))) + goto nope; + + RETPUSHYES; +nope: + if (!errno) + SETERRNO(EBADF,RMS$_DIR); + RETPUSHUNDEF; +#else + DIE(no_dir_func, "opendir"); +#endif +} + +PP(pp_readdir) +{ + djSP; +#if defined(Direntry_t) && defined(HAS_READDIR) +#ifndef I_DIRENT + Direntry_t *readdir _((DIR *)); +#endif + register Direntry_t *dp; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + SV *sv; + + if (!io || !IoDIRP(io)) + goto nope; + + if (GIMME == G_ARRAY) { + /*SUPPRESS 560*/ + while (dp = (Direntry_t *)PerlDir_read(IoDIRP(io))) { +#ifdef DIRNAMLEN + sv = newSVpv(dp->d_name, dp->d_namlen); +#else + sv = newSVpv(dp->d_name, 0); +#endif +#ifndef INCOMPLETE_TAINTS + SvTAINTED_on(sv); +#endif + XPUSHs(sv_2mortal(sv)); + } + } + else { + if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io)))) + goto nope; +#ifdef DIRNAMLEN + sv = newSVpv(dp->d_name, dp->d_namlen); +#else + sv = newSVpv(dp->d_name, 0); +#endif +#ifndef INCOMPLETE_TAINTS + SvTAINTED_on(sv); +#endif + XPUSHs(sv_2mortal(sv)); + } + RETURN; + +nope: + if (!errno) + SETERRNO(EBADF,RMS$_ISI); + if (GIMME == G_ARRAY) + RETURN; + else + RETPUSHUNDEF; +#else + DIE(no_dir_func, "readdir"); +#endif +} + +PP(pp_telldir) +{ + djSP; dTARGET; +#if defined(HAS_TELLDIR) || defined(telldir) +# ifdef NEED_TELLDIR_PROTO /* XXX does _anyone_ need this? --AD 2/20/1998 */ + long telldir _((DIR *)); +# endif + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoDIRP(io)) + goto nope; + + PUSHi( PerlDir_tell(IoDIRP(io)) ); + RETURN; +nope: + if (!errno) + SETERRNO(EBADF,RMS$_ISI); + RETPUSHUNDEF; +#else + DIE(no_dir_func, "telldir"); +#endif +} + +PP(pp_seekdir) +{ + djSP; +#if defined(HAS_SEEKDIR) || defined(seekdir) + long along = POPl; + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoDIRP(io)) + goto nope; + + (void)PerlDir_seek(IoDIRP(io), along); + + RETPUSHYES; +nope: + if (!errno) + SETERRNO(EBADF,RMS$_ISI); + RETPUSHUNDEF; +#else + DIE(no_dir_func, "seekdir"); +#endif +} + +PP(pp_rewinddir) +{ + djSP; +#if defined(HAS_REWINDDIR) || defined(rewinddir) + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoDIRP(io)) + goto nope; + + (void)PerlDir_rewind(IoDIRP(io)); + RETPUSHYES; +nope: + if (!errno) + SETERRNO(EBADF,RMS$_ISI); + RETPUSHUNDEF; +#else + DIE(no_dir_func, "rewinddir"); +#endif +} + +PP(pp_closedir) +{ + djSP; +#if defined(Direntry_t) && defined(HAS_READDIR) + GV *gv = (GV*)POPs; + register IO *io = GvIOn(gv); + + if (!io || !IoDIRP(io)) + goto nope; + +#ifdef VOID_CLOSEDIR + PerlDir_close(IoDIRP(io)); +#else + if (PerlDir_close(IoDIRP(io)) < 0) { + IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */ + goto nope; + } +#endif + IoDIRP(io) = 0; + + RETPUSHYES; +nope: + if (!errno) + SETERRNO(EBADF,RMS$_IFI); + RETPUSHUNDEF; +#else + DIE(no_dir_func, "closedir"); +#endif +} + +/* Process control. */ + +PP(pp_fork) +{ +#ifdef HAS_FORK + djSP; dTARGET; + int childpid; + GV *tmpgv; + + EXTEND(SP, 1); + childpid = fork(); + if (childpid < 0) + RETSETUNDEF; + if (!childpid) { + /*SUPPRESS 560*/ + if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) + sv_setiv(GvSV(tmpgv), (IV)getpid()); + hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */ + } + PUSHi(childpid); + RETURN; +#else + DIE(no_func, "Unsupported function fork"); +#endif +} + +PP(pp_wait) +{ +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) + djSP; dTARGET; + int childpid; + int argflags; + + childpid = wait4pid(-1, &argflags, 0); + STATUS_NATIVE_SET((childpid > 0) ? argflags : -1); + XPUSHi(childpid); + RETURN; +#else + DIE(no_func, "Unsupported function wait"); +#endif +} + +PP(pp_waitpid) +{ +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) + djSP; dTARGET; + int childpid; + int optype; + int argflags; + + optype = POPi; + childpid = TOPi; + childpid = wait4pid(childpid, &argflags, optype); + STATUS_NATIVE_SET((childpid > 0) ? argflags : -1); + SETi(childpid); + RETURN; +#else + DIE(no_func, "Unsupported function waitpid"); +#endif +} + +PP(pp_system) +{ + djSP; dMARK; dORIGMARK; dTARGET; + I32 value; + int childpid; + int result; + int status; + Sigsave_t ihand,qhand; /* place to save signals during system() */ + + if (SP - MARK == 1) { + if (PL_tainting) { + char *junk = SvPV(TOPs, PL_na); + TAINT_ENV(); + TAINT_PROPER("system"); + } + } +#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) + while ((childpid = vfork()) == -1) { + if (errno != EAGAIN) { + value = -1; + SP = ORIGMARK; + PUSHi(value); + RETURN; + } + sleep(5); + } + if (childpid > 0) { + rsignal_save(SIGINT, SIG_IGN, &ihand); + rsignal_save(SIGQUIT, SIG_IGN, &qhand); + do { + result = wait4pid(childpid, &status, 0); + } while (result == -1 && errno == EINTR); + (void)rsignal_restore(SIGINT, &ihand); + (void)rsignal_restore(SIGQUIT, &qhand); + STATUS_NATIVE_SET(result == -1 ? -1 : status); + do_execfree(); /* free any memory child malloced on vfork */ + SP = ORIGMARK; + PUSHi(STATUS_CURRENT); + RETURN; + } + if (PL_op->op_flags & OPf_STACKED) { + SV *really = *++MARK; + value = (I32)do_aexec(really, MARK, SP); + } + else if (SP - MARK != 1) + value = (I32)do_aexec(Nullsv, MARK, SP); + else { + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); + } + PerlProc__exit(-1); +#else /* ! FORK or VMS or OS/2 */ + if (PL_op->op_flags & OPf_STACKED) { + SV *really = *++MARK; + value = (I32)do_aspawn(really, (void **)MARK, (void **)SP); + } + else if (SP - MARK != 1) + value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP); + else { + value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na)); + } + STATUS_NATIVE_SET(value); + do_execfree(); + SP = ORIGMARK; + PUSHi(STATUS_CURRENT); +#endif /* !FORK or VMS */ + RETURN; +} + +PP(pp_exec) +{ + djSP; dMARK; dORIGMARK; dTARGET; + I32 value; + + if (PL_op->op_flags & OPf_STACKED) { + SV *really = *++MARK; + value = (I32)do_aexec(really, MARK, SP); + } + else if (SP - MARK != 1) +#ifdef VMS + value = (I32)vms_do_aexec(Nullsv, MARK, SP); +#else + value = (I32)do_aexec(Nullsv, MARK, SP); +#endif + else { + if (PL_tainting) { + char *junk = SvPV(*SP, PL_na); + TAINT_ENV(); + TAINT_PROPER("exec"); + } +#ifdef VMS + value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); +#else + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na)); +#endif + } + SP = ORIGMARK; + PUSHi(value); + RETURN; +} + +PP(pp_kill) +{ + djSP; dMARK; dTARGET; + I32 value; +#ifdef HAS_KILL + value = (I32)apply(PL_op->op_type, MARK, SP); + SP = MARK; + PUSHi(value); + RETURN; +#else + DIE(no_func, "Unsupported function kill"); +#endif +} + +PP(pp_getppid) +{ +#ifdef HAS_GETPPID + djSP; dTARGET; + XPUSHi( getppid() ); + RETURN; +#else + DIE(no_func, "getppid"); +#endif +} + +PP(pp_getpgrp) +{ +#ifdef HAS_GETPGRP + djSP; dTARGET; + int pid; + I32 value; + + if (MAXARG < 1) + pid = 0; + else + pid = SvIVx(POPs); +#ifdef BSD_GETPGRP + value = (I32)BSD_GETPGRP(pid); +#else + if (pid != 0 && pid != getpid()) + DIE("POSIX getpgrp can't take an argument"); + value = (I32)getpgrp(); +#endif + XPUSHi(value); + RETURN; +#else + DIE(no_func, "getpgrp()"); +#endif +} + +PP(pp_setpgrp) +{ +#ifdef HAS_SETPGRP + djSP; dTARGET; + int pgrp; + int pid; + if (MAXARG < 2) { + pgrp = 0; + pid = 0; + } + else { + pgrp = POPi; + pid = TOPi; + } + + TAINT_PROPER("setpgrp"); +#ifdef BSD_SETPGRP + SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); +#else + if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid())) + DIE("POSIX setpgrp can't take an argument"); + SETi( setpgrp() >= 0 ); +#endif /* USE_BSDPGRP */ + RETURN; +#else + DIE(no_func, "setpgrp()"); +#endif +} + +PP(pp_getpriority) +{ + djSP; dTARGET; + int which; + int who; +#ifdef HAS_GETPRIORITY + who = POPi; + which = TOPi; + SETi( getpriority(which, who) ); + RETURN; +#else + DIE(no_func, "getpriority()"); +#endif +} + +PP(pp_setpriority) +{ + djSP; dTARGET; + int which; + int who; + int niceval; +#ifdef HAS_SETPRIORITY + niceval = POPi; + who = POPi; + which = TOPi; + TAINT_PROPER("setpriority"); + SETi( setpriority(which, who, niceval) >= 0 ); + RETURN; +#else + DIE(no_func, "setpriority()"); +#endif +} + +/* Time calls. */ + +PP(pp_time) +{ + djSP; dTARGET; +#ifdef BIG_TIME + XPUSHn( time(Null(Time_t*)) ); +#else + XPUSHi( time(Null(Time_t*)) ); +#endif + RETURN; +} + +/* XXX The POSIX name is CLK_TCK; it is to be preferred + to HZ. Probably. For now, assume that if the system + defines HZ, it does so correctly. (Will this break + on VMS?) + Probably we ought to use _sysconf(_SC_CLK_TCK), if + it's supported. --AD 9/96. +*/ + +#ifndef HZ +# ifdef CLK_TCK +# define HZ CLK_TCK +# else +# define HZ 60 +# endif +#endif + +PP(pp_tms) +{ + djSP; + +#ifndef HAS_TIMES + DIE("times not implemented"); +#else + EXTEND(SP, 4); + +#ifndef VMS + (void)PerlProc_times(&PL_timesbuf); +#else + (void)PerlProc_times((tbuffer_t *)&PL_timesbuf); /* time.h uses different name for */ + /* struct tms, though same data */ + /* is returned. */ +#endif + + PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_utime)/HZ))); + if (GIMME == G_ARRAY) { + PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_stime)/HZ))); + PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cutime)/HZ))); + PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cstime)/HZ))); + } + RETURN; +#endif /* HAS_TIMES */ +} + +PP(pp_localtime) +{ + return pp_gmtime(ARGS); +} + +PP(pp_gmtime) +{ + djSP; + Time_t when; + struct tm *tmbuf; + static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; + static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + + if (MAXARG < 1) + (void)time(&when); + else +#ifdef BIG_TIME + when = (Time_t)SvNVx(POPs); +#else + when = (Time_t)SvIVx(POPs); +#endif + + if (PL_op->op_type == OP_LOCALTIME) + tmbuf = localtime(&when); + else + tmbuf = gmtime(&when); + + EXTEND(SP, 9); + EXTEND_MORTAL(9); + if (GIMME != G_ARRAY) { + dTARGET; + SV *tsv; + if (!tmbuf) + RETPUSHUNDEF; + tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d", + dayname[tmbuf->tm_wday], + monname[tmbuf->tm_mon], + tmbuf->tm_mday, + tmbuf->tm_hour, + tmbuf->tm_min, + tmbuf->tm_sec, + tmbuf->tm_year + 1900); + PUSHs(sv_2mortal(tsv)); + } + else if (tmbuf) { + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst))); + } + RETURN; +} + +PP(pp_alarm) +{ + djSP; dTARGET; + int anum; +#ifdef HAS_ALARM + anum = POPi; + anum = alarm((unsigned int)anum); + EXTEND(SP, 1); + if (anum < 0) + RETPUSHUNDEF; + PUSHi((I32)anum); + RETURN; +#else + DIE(no_func, "Unsupported function alarm"); +#endif +} + +PP(pp_sleep) +{ + djSP; dTARGET; + I32 duration; + Time_t lasttime; + Time_t when; + + (void)time(&lasttime); + if (MAXARG < 1) + PerlProc_pause(); + else { + duration = POPi; + PerlProc_sleep((unsigned int)duration); + } + (void)time(&when); + XPUSHi(when - lasttime); + RETURN; +} + +/* Shared memory. */ + +PP(pp_shmget) +{ + return pp_semget(ARGS); +} + +PP(pp_shmctl) +{ + return pp_semctl(ARGS); +} + +PP(pp_shmread) +{ + return pp_shmwrite(ARGS); +} + +PP(pp_shmwrite) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + I32 value = (I32)(do_shmio(PL_op->op_type, MARK, SP) >= 0); + SP = MARK; + PUSHi(value); + RETURN; +#else + return pp_semget(ARGS); +#endif +} + +/* Message passing. */ + +PP(pp_msgget) +{ + return pp_semget(ARGS); +} + +PP(pp_msgctl) +{ + return pp_semctl(ARGS); +} + +PP(pp_msgsnd) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + I32 value = (I32)(do_msgsnd(MARK, SP) >= 0); + SP = MARK; + PUSHi(value); + RETURN; +#else + return pp_semget(ARGS); +#endif +} + +PP(pp_msgrcv) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + I32 value = (I32)(do_msgrcv(MARK, SP) >= 0); + SP = MARK; + PUSHi(value); + RETURN; +#else + return pp_semget(ARGS); +#endif +} + +/* Semaphores. */ + +PP(pp_semget) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + int anum = do_ipcget(PL_op->op_type, MARK, SP); + SP = MARK; + if (anum == -1) + RETPUSHUNDEF; + PUSHi(anum); + RETURN; +#else + DIE("System V IPC is not implemented on this machine"); +#endif +} + +PP(pp_semctl) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + int anum = do_ipcctl(PL_op->op_type, MARK, SP); + SP = MARK; + if (anum == -1) + RETSETUNDEF; + if (anum != 0) { + PUSHi(anum); + } + else { + PUSHp(zero_but_true, ZBTLEN); + } + RETURN; +#else + return pp_semget(ARGS); +#endif +} + +PP(pp_semop) +{ +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + djSP; dMARK; dTARGET; + I32 value = (I32)(do_semop(MARK, SP) >= 0); + SP = MARK; + PUSHi(value); + RETURN; +#else + return pp_semget(ARGS); +#endif +} + +/* Get system info. */ + +PP(pp_ghbyname) +{ +#ifdef HAS_GETHOSTBYNAME + return pp_ghostent(ARGS); +#else + DIE(no_sock_func, "gethostbyname"); +#endif +} + +PP(pp_ghbyaddr) +{ +#ifdef HAS_GETHOSTBYADDR + return pp_ghostent(ARGS); +#else + DIE(no_sock_func, "gethostbyaddr"); +#endif +} + +PP(pp_ghostent) +{ + djSP; +#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT) + I32 which = PL_op->op_type; + register char **elem; + register SV *sv; +#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */ + struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int); + struct hostent *PerlSock_gethostbyname(Netdb_name_t); + struct hostent *PerlSock_gethostent(void); +#endif + struct hostent *hent; + unsigned long len; + + EXTEND(SP, 10); + if (which == OP_GHBYNAME) +#ifdef HAS_GETHOSTBYNAME + hent = PerlSock_gethostbyname(POPp); +#else + DIE(no_sock_func, "gethostbyname"); +#endif + else if (which == OP_GHBYADDR) { +#ifdef HAS_GETHOSTBYADDR + int addrtype = POPi; + SV *addrsv = POPs; + STRLEN addrlen; + Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen); + + hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); +#else + DIE(no_sock_func, "gethostbyaddr"); +#endif + } + else +#ifdef HAS_GETHOSTENT + hent = PerlSock_gethostent(); +#else + DIE(no_sock_func, "gethostent"); +#endif + +#ifdef HOST_NOT_FOUND + if (!hent) + STATUS_NATIVE_SET(h_errno); +#endif + + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (hent) { + if (which == OP_GHBYNAME) { + if (hent->h_addr) + sv_setpvn(sv, hent->h_addr, hent->h_length); + } + else + sv_setpv(sv, (char*)hent->h_name); + } + RETURN; + } + + if (hent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, (char*)hent->h_name); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + for (elem = hent->h_aliases; elem && *elem; elem++) { + sv_catpv(sv, *elem); + if (elem[1]) + sv_catpvn(sv, " ", 1); + } + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)hent->h_addrtype); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + len = hent->h_length; + sv_setiv(sv, (IV)len); +#ifdef h_addr + for (elem = hent->h_addr_list; elem && *elem; elem++) { + XPUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpvn(sv, *elem, len); + } +#else + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + if (hent->h_addr) + sv_setpvn(sv, hent->h_addr, len); +#endif /* h_addr */ + } + RETURN; +#else + DIE(no_sock_func, "gethostent"); +#endif +} + +PP(pp_gnbyname) +{ +#ifdef HAS_GETNETBYNAME + return pp_gnetent(ARGS); +#else + DIE(no_sock_func, "getnetbyname"); +#endif +} + +PP(pp_gnbyaddr) +{ +#ifdef HAS_GETNETBYADDR + return pp_gnetent(ARGS); +#else + DIE(no_sock_func, "getnetbyaddr"); +#endif +} + +PP(pp_gnetent) +{ + djSP; +#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT) + I32 which = PL_op->op_type; + register char **elem; + register SV *sv; +#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */ + struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int); + struct netent *PerlSock_getnetbyname(Netdb_name_t); + struct netent *PerlSock_getnetent(void); +#endif + struct netent *nent; + + if (which == OP_GNBYNAME) +#ifdef HAS_GETNETBYNAME + nent = PerlSock_getnetbyname(POPp); +#else + DIE(no_sock_func, "getnetbyname"); +#endif + else if (which == OP_GNBYADDR) { +#ifdef HAS_GETNETBYADDR + int addrtype = POPi; + Netdb_net_t addr = (Netdb_net_t) U_L(POPn); + nent = PerlSock_getnetbyaddr(addr, addrtype); +#else + DIE(no_sock_func, "getnetbyaddr"); +#endif + } + else +#ifdef HAS_GETNETENT + nent = PerlSock_getnetent(); +#else + DIE(no_sock_func, "getnetent"); +#endif + + EXTEND(SP, 4); + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (nent) { + if (which == OP_GNBYNAME) + sv_setiv(sv, (IV)nent->n_net); + else + sv_setpv(sv, nent->n_name); + } + RETURN; + } + + if (nent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, nent->n_name); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + for (elem = nent->n_aliases; elem && *elem; elem++) { + sv_catpv(sv, *elem); + if (elem[1]) + sv_catpvn(sv, " ", 1); + } + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)nent->n_addrtype); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)nent->n_net); + } + + RETURN; +#else + DIE(no_sock_func, "getnetent"); +#endif +} + +PP(pp_gpbyname) +{ +#ifdef HAS_GETPROTOBYNAME + return pp_gprotoent(ARGS); +#else + DIE(no_sock_func, "getprotobyname"); +#endif +} + +PP(pp_gpbynumber) +{ +#ifdef HAS_GETPROTOBYNUMBER + return pp_gprotoent(ARGS); +#else + DIE(no_sock_func, "getprotobynumber"); +#endif +} + +PP(pp_gprotoent) +{ + djSP; +#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT) + I32 which = PL_op->op_type; + register char **elem; + register SV *sv; +#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */ + struct protoent *PerlSock_getprotobyname(Netdb_name_t); + struct protoent *PerlSock_getprotobynumber(int); + struct protoent *PerlSock_getprotoent(void); +#endif + struct protoent *pent; + + if (which == OP_GPBYNAME) +#ifdef HAS_GETPROTOBYNAME + pent = PerlSock_getprotobyname(POPp); +#else + DIE(no_sock_func, "getprotobyname"); +#endif + else if (which == OP_GPBYNUMBER) +#ifdef HAS_GETPROTOBYNUMBER + pent = PerlSock_getprotobynumber(POPi); +#else + DIE(no_sock_func, "getprotobynumber"); +#endif + else +#ifdef HAS_GETPROTOENT + pent = PerlSock_getprotoent(); +#else + DIE(no_sock_func, "getprotoent"); +#endif + + EXTEND(SP, 3); + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (pent) { + if (which == OP_GPBYNAME) + sv_setiv(sv, (IV)pent->p_proto); + else + sv_setpv(sv, pent->p_name); + } + RETURN; + } + + if (pent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, pent->p_name); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + for (elem = pent->p_aliases; elem && *elem; elem++) { + sv_catpv(sv, *elem); + if (elem[1]) + sv_catpvn(sv, " ", 1); + } + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)pent->p_proto); + } + + RETURN; +#else + DIE(no_sock_func, "getprotoent"); +#endif +} + +PP(pp_gsbyname) +{ +#ifdef HAS_GETSERVBYNAME + return pp_gservent(ARGS); +#else + DIE(no_sock_func, "getservbyname"); +#endif +} + +PP(pp_gsbyport) +{ +#ifdef HAS_GETSERVBYPORT + return pp_gservent(ARGS); +#else + DIE(no_sock_func, "getservbyport"); +#endif +} + +PP(pp_gservent) +{ + djSP; +#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT) + I32 which = PL_op->op_type; + register char **elem; + register SV *sv; +#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */ + struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t); + struct servent *PerlSock_getservbyport(int, Netdb_name_t); + struct servent *PerlSock_getservent(void); +#endif + struct servent *sent; + + if (which == OP_GSBYNAME) { +#ifdef HAS_GETSERVBYNAME + char *proto = POPp; + char *name = POPp; + + if (proto && !*proto) + proto = Nullch; + + sent = PerlSock_getservbyname(name, proto); +#else + DIE(no_sock_func, "getservbyname"); +#endif + } + else if (which == OP_GSBYPORT) { +#ifdef HAS_GETSERVBYPORT + char *proto = POPp; + unsigned short port = POPu; + +#ifdef HAS_HTONS + port = PerlSock_htons(port); +#endif + sent = PerlSock_getservbyport(port, proto); +#else + DIE(no_sock_func, "getservbyport"); +#endif + } + else +#ifdef HAS_GETSERVENT + sent = PerlSock_getservent(); +#else + DIE(no_sock_func, "getservent"); +#endif + + EXTEND(SP, 4); + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (sent) { + if (which == OP_GSBYNAME) { +#ifdef HAS_NTOHS + sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); +#else + sv_setiv(sv, (IV)(sent->s_port)); +#endif + } + else + sv_setpv(sv, sent->s_name); + } + RETURN; + } + + if (sent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, sent->s_name); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + for (elem = sent->s_aliases; elem && *elem; elem++) { + sv_catpv(sv, *elem); + if (elem[1]) + sv_catpvn(sv, " ", 1); + } + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef HAS_NTOHS + sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); +#else + sv_setiv(sv, (IV)(sent->s_port)); +#endif + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, sent->s_proto); + } + + RETURN; +#else + DIE(no_sock_func, "getservent"); +#endif +} + +PP(pp_shostent) +{ + djSP; +#ifdef HAS_SETHOSTENT + PerlSock_sethostent(TOPi); + RETSETYES; +#else + DIE(no_sock_func, "sethostent"); +#endif +} + +PP(pp_snetent) +{ + djSP; +#ifdef HAS_SETNETENT + PerlSock_setnetent(TOPi); + RETSETYES; +#else + DIE(no_sock_func, "setnetent"); +#endif +} + +PP(pp_sprotoent) +{ + djSP; +#ifdef HAS_SETPROTOENT + PerlSock_setprotoent(TOPi); + RETSETYES; +#else + DIE(no_sock_func, "setprotoent"); +#endif +} + +PP(pp_sservent) +{ + djSP; +#ifdef HAS_SETSERVENT + PerlSock_setservent(TOPi); + RETSETYES; +#else + DIE(no_sock_func, "setservent"); +#endif +} + +PP(pp_ehostent) +{ + djSP; +#ifdef HAS_ENDHOSTENT + PerlSock_endhostent(); + EXTEND(SP,1); + RETPUSHYES; +#else + DIE(no_sock_func, "endhostent"); +#endif +} + +PP(pp_enetent) +{ + djSP; +#ifdef HAS_ENDNETENT + PerlSock_endnetent(); + EXTEND(SP,1); + RETPUSHYES; +#else + DIE(no_sock_func, "endnetent"); +#endif +} + +PP(pp_eprotoent) +{ + djSP; +#ifdef HAS_ENDPROTOENT + PerlSock_endprotoent(); + EXTEND(SP,1); + RETPUSHYES; +#else + DIE(no_sock_func, "endprotoent"); +#endif +} + +PP(pp_eservent) +{ + djSP; +#ifdef HAS_ENDSERVENT + PerlSock_endservent(); + EXTEND(SP,1); + RETPUSHYES; +#else + DIE(no_sock_func, "endservent"); +#endif +} + +PP(pp_gpwnam) +{ +#ifdef HAS_PASSWD + return pp_gpwent(ARGS); +#else + DIE(no_func, "getpwnam"); +#endif +} + +PP(pp_gpwuid) +{ +#ifdef HAS_PASSWD + return pp_gpwent(ARGS); +#else + DIE(no_func, "getpwuid"); +#endif +} + +PP(pp_gpwent) +{ + djSP; +#if defined(HAS_PASSWD) && defined(HAS_GETPWENT) + I32 which = PL_op->op_type; + register SV *sv; + struct passwd *pwent; + + if (which == OP_GPWNAM) + pwent = getpwnam(POPp); + else if (which == OP_GPWUID) + pwent = getpwuid(POPi); + else + pwent = (struct passwd *)getpwent(); + + EXTEND(SP, 10); + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (pwent) { + if (which == OP_GPWNAM) + sv_setiv(sv, (IV)pwent->pw_uid); + else + sv_setpv(sv, pwent->pw_name); + } + RETURN; + } + + if (pwent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, pwent->pw_name); + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef PWPASSWD + sv_setpv(sv, pwent->pw_passwd); +#endif + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)pwent->pw_uid); + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)pwent->pw_gid); + + /* pw_change, pw_quota, and pw_age are mutually exclusive. */ + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef PWCHANGE + sv_setiv(sv, (IV)pwent->pw_change); +#else +# ifdef PWQUOTA + sv_setiv(sv, (IV)pwent->pw_quota); +# else +# ifdef PWAGE + sv_setpv(sv, pwent->pw_age); +# endif +# endif +#endif + + /* pw_class and pw_comment are mutually exclusive. */ + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef PWCLASS + sv_setpv(sv, pwent->pw_class); +#else +# ifdef PWCOMMENT + sv_setpv(sv, pwent->pw_comment); +# endif +#endif + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef PWGECOS + sv_setpv(sv, pwent->pw_gecos); +#endif +#ifndef INCOMPLETE_TAINTS + /* pw_gecos is tainted because user himself can diddle with it. */ + SvTAINTED_on(sv); +#endif + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, pwent->pw_dir); + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, pwent->pw_shell); + +#ifdef PWEXPIRE + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)pwent->pw_expire); +#endif + } + RETURN; +#else + DIE(no_func, "getpwent"); +#endif +} + +PP(pp_spwent) +{ + djSP; +#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32) + setpwent(); + RETPUSHYES; +#else + DIE(no_func, "setpwent"); +#endif +} + +PP(pp_epwent) +{ + djSP; +#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) + endpwent(); + RETPUSHYES; +#else + DIE(no_func, "endpwent"); +#endif +} + +PP(pp_ggrnam) +{ +#ifdef HAS_GROUP + return pp_ggrent(ARGS); +#else + DIE(no_func, "getgrnam"); +#endif +} + +PP(pp_ggrgid) +{ +#ifdef HAS_GROUP + return pp_ggrent(ARGS); +#else + DIE(no_func, "getgrgid"); +#endif +} + +PP(pp_ggrent) +{ + djSP; +#if defined(HAS_GROUP) && defined(HAS_GETGRENT) + I32 which = PL_op->op_type; + register char **elem; + register SV *sv; + struct group *grent; + + if (which == OP_GGRNAM) + grent = (struct group *)getgrnam(POPp); + else if (which == OP_GGRGID) + grent = (struct group *)getgrgid(POPi); + else + grent = (struct group *)getgrent(); + + EXTEND(SP, 4); + if (GIMME != G_ARRAY) { + PUSHs(sv = sv_newmortal()); + if (grent) { + if (which == OP_GGRNAM) + sv_setiv(sv, (IV)grent->gr_gid); + else + sv_setpv(sv, grent->gr_name); + } + RETURN; + } + + if (grent) { + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setpv(sv, grent->gr_name); + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +#ifdef GRPASSWD + sv_setpv(sv, grent->gr_passwd); +#endif + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + sv_setiv(sv, (IV)grent->gr_gid); + + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + for (elem = grent->gr_mem; elem && *elem; elem++) { + sv_catpv(sv, *elem); + if (elem[1]) + sv_catpvn(sv, " ", 1); + } + } + + RETURN; +#else + DIE(no_func, "getgrent"); +#endif +} + +PP(pp_sgrent) +{ + djSP; +#if defined(HAS_GROUP) && defined(HAS_SETGRENT) + setgrent(); + RETPUSHYES; +#else + DIE(no_func, "setgrent"); +#endif +} + +PP(pp_egrent) +{ + djSP; +#if defined(HAS_GROUP) && defined(HAS_ENDGRENT) + endgrent(); + RETPUSHYES; +#else + DIE(no_func, "endgrent"); +#endif +} + +PP(pp_getlogin) +{ + djSP; dTARGET; +#ifdef HAS_GETLOGIN + char *tmps; + EXTEND(SP, 1); + if (!(tmps = PerlProc_getlogin())) + RETPUSHUNDEF; + PUSHp(tmps, strlen(tmps)); + RETURN; +#else + DIE(no_func, "getlogin"); +#endif +} + +/* Miscellaneous. */ + +PP(pp_syscall) +{ +#ifdef HAS_SYSCALL + djSP; dMARK; dORIGMARK; dTARGET; + register I32 items = SP - MARK; + unsigned long a[20]; + register I32 i = 0; + I32 retval = -1; + MAGIC *mg; + + if (PL_tainting) { + while (++MARK <= SP) { + if (SvTAINTED(*MARK)) { + TAINT; + break; + } + } + MARK = ORIGMARK; + TAINT_PROPER("syscall"); + } + + /* This probably won't work on machines where sizeof(long) != sizeof(int) + * or where sizeof(long) != sizeof(char*). But such machines will + * not likely have syscall implemented either, so who cares? + */ + while (++MARK <= SP) { + if (SvNIOK(*MARK) || !i) + a[i++] = SvIV(*MARK); + else if (*MARK == &PL_sv_undef) + a[i++] = 0; + else + a[i++] = (unsigned long)SvPV_force(*MARK, PL_na); + if (i > 15) + break; + } + switch (items) { + default: + DIE("Too many args to syscall"); + case 0: + DIE("Too few args to syscall"); + case 1: + retval = syscall(a[0]); + break; + case 2: + retval = syscall(a[0],a[1]); + break; + case 3: + retval = syscall(a[0],a[1],a[2]); + break; + case 4: + retval = syscall(a[0],a[1],a[2],a[3]); + break; + case 5: + retval = syscall(a[0],a[1],a[2],a[3],a[4]); + break; + case 6: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]); + break; + case 7: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]); + break; + case 8: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]); + break; +#ifdef atarist + case 9: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]); + break; + case 10: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]); + break; + case 11: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9], + a[10]); + break; + case 12: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9], + a[10],a[11]); + break; + case 13: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9], + a[10],a[11],a[12]); + break; + case 14: + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9], + a[10],a[11],a[12],a[13]); + break; +#endif /* atarist */ + } + SP = ORIGMARK; + PUSHi(retval); + RETURN; +#else + DIE(no_func, "syscall"); +#endif +} + +#ifdef FCNTL_EMULATE_FLOCK + +/* XXX Emulate flock() with fcntl(). + What's really needed is a good file locking module. +*/ + +static int +fcntl_emulate_flock(int fd, int operation) +{ + struct flock flock; + + switch (operation & ~LOCK_NB) { + case LOCK_SH: + flock.l_type = F_RDLCK; + break; + case LOCK_EX: + flock.l_type = F_WRLCK; + break; + case LOCK_UN: + flock.l_type = F_UNLCK; + break; + default: + errno = EINVAL; + return -1; + } + flock.l_whence = SEEK_SET; + flock.l_start = flock.l_len = 0L; + + return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock); +} + +#endif /* FCNTL_EMULATE_FLOCK */ + +#ifdef LOCKF_EMULATE_FLOCK + +/* XXX Emulate flock() with lockf(). This is just to increase + portability of scripts. The calls are not completely + interchangeable. What's really needed is a good file + locking module. +*/ + +/* The lockf() constants might have been defined in . + Unfortunately, causes troubles on some mixed + (BSD/POSIX) systems, such as SunOS 4.1.3. + + Further, the lockf() constants aren't POSIX, so they might not be + visible if we're compiling with _POSIX_SOURCE defined. Thus, we'll + just stick in the SVID values and be done with it. Sigh. +*/ + +# ifndef F_ULOCK +# define F_ULOCK 0 /* Unlock a previously locked region */ +# endif +# ifndef F_LOCK +# define F_LOCK 1 /* Lock a region for exclusive use */ +# endif +# ifndef F_TLOCK +# define F_TLOCK 2 /* Test and lock a region for exclusive use */ +# endif +# ifndef F_TEST +# define F_TEST 3 /* Test a region for other processes locks */ +# endif + +static int +lockf_emulate_flock (fd, operation) +int fd; +int operation; +{ + int i; + int save_errno; + Off_t pos; + + /* flock locks entire file so for lockf we need to do the same */ + save_errno = errno; + pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */ + if (pos > 0) /* is seekable and needs to be repositioned */ + if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0) + pos = -1; /* seek failed, so don't seek back afterwards */ + errno = save_errno; + + switch (operation) { + + /* LOCK_SH - get a shared lock */ + case LOCK_SH: + /* LOCK_EX - get an exclusive lock */ + case LOCK_EX: + i = lockf (fd, F_LOCK, 0); + break; + + /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */ + case LOCK_SH|LOCK_NB: + /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */ + case LOCK_EX|LOCK_NB: + i = lockf (fd, F_TLOCK, 0); + if (i == -1) + if ((errno == EAGAIN) || (errno == EACCES)) + errno = EWOULDBLOCK; + break; + + /* LOCK_UN - unlock (non-blocking is a no-op) */ + case LOCK_UN: + case LOCK_UN|LOCK_NB: + i = lockf (fd, F_ULOCK, 0); + break; + + /* Default - can't decipher operation */ + default: + i = -1; + errno = EINVAL; + break; + } + + if (pos > 0) /* need to restore position of the handle */ + PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */ + + return (i); +} + +#endif /* LOCKF_EMULATE_FLOCK */ diff --git a/contrib/perl5/proto.h b/contrib/perl5/proto.h new file mode 100644 index 00000000000..1b9867552d0 --- /dev/null +++ b/contrib/perl5/proto.h @@ -0,0 +1,902 @@ +#ifndef PERL_CALLCONV +# define PERL_CALLCONV +#endif + +#ifdef PERL_OBJECT +#define VIRTUAL virtual PERL_CALLCONV +#else +#define VIRTUAL PERL_CALLCONV +START_EXTERN_C +#endif + +/* NOTE!!! When new virtual functions are added, they must be added at + * the end of this file to maintain binary compatibility with PERL_OBJECT + */ + + +#ifndef NEXT30_NO_ATTRIBUTE +#ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ +#ifdef __attribute__ /* Avoid possible redefinition errors */ +#undef __attribute__ +#endif +#define __attribute__(attr) +#endif +#endif +#ifdef OVERLOAD +VIRTUAL SV* amagic_call _((SV* left,SV* right,int method,int dir)); +VIRTUAL bool Gv_AMupdate _((HV* stash)); +#endif /* OVERLOAD */ +VIRTUAL OP* append_elem _((I32 optype, OP* head, OP* tail)); +VIRTUAL OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); +VIRTUAL I32 apply _((I32 type, SV** mark, SV** sp)); +VIRTUAL void assertref _((OP* o)); +VIRTUAL bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); +VIRTUAL SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); +VIRTUAL HE* avhv_iternext _((AV *ar)); +VIRTUAL SV* avhv_iterval _((AV *ar, HE* entry)); +VIRTUAL HV* avhv_keys _((AV *ar)); +VIRTUAL void av_clear _((AV* ar)); +VIRTUAL void av_extend _((AV* ar, I32 key)); +VIRTUAL AV* av_fake _((I32 size, SV** svp)); +VIRTUAL SV** av_fetch _((AV* ar, I32 key, I32 lval)); +VIRTUAL void av_fill _((AV* ar, I32 fill)); +VIRTUAL I32 av_len _((AV* ar)); +VIRTUAL AV* av_make _((I32 size, SV** svp)); +VIRTUAL SV* av_pop _((AV* ar)); +VIRTUAL void av_push _((AV* ar, SV* val)); +VIRTUAL void av_reify _((AV* ar)); +VIRTUAL SV* av_shift _((AV* ar)); +VIRTUAL SV** av_store _((AV* ar, I32 key, SV* val)); +VIRTUAL void av_undef _((AV* ar)); +VIRTUAL void av_unshift _((AV* ar, I32 num)); +VIRTUAL OP* bind_match _((I32 type, OP* left, OP* pat)); +VIRTUAL OP* block_end _((I32 floor, OP* seq)); +VIRTUAL I32 block_gimme _((void)); +VIRTUAL int block_start _((int full)); +VIRTUAL void boot_core_UNIVERSAL _((void)); +VIRTUAL void call_list _((I32 oldscope, AV* av_list)); +VIRTUAL I32 cando _((I32 bit, I32 effective, Stat_t* statbufp)); +#ifndef CASTNEGFLOAT +VIRTUAL U32 cast_ulong _((double f)); +#endif +#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) +VIRTUAL I32 my_chsize _((int fd, Off_t length)); +#endif +VIRTUAL OP* ck_gvconst _((OP* o)); +VIRTUAL OP* ck_retarget _((OP* o)); +#ifdef USE_THREADS +VIRTUAL MAGIC * condpair_magic _((SV *sv)); +#endif +VIRTUAL OP* convert _((I32 optype, I32 flags, OP* o)); +VIRTUAL void croak _((const char* pat,...)) __attribute__((noreturn)); +VIRTUAL void cv_ckproto _((CV* cv, GV* gv, char* p)); +VIRTUAL CV* cv_clone _((CV* proto)); +VIRTUAL SV* cv_const_sv _((CV* cv)); +VIRTUAL SV* op_const_sv _((OP* o, CV* cv)); +VIRTUAL void cv_undef _((CV* cv)); +VIRTUAL void cx_dump _((PERL_CONTEXT* cs)); +VIRTUAL SV* filter_add _((filter_t funcp, SV* datasv)); +VIRTUAL void filter_del _((filter_t funcp)); +VIRTUAL I32 filter_read _((int idx, SV* buffer, int maxlen)); +VIRTUAL char ** get_op_descs _((void)); +VIRTUAL char ** get_op_names _((void)); +VIRTUAL char * get_no_modify _((void)); +VIRTUAL U32 * get_opargs _((void)); +VIRTUAL I32 cxinc _((void)); +VIRTUAL void deb _((const char* pat,...)); +VIRTUAL void deb_growlevel _((void)); +VIRTUAL void debprofdump _((void)); +VIRTUAL I32 debop _((OP* o)); +VIRTUAL I32 debstack _((void)); +VIRTUAL I32 debstackptrs _((void)); +VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend, + int delim, I32* retlen)); +VIRTUAL void deprecate _((char* s)); +VIRTUAL OP* die _((const char* pat,...)); +VIRTUAL OP* die_where _((char* message)); +VIRTUAL void dounwind _((I32 cxix)); +VIRTUAL bool do_aexec _((SV* really, SV** mark, SV** sp)); +VIRTUAL int do_binmode _((PerlIO *fp, int iotype, int flag)); +VIRTUAL void do_chop _((SV* asv, SV* sv)); +VIRTUAL bool do_close _((GV* gv, bool not_implicit)); +VIRTUAL bool do_eof _((GV* gv)); +VIRTUAL bool do_exec _((char* cmd)); +VIRTUAL void do_execfree _((void)); +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +I32 do_ipcctl _((I32 optype, SV** mark, SV** sp)); +I32 do_ipcget _((I32 optype, SV** mark, SV** sp)); +#endif +VIRTUAL void do_join _((SV* sv, SV* del, SV** mark, SV** sp)); +VIRTUAL OP* do_kv _((ARGSproto)); +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +I32 do_msgrcv _((SV** mark, SV** sp)); +I32 do_msgsnd _((SV** mark, SV** sp)); +#endif +VIRTUAL bool do_open _((GV* gv, char* name, I32 len, + int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp)); +VIRTUAL void do_pipe _((SV* sv, GV* rgv, GV* wgv)); +VIRTUAL bool do_print _((SV* sv, PerlIO* fp)); +VIRTUAL OP* do_readline _((void)); +VIRTUAL I32 do_chomp _((SV* sv)); +VIRTUAL bool do_seek _((GV* gv, long pos, int whence)); +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +I32 do_semop _((SV** mark, SV** sp)); +I32 do_shmio _((I32 optype, SV** mark, SV** sp)); +#endif +VIRTUAL void do_sprintf _((SV* sv, I32 len, SV** sarg)); +VIRTUAL long do_sysseek _((GV* gv, long pos, int whence)); +VIRTUAL long do_tell _((GV* gv)); +VIRTUAL I32 do_trans _((SV* sv, OP* arg)); +VIRTUAL void do_vecset _((SV* sv)); +VIRTUAL void do_vop _((I32 optype, SV* sv, SV* left, SV* right)); +VIRTUAL I32 dowantarray _((void)); +VIRTUAL void dump_all _((void)); +VIRTUAL void dump_eval _((void)); +#ifdef DUMP_FDS /* See util.c */ +VIRTUAL void dump_fds _((char* s)); +#endif +VIRTUAL void dump_form _((GV* gv)); +VIRTUAL void dump_gv _((GV* gv)); +#ifdef MYMALLOC +VIRTUAL void dump_mstats _((char* s)); +#endif +VIRTUAL void dump_op _((OP* arg)); +VIRTUAL void dump_pm _((PMOP* pm)); +VIRTUAL void dump_packsubs _((HV* stash)); +VIRTUAL void dump_sub _((GV* gv)); +VIRTUAL void fbm_compile _((SV* sv, U32 flags)); +VIRTUAL char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags)); +VIRTUAL char* find_script _((char *scriptname, bool dosearch, char **search_ext, I32 flags)); +#ifdef USE_THREADS +VIRTUAL PADOFFSET find_threadsv _((char *name)); +#endif +VIRTUAL OP* force_list _((OP* arg)); +VIRTUAL OP* fold_constants _((OP* arg)); +VIRTUAL char* form _((const char* pat, ...)); +VIRTUAL void free_tmps _((void)); +VIRTUAL OP* gen_constant_list _((OP* o)); +VIRTUAL void gp_free _((GV* gv)); +VIRTUAL GP* gp_ref _((GP* gp)); +VIRTUAL GV* gv_AVadd _((GV* gv)); +VIRTUAL GV* gv_HVadd _((GV* gv)); +VIRTUAL GV* gv_IOadd _((GV* gv)); +VIRTUAL GV* gv_autoload4 _((HV* stash, char* name, STRLEN len, I32 method)); +VIRTUAL void gv_check _((HV* stash)); +VIRTUAL void gv_efullname _((SV* sv, GV* gv)); +VIRTUAL void gv_efullname3 _((SV* sv, GV* gv, char* prefix)); +VIRTUAL GV* gv_fetchfile _((char* name)); +VIRTUAL GV* gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level)); +VIRTUAL GV* gv_fetchmethod _((HV* stash, char* name)); +VIRTUAL GV* gv_fetchmethod_autoload _((HV* stash, char* name, I32 autoload)); +VIRTUAL GV* gv_fetchpv _((char* name, I32 add, I32 sv_type)); +VIRTUAL void gv_fullname _((SV* sv, GV* gv)); +VIRTUAL void gv_fullname3 _((SV* sv, GV* gv, char* prefix)); +VIRTUAL void gv_init _((GV* gv, HV* stash, char* name, STRLEN len, int multi)); +VIRTUAL HV* gv_stashpv _((char* name, I32 create)); +VIRTUAL HV* gv_stashpvn _((char* name, U32 namelen, I32 create)); +VIRTUAL HV* gv_stashsv _((SV* sv, I32 create)); +VIRTUAL void hv_clear _((HV* tb)); +VIRTUAL void hv_delayfree_ent _((HV* hv, HE* entry)); +VIRTUAL SV* hv_delete _((HV* tb, char* key, U32 klen, I32 flags)); +VIRTUAL SV* hv_delete_ent _((HV* tb, SV* key, I32 flags, U32 hash)); +VIRTUAL bool hv_exists _((HV* tb, char* key, U32 klen)); +VIRTUAL bool hv_exists_ent _((HV* tb, SV* key, U32 hash)); +VIRTUAL SV** hv_fetch _((HV* tb, char* key, U32 klen, I32 lval)); +VIRTUAL HE* hv_fetch_ent _((HV* tb, SV* key, I32 lval, U32 hash)); +VIRTUAL void hv_free_ent _((HV* hv, HE* entry)); +VIRTUAL I32 hv_iterinit _((HV* tb)); +VIRTUAL char* hv_iterkey _((HE* entry, I32* retlen)); +VIRTUAL SV* hv_iterkeysv _((HE* entry)); +VIRTUAL HE* hv_iternext _((HV* tb)); +VIRTUAL SV* hv_iternextsv _((HV* hv, char** key, I32* retlen)); +VIRTUAL SV* hv_iterval _((HV* tb, HE* entry)); +VIRTUAL void hv_ksplit _((HV* hv, IV newmax)); +VIRTUAL void hv_magic _((HV* hv, GV* gv, int how)); +VIRTUAL SV** hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash)); +VIRTUAL HE* hv_store_ent _((HV* tb, SV* key, SV* val, U32 hash)); +VIRTUAL void hv_undef _((HV* tb)); +VIRTUAL I32 ibcmp _((char* a, char* b, I32 len)); +VIRTUAL I32 ibcmp_locale _((char* a, char* b, I32 len)); +VIRTUAL I32 ingroup _((I32 testgid, I32 effective)); +VIRTUAL void init_stacks _((ARGSproto)); +VIRTUAL U32 intro_my _((void)); +VIRTUAL char* instr _((char* big, char* little)); +VIRTUAL bool io_close _((IO* io)); +VIRTUAL OP* invert _((OP* cmd)); +VIRTUAL OP* jmaybe _((OP* arg)); +VIRTUAL I32 keyword _((char* d, I32 len)); +VIRTUAL void leave_scope _((I32 base)); +VIRTUAL void lex_end _((void)); +VIRTUAL void lex_start _((SV* line)); +VIRTUAL OP* linklist _((OP* o)); +VIRTUAL OP* list _((OP* o)); +VIRTUAL OP* listkids _((OP* o)); +VIRTUAL OP* localize _((OP* arg, I32 lexical)); +VIRTUAL I32 looks_like_number _((SV* sv)); +VIRTUAL int magic_clearenv _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clear_all_env _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clearpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_clearsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_existspack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_freeregexp _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_get _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getarylen _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getdefelem _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getnkeys _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getpos _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getsubstr _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_gettaint _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getuvar _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_getvec _((SV* sv, MAGIC* mg)); +VIRTUAL U32 magic_len _((SV* sv, MAGIC* mg)); +#ifdef USE_THREADS +VIRTUAL int magic_mutexfree _((SV* sv, MAGIC* mg)); +#endif /* USE_THREADS */ +VIRTUAL int magic_nextpack _((SV* sv, MAGIC* mg, SV* key)); +VIRTUAL int magic_set _((SV* sv, MAGIC* mg)); +#ifdef OVERLOAD +VIRTUAL int magic_setamagic _((SV* sv, MAGIC* mg)); +#endif /* OVERLOAD */ +VIRTUAL int magic_setarylen _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setbm _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setdbline _((SV* sv, MAGIC* mg)); +#ifdef USE_LOCALE_COLLATE +VIRTUAL int magic_setcollxfrm _((SV* sv, MAGIC* mg)); +#endif +VIRTUAL int magic_setdefelem _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setenv _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setfm _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setisa _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setmglob _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setnkeys _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setpack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setpos _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setsig _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setsubstr _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_settaint _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setuvar _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_setvec _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_set_all_env _((SV* sv, MAGIC* mg)); +VIRTUAL U32 magic_sizepack _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_wipepack _((SV* sv, MAGIC* mg)); +VIRTUAL void magicname _((char* sym, char* name, I32 namlen)); +int main _((int argc, char** argv, char** env)); +#ifdef MYMALLOC +VIRTUAL MEM_SIZE malloced_size _((void *p)); +#endif +VIRTUAL void markstack_grow _((void)); +#ifdef USE_LOCALE_COLLATE +VIRTUAL char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen)); +#endif +VIRTUAL char* mess _((const char* pat, va_list* args)); +VIRTUAL int mg_clear _((SV* sv)); +VIRTUAL int mg_copy _((SV* sv, SV* nsv, char* key, I32 klen)); +VIRTUAL MAGIC* mg_find _((SV* sv, int type)); +VIRTUAL int mg_free _((SV* sv)); +VIRTUAL int mg_get _((SV* sv)); +VIRTUAL U32 mg_length _((SV* sv)); +VIRTUAL void mg_magical _((SV* sv)); +VIRTUAL int mg_set _((SV* sv)); +VIRTUAL I32 mg_size _((SV* sv)); +VIRTUAL OP* mod _((OP* o, I32 type)); +VIRTUAL char* moreswitches _((char* s)); +VIRTUAL OP* my _((OP* o)); +#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) +VIRTUAL char* my_bcopy _((char* from, char* to, I32 len)); +#endif +#if !defined(HAS_BZERO) && !defined(HAS_MEMSET) +char* my_bzero _((char* loc, I32 len)); +#endif +VIRTUAL void my_exit _((U32 status)) __attribute__((noreturn)); +VIRTUAL void my_failure_exit _((void)) __attribute__((noreturn)); +VIRTUAL I32 my_lstat _((ARGSproto)); +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) +VIRTUAL I32 my_memcmp _((char* s1, char* s2, I32 len)); +#endif +#if !defined(HAS_MEMSET) +VIRTUAL void* my_memset _((char* loc, I32 ch, I32 len)); +#endif +#ifndef PERL_OBJECT +VIRTUAL I32 my_pclose _((PerlIO* ptr)); +VIRTUAL PerlIO* my_popen _((char* cmd, char* mode)); +#endif +VIRTUAL void my_setenv _((char* nam, char* val)); +VIRTUAL I32 my_stat _((ARGSproto)); +#ifdef MYSWAP +VIRTUAL short my_swap _((short s)); +VIRTUAL long my_htonl _((long l)); +VIRTUAL long my_ntohl _((long l)); +#endif +VIRTUAL void my_unexec _((void)); +VIRTUAL OP* newANONLIST _((OP* o)); +VIRTUAL OP* newANONHASH _((OP* o)); +VIRTUAL OP* newANONSUB _((I32 floor, OP* proto, OP* block)); +VIRTUAL OP* newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right)); +VIRTUAL OP* newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop)); +VIRTUAL void newCONSTSUB _((HV* stash, char* name, SV* sv)); +VIRTUAL void newFORM _((I32 floor, OP* o, OP* block)); +VIRTUAL OP* newFOROP _((I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont)); +VIRTUAL OP* newLOGOP _((I32 optype, I32 flags, OP* left, OP* right)); +VIRTUAL OP* newLOOPEX _((I32 type, OP* label)); +VIRTUAL OP* newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block)); +VIRTUAL OP* newNULLLIST _((void)); +VIRTUAL OP* newOP _((I32 optype, I32 flags)); +VIRTUAL void newPROG _((OP* o)); +VIRTUAL OP* newRANGE _((I32 flags, OP* left, OP* right)); +VIRTUAL OP* newSLICEOP _((I32 flags, OP* subscript, OP* list)); +VIRTUAL OP* newSTATEOP _((I32 flags, char* label, OP* o)); +VIRTUAL CV* newSUB _((I32 floor, OP* o, OP* proto, OP* block)); +VIRTUAL CV* newXS _((char* name, void (*subaddr)(CV* cv _CPERLproto), char* filename)); +VIRTUAL AV* newAV _((void)); +VIRTUAL OP* newAVREF _((OP* o)); +VIRTUAL OP* newBINOP _((I32 type, I32 flags, OP* first, OP* last)); +VIRTUAL OP* newCVREF _((I32 flags, OP* o)); +VIRTUAL OP* newGVOP _((I32 type, I32 flags, GV* gv)); +VIRTUAL GV* newGVgen _((char* pack)); +VIRTUAL OP* newGVREF _((I32 type, OP* o)); +VIRTUAL OP* newHVREF _((OP* o)); +VIRTUAL HV* newHV _((void)); +VIRTUAL HV* newHVhv _((HV* hv)); +VIRTUAL IO* newIO _((void)); +VIRTUAL OP* newLISTOP _((I32 type, I32 flags, OP* first, OP* last)); +VIRTUAL OP* newPMOP _((I32 type, I32 flags)); +VIRTUAL OP* newPVOP _((I32 type, I32 flags, char* pv)); +VIRTUAL SV* newRV _((SV* pref)); +VIRTUAL SV* newRV_noinc _((SV *sv)); +VIRTUAL SV* newSV _((STRLEN len)); +VIRTUAL OP* newSVREF _((OP* o)); +VIRTUAL OP* newSVOP _((I32 type, I32 flags, SV* sv)); +VIRTUAL SV* newSViv _((IV i)); +VIRTUAL SV* newSVnv _((double n)); +VIRTUAL SV* newSVpv _((char* s, STRLEN len)); +VIRTUAL SV* newSVpvn _((char *s, STRLEN len)); +VIRTUAL SV* newSVpvf _((const char* pat, ...)); +VIRTUAL SV* newSVrv _((SV* rv, char* classname)); +VIRTUAL SV* newSVsv _((SV* old)); +VIRTUAL OP* newUNOP _((I32 type, I32 flags, OP* first)); +VIRTUAL OP* newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop, + I32 whileline, OP* expr, OP* block, OP* cont)); +#ifdef USE_THREADS +VIRTUAL struct perl_thread * new_struct_thread _((struct perl_thread *t)); +#endif +VIRTUAL PERL_SI * new_stackinfo _((I32 stitems, I32 cxitems)); +VIRTUAL PerlIO* nextargv _((GV* gv)); +VIRTUAL char* ninstr _((char* big, char* bigend, char* little, char* lend)); +VIRTUAL OP* oopsCV _((OP* o)); +VIRTUAL void op_free _((OP* arg)); +VIRTUAL void package _((OP* o)); +VIRTUAL PADOFFSET pad_alloc _((I32 optype, U32 tmptype)); +VIRTUAL PADOFFSET pad_allocmy _((char* name)); +VIRTUAL PADOFFSET pad_findmy _((char* name)); +VIRTUAL OP* oopsAV _((OP* o)); +VIRTUAL OP* oopsHV _((OP* o)); +VIRTUAL void pad_leavemy _((I32 fill)); +VIRTUAL SV* pad_sv _((PADOFFSET po)); +VIRTUAL void pad_free _((PADOFFSET po)); +VIRTUAL void pad_reset _((void)); +VIRTUAL void pad_swipe _((PADOFFSET po)); +VIRTUAL void peep _((OP* o)); +#ifndef PERL_OBJECT +PerlInterpreter* perl_alloc _((void)); +#endif +#ifdef PERL_OBJECT +VIRTUAL void perl_atexit _((void(*fn)(CPerlObj *, void *), void* ptr)); +#else +void perl_atexit _((void(*fn)(void *), void*)); +#endif +VIRTUAL I32 perl_call_argv _((char* sub_name, I32 flags, char** argv)); +VIRTUAL I32 perl_call_method _((char* methname, I32 flags)); +VIRTUAL I32 perl_call_pv _((char* sub_name, I32 flags)); +VIRTUAL I32 perl_call_sv _((SV* sv, I32 flags)); +#ifdef PERL_OBJECT +VIRTUAL void perl_construct _((void)); +VIRTUAL void perl_destruct _((void)); +#else +void perl_construct _((PerlInterpreter* sv_interp)); +void perl_destruct _((PerlInterpreter* sv_interp)); +#endif +VIRTUAL SV* perl_eval_pv _((char* p, I32 croak_on_error)); +VIRTUAL I32 perl_eval_sv _((SV* sv, I32 flags)); +#ifdef PERL_OBJECT +VIRTUAL void perl_free _((void)); +#else +void perl_free _((PerlInterpreter* sv_interp)); +#endif +VIRTUAL SV* perl_get_sv _((char* name, I32 create)); +VIRTUAL AV* perl_get_av _((char* name, I32 create)); +VIRTUAL HV* perl_get_hv _((char* name, I32 create)); +VIRTUAL CV* perl_get_cv _((char* name, I32 create)); +VIRTUAL int perl_init_i18nl10n _((int printwarn)); +VIRTUAL int perl_init_i18nl14n _((int printwarn)); +VIRTUAL void perl_new_collate _((char* newcoll)); +VIRTUAL void perl_new_ctype _((char* newctype)); +VIRTUAL void perl_new_numeric _((char* newcoll)); +VIRTUAL void perl_set_numeric_local _((void)); +VIRTUAL void perl_set_numeric_standard _((void)); +#ifdef PERL_OBJECT +VIRTUAL int perl_parse _((void(*xsinit)(CPerlObj*), int argc, char** argv, char** env)); +#else +int perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env)); +#endif +VIRTUAL void perl_require_pv _((char* pv)); +#define perl_requirepv perl_require_pv +#ifdef PERL_OBJECT +VIRTUAL int perl_run _((void)); +#else +int perl_run _((PerlInterpreter* sv_interp)); +#endif +VIRTUAL void pidgone _((int pid, int status)); +VIRTUAL void pmflag _((U16* pmfl, int ch)); +VIRTUAL OP* pmruntime _((OP* pm, OP* expr, OP* repl)); +VIRTUAL OP* pmtrans _((OP* o, OP* expr, OP* repl)); +VIRTUAL OP* pop_return _((void)); +VIRTUAL void pop_scope _((void)); +VIRTUAL OP* prepend_elem _((I32 optype, OP* head, OP* tail)); +VIRTUAL void push_return _((OP* o)); +VIRTUAL void push_scope _((void)); +VIRTUAL OP* ref _((OP* o, I32 type)); +VIRTUAL OP* refkids _((OP* o, I32 type)); +VIRTUAL void regdump _((regexp* r)); +VIRTUAL I32 pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave)); +VIRTUAL void pregfree _((struct regexp* r)); +VIRTUAL regexp* pregcomp _((char* exp, char* xend, PMOP* pm)); +VIRTUAL I32 regexec_flags _((regexp* prog, char* stringarg, char* strend, + char* strbeg, I32 minend, SV* screamer, + void* data, U32 flags)); +VIRTUAL regnode* regnext _((regnode* p)); +VIRTUAL void regprop _((SV* sv, regnode* o)); +VIRTUAL void repeatcpy _((char* to, char* from, I32 len, I32 count)); +VIRTUAL char* rninstr _((char* big, char* bigend, char* little, char* lend)); +VIRTUAL Sighandler_t rsignal _((int i, Sighandler_t t)); +VIRTUAL int rsignal_restore _((int i, Sigsave_t* t)); +VIRTUAL int rsignal_save _((int i, Sighandler_t t1, Sigsave_t* t2)); +VIRTUAL Sighandler_t rsignal_state _((int i)); +VIRTUAL void rxres_free _((void** rsp)); +VIRTUAL void rxres_restore _((void** rsp, REGEXP* prx)); +VIRTUAL void rxres_save _((void** rsp, REGEXP* prx)); +#ifndef HAS_RENAME +VIRTUAL I32 same_dirent _((char* a, char* b)); +#endif +VIRTUAL char* savepv _((char* sv)); +VIRTUAL char* savepvn _((char* sv, I32 len)); +VIRTUAL void savestack_grow _((void)); +VIRTUAL void save_aelem _((AV* av, I32 idx, SV **sptr)); +VIRTUAL void save_aptr _((AV** aptr)); +VIRTUAL AV* save_ary _((GV* gv)); +VIRTUAL void save_clearsv _((SV** svp)); +VIRTUAL void save_delete _((HV* hv, char* key, I32 klen)); +#ifndef titan /* TitanOS cc can't handle this */ +#ifdef PERL_OBJECT +typedef void (CPerlObj::*DESTRUCTORFUNC) _((void*)); +VIRTUAL void save_destructor _((DESTRUCTORFUNC f, void* p)); +#else +void save_destructor _((void (*f)(void*), void* p)); +#endif +#endif /* titan */ +VIRTUAL void save_freesv _((SV* sv)); +VIRTUAL void save_freeop _((OP* o)); +VIRTUAL void save_freepv _((char* pv)); +VIRTUAL void save_gp _((GV* gv, I32 empty)); +VIRTUAL HV* save_hash _((GV* gv)); +VIRTUAL void save_helem _((HV* hv, SV *key, SV **sptr)); +VIRTUAL void save_hints _((void)); +VIRTUAL void save_hptr _((HV** hptr)); +VIRTUAL void save_I16 _((I16* intp)); +VIRTUAL void save_I32 _((I32* intp)); +VIRTUAL void save_int _((int* intp)); +VIRTUAL void save_item _((SV* item)); +VIRTUAL void save_iv _((IV* iv)); +VIRTUAL void save_list _((SV** sarg, I32 maxsarg)); +VIRTUAL void save_long _((long* longp)); +VIRTUAL void save_nogv _((GV* gv)); +VIRTUAL void save_op _((void)); +VIRTUAL SV* save_scalar _((GV* gv)); +VIRTUAL void save_pptr _((char** pptr)); +VIRTUAL void save_sptr _((SV** sptr)); +VIRTUAL SV* save_svref _((SV** sptr)); +VIRTUAL SV** save_threadsv _((PADOFFSET i)); +VIRTUAL OP* sawparens _((OP* o)); +VIRTUAL OP* scalar _((OP* o)); +VIRTUAL OP* scalarkids _((OP* o)); +VIRTUAL OP* scalarseq _((OP* o)); +VIRTUAL OP* scalarvoid _((OP* o)); +VIRTUAL UV scan_hex _((char* start, I32 len, I32* retlen)); +VIRTUAL char* scan_num _((char* s)); +VIRTUAL UV scan_oct _((char* start, I32 len, I32* retlen)); +VIRTUAL OP* scope _((OP* o)); +VIRTUAL char* screaminstr _((SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last)); +#ifndef VMS +VIRTUAL I32 setenv_getix _((char* nam)); +#endif +VIRTUAL void setdefout _((GV* gv)); +VIRTUAL char* sharepvn _((char* sv, I32 len, U32 hash)); +VIRTUAL HEK* share_hek _((char* sv, I32 len, U32 hash)); +VIRTUAL Signal_t sighandler _((int sig)); +VIRTUAL SV** stack_grow _((SV** sp, SV**p, int n)); +VIRTUAL I32 start_subparse _((I32 is_format, U32 flags)); +VIRTUAL void sub_crush_depth _((CV* cv)); +VIRTUAL bool sv_2bool _((SV* sv)); +VIRTUAL CV* sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref)); +VIRTUAL IO* sv_2io _((SV* sv)); +VIRTUAL IV sv_2iv _((SV* sv)); +VIRTUAL SV* sv_2mortal _((SV* sv)); +VIRTUAL double sv_2nv _((SV* sv)); +VIRTUAL char* sv_2pv _((SV* sv, STRLEN* lp)); +VIRTUAL UV sv_2uv _((SV* sv)); +VIRTUAL IV sv_iv _((SV* sv)); +VIRTUAL UV sv_uv _((SV* sv)); +VIRTUAL double sv_nv _((SV* sv)); +VIRTUAL char * sv_pvn _((SV *sv, STRLEN *len)); +VIRTUAL I32 sv_true _((SV *sv)); +VIRTUAL void sv_add_arena _((char* ptr, U32 size, U32 flags)); +VIRTUAL int sv_backoff _((SV* sv)); +VIRTUAL SV* sv_bless _((SV* sv, HV* stash)); +VIRTUAL void sv_catpvf _((SV* sv, const char* pat, ...)); +VIRTUAL void sv_catpv _((SV* sv, char* ptr)); +VIRTUAL void sv_catpvn _((SV* sv, char* ptr, STRLEN len)); +VIRTUAL void sv_catsv _((SV* dsv, SV* ssv)); +VIRTUAL void sv_chop _((SV* sv, char* ptr)); +VIRTUAL void sv_clean_all _((void)); +VIRTUAL void sv_clean_objs _((void)); +VIRTUAL void sv_clear _((SV* sv)); +VIRTUAL I32 sv_cmp _((SV* sv1, SV* sv2)); +VIRTUAL I32 sv_cmp_locale _((SV* sv1, SV* sv2)); +#ifdef USE_LOCALE_COLLATE +VIRTUAL char* sv_collxfrm _((SV* sv, STRLEN* nxp)); +#endif +VIRTUAL OP* sv_compile_2op _((SV* sv, OP** startp, char* code, AV** avp)); +VIRTUAL void sv_dec _((SV* sv)); +VIRTUAL void sv_dump _((SV* sv)); +VIRTUAL bool sv_derived_from _((SV* sv, char* name)); +VIRTUAL I32 sv_eq _((SV* sv1, SV* sv2)); +VIRTUAL void sv_free _((SV* sv)); +VIRTUAL void sv_free_arenas _((void)); +VIRTUAL char* sv_gets _((SV* sv, PerlIO* fp, I32 append)); +#ifndef DOSISH +VIRTUAL char* sv_grow _((SV* sv, I32 newlen)); +#else +VIRTUAL char* sv_grow _((SV* sv, unsigned long newlen)); +#endif +VIRTUAL void sv_inc _((SV* sv)); +VIRTUAL void sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen)); +VIRTUAL int sv_isa _((SV* sv, char* name)); +VIRTUAL int sv_isobject _((SV* sv)); +VIRTUAL STRLEN sv_len _((SV* sv)); +VIRTUAL void sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen)); +VIRTUAL SV* sv_mortalcopy _((SV* oldsv)); +VIRTUAL SV* sv_newmortal _((void)); +VIRTUAL SV* sv_newref _((SV* sv)); +VIRTUAL char* sv_peek _((SV* sv)); +VIRTUAL char* sv_pvn_force _((SV* sv, STRLEN* lp)); +VIRTUAL char* sv_reftype _((SV* sv, int ob)); +VIRTUAL void sv_replace _((SV* sv, SV* nsv)); +VIRTUAL void sv_report_used _((void)); +VIRTUAL void sv_reset _((char* s, HV* stash)); +VIRTUAL void sv_setpvf _((SV* sv, const char* pat, ...)); +VIRTUAL void sv_setiv _((SV* sv, IV num)); +VIRTUAL void sv_setpviv _((SV* sv, IV num)); +VIRTUAL void sv_setuv _((SV* sv, UV num)); +VIRTUAL void sv_setnv _((SV* sv, double num)); +VIRTUAL SV* sv_setref_iv _((SV* rv, char* classname, IV iv)); +VIRTUAL SV* sv_setref_nv _((SV* rv, char* classname, double nv)); +VIRTUAL SV* sv_setref_pv _((SV* rv, char* classname, void* pv)); +VIRTUAL SV* sv_setref_pvn _((SV* rv, char* classname, char* pv, I32 n)); +VIRTUAL void sv_setpv _((SV* sv, const char* ptr)); +VIRTUAL void sv_setpvn _((SV* sv, const char* ptr, STRLEN len)); +VIRTUAL void sv_setsv _((SV* dsv, SV* ssv)); +VIRTUAL void sv_taint _((SV* sv)); +VIRTUAL bool sv_tainted _((SV* sv)); +VIRTUAL int sv_unmagic _((SV* sv, int type)); +VIRTUAL void sv_unref _((SV* sv)); +VIRTUAL void sv_untaint _((SV* sv)); +VIRTUAL bool sv_upgrade _((SV* sv, U32 mt)); +VIRTUAL void sv_usepvn _((SV* sv, char* ptr, STRLEN len)); +VIRTUAL void sv_vcatpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list* args, SV** svargs, I32 svmax, + bool *used_locale)); +VIRTUAL void sv_vsetpvfn _((SV* sv, const char* pat, STRLEN patlen, + va_list* args, SV** svargs, I32 svmax, + bool *used_locale)); +VIRTUAL void taint_env _((void)); +VIRTUAL void taint_proper _((const char* f, char* s)); +#ifdef UNLINK_ALL_VERSIONS +VIRTUAL I32 unlnk _((char* f)); +#endif +#ifdef USE_THREADS +VIRTUAL void unlock_condpair _((void* svv)); +#endif +VIRTUAL void unsharepvn _((char* sv, I32 len, U32 hash)); +VIRTUAL void unshare_hek _((HEK* hek)); +VIRTUAL void utilize _((int aver, I32 floor, OP* version, OP* id, OP* arg)); +VIRTUAL void vivify_defelem _((SV* sv)); +VIRTUAL void vivify_ref _((SV* sv, U32 to_what)); +VIRTUAL I32 wait4pid _((int pid, int* statusp, int flags)); +VIRTUAL void warn _((const char* pat,...)); +VIRTUAL void watch _((char** addr)); +VIRTUAL I32 whichsig _((char* sig)); +VIRTUAL int yyerror _((char* s)); +VIRTUAL int yylex _((void)); +VIRTUAL int yyparse _((void)); +VIRTUAL int yywarn _((char* s)); + +#ifndef MYMALLOC +VIRTUAL Malloc_t safemalloc _((MEM_SIZE nbytes)); +VIRTUAL Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); +VIRTUAL Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes)); +VIRTUAL Free_t safefree _((Malloc_t where)); +#endif + +#ifdef LEAKTEST +VIRTUAL Malloc_t safexmalloc _((I32 x, MEM_SIZE size)); +VIRTUAL Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); +VIRTUAL Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size)); +VIRTUAL void safexfree _((Malloc_t where)); +#endif + +#ifdef PERL_GLOBAL_STRUCT +VIRTUAL struct perl_vars *Perl_GetVars _((void)); +#endif + +#ifdef PERL_OBJECT +protected: +void hsplit _((HV *hv)); +void hfreeentries _((HV *hv)); +HE* more_he _((void)); +HE* new_he _((void)); +void del_he _((HE *p)); +HEK *save_hek _((char *str, I32 len, U32 hash)); +SV *mess_alloc _((void)); +void gv_init_sv _((GV *gv, I32 sv_type)); +SV *save_scalar_at _((SV **sptr)); +IV asIV _((SV* sv)); +UV asUV _((SV* sv)); +SV *more_sv _((void)); +XPVIV *more_xiv _((void)); +XPVNV *more_xnv _((void)); +XPV *more_xpv _((void)); +XRV *more_xrv _((void)); +XPVIV *new_xiv _((void)); +XPVNV *new_xnv _((void)); +XPV *new_xpv _((void)); +XRV *new_xrv _((void)); +void del_xiv _((XPVIV* p)); +void del_xnv _((XPVNV* p)); +void del_xpv _((XPV* p)); +void del_xrv _((XRV* p)); +void sv_mortalgrow _((void)); +void sv_unglob _((SV* sv)); +void sv_check_thinkfirst _((SV *sv)); +I32 avhv_index_sv _((SV* sv)); + +void do_report_used _((SV *sv)); +void do_clean_objs _((SV *sv)); +void do_clean_named_objs _((SV *sv)); +void do_clean_all _((SV *sv)); +void not_a_number _((SV *sv)); +void* my_safemalloc _((MEM_SIZE size)); + +typedef void (CPerlObj::*SVFUNC) _((SV*)); +void visit _((SVFUNC f)); + +typedef I32 (CPerlObj::*SVCOMPARE) _((SV*, SV*)); +void qsortsv _((SV ** array, size_t num_elts, SVCOMPARE f)); +I32 sortcv _((SV *a, SV *b)); +void save_magic _((MGS *mgs, SV *sv)); +int magic_methpack _((SV *sv, MAGIC *mg, char *meth)); +int magic_methcall _((MAGIC *mg, char *meth, I32 flags, int n, SV *val)); +OP * doform _((CV *cv, GV *gv, OP *retop)); +void doencodes _((SV* sv, char* s, I32 len)); +SV* refto _((SV* sv)); +U32 seed _((void)); +OP *docatch _((OP *o)); +OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit)); +void doparseform _((SV *sv)); +I32 dopoptoeval _((I32 startingblock)); +I32 dopoptolabel _((char *label)); +I32 dopoptoloop _((I32 startingblock)); +I32 dopoptosub _((I32 startingblock)); +I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock)); +void save_lines _((AV *array, SV *sv)); +OP *doeval _((int gimme, OP** startop)); +SV *mul128 _((SV *sv, U8 m)); +SV *is_an_int _((char *s, STRLEN l)); +int div128 _((SV *pnum, bool *done)); + +int runops_standard _((void)); +int runops_debug _((void)); + +void check_uni _((void)); +void force_next _((I32 type)); +char *force_version _((char *start)); +char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick)); +SV *tokeq _((SV *sv)); +char *scan_const _((char *start)); +char *scan_formline _((char *s)); +char *scan_heredoc _((char *s)); +char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen, I32 ck_uni)); +char *scan_inputsymbol _((char *start)); +char *scan_pat _((char *start, I32 type)); +char *scan_str _((char *start)); +char *scan_subst _((char *start)); +char *scan_trans _((char *start)); +char *scan_word _((char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)); +char *skipspace _((char *s)); +void checkcomma _((char *s, char *name, char *what)); +void force_ident _((char *s, int kind)); +void incline _((char *s)); +int intuit_method _((char *s, GV *gv)); +int intuit_more _((char *s)); +I32 lop _((I32 f, expectation x, char *s)); +void missingterm _((char *s)); +void no_op _((char *what, char *s)); +void set_csh _((void)); +I32 sublex_done _((void)); +I32 sublex_push _((void)); +I32 sublex_start _((void)); +#ifdef CRIPPLED_CC +int uni _((I32 f, char *s)); +#endif +char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); +SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)); +int ao _((int toketype)); +void depcom _((void)); +#ifdef WIN32 +I32 win32_textfilter _((int idx, SV *sv, int maxlen)); +#endif +char* incl_perldb _((void)); +SV *isa_lookup _((HV *stash, char *name, int len, int level)); +CV *get_db_sub _((SV **svp, CV *cv)); +I32 list_assignment _((OP *o)); +void bad_type _((I32 n, char *t, char *name, OP *kid)); +OP *modkids _((OP *o, I32 type)); +OP *no_fh_allowed _((OP *o)); +OP *scalarboolean _((OP *o)); +OP *too_few_arguments _((OP *o, char* name)); +OP *too_many_arguments _((OP *o, char* name)); +void null _((OP* o)); +PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); +OP *newDEFSVOP _((void)); +char* gv_ename _((GV *gv)); +CV *cv_clone2 _((CV *proto, CV *outside)); + +void find_beginning _((void)); +void forbid_setid _((char *)); +void incpush _((char *, int)); +void init_interp _((void)); +void init_ids _((void)); +void init_debugger _((void)); +void init_lexer _((void)); +void init_main_stash _((void)); +#ifdef USE_THREADS +struct perl_thread * init_main_thread _((void)); +#endif /* USE_THREADS */ +void init_perllib _((void)); +void init_postdump_symbols _((int, char **, char **)); +void init_predump_symbols _((void)); +void my_exit_jump _((void)) __attribute__((noreturn)); +void nuke_stacks _((void)); +void open_script _((char *, bool, SV *, int *fd)); +void usage _((char *)); +void validate_suid _((char *, char*, int)); + +regnode *reg _((I32, I32 *)); +regnode *reganode _((U8, U32)); +regnode *regatom _((I32 *)); +regnode *regbranch _((I32 *, I32)); +void regc _((U8, char *)); +regnode *regclass _((void)); +I32 regcurly _((char *)); +regnode *reg_node _((U8)); +regnode *regpiece _((I32 *)); +void reginsert _((U8, regnode *)); +void regoptail _((regnode *, regnode *)); +void regset _((char *, I32)); +void regtail _((regnode *, regnode *)); +char* regwhite _((char *, char *)); +char* nextchar _((void)); +regnode *dumpuntil _((regnode *start, regnode *node, regnode *last, SV* sv, I32 l)); +void scan_commit _((scan_data_t *data)); +I32 study_chunk _((regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)); +I32 add_data _((I32 n, char *s)); +void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); +I32 regmatch _((regnode *prog)); +I32 regrepeat _((regnode *p, I32 max)); +I32 regrepeat_hard _((regnode *p, I32 max, I32 *lp)); +I32 regtry _((regexp *prog, char *startpos)); +bool reginclass _((char *p, I32 c)); +CHECKPOINT regcppush _((I32 parenfloor)); +char * regcppop _((void)); +void dump _((char *pat,...)); +#ifdef WIN32 +int do_aspawn _((void *vreally, void **vmark, void **vsp)); +#endif + +#ifdef DEBUGGING +void del_sv _((SV *p)); +#endif +void debprof _((OP *o)); + +void *bset_obj_store _((void *obj, I32 ix)); +OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); + +#define PPDEF(s) OP* CPerlObj::s _((ARGSproto)); +public: + +#include "pp_proto.h" + +OP * ck_ftst _((OP *o)); +OP *ck_anoncode _((OP *o)); +OP *ck_bitop _((OP *o)); +OP *ck_concat _((OP *o)); +OP *ck_spair _((OP *o)); +OP *ck_delete _((OP *o)); +OP *ck_eof _((OP *o)); +OP *ck_eval _((OP *o)); +OP *ck_exec _((OP *o)); +OP *ck_exists _((OP *o)); +OP *ck_rvconst _((OP *o)); +OP *ck_fun _((OP *o)); +OP *ck_glob _((OP *o)); +OP *ck_grep _((OP *o)); +OP *ck_index _((OP *o)); +OP *ck_lengthconst _((OP *o)); +OP *ck_lfun _((OP *o)); +OP *ck_rfun _((OP *o)); +OP *ck_listiob _((OP *o)); +OP *ck_fun_locale _((OP *o)); +OP *ck_scmp _((OP *o)); +OP *ck_match _((OP *o)); +OP *ck_null _((OP *o)); +OP *ck_repeat _((OP *o)); +OP *ck_require _((OP *o)); +OP *ck_select _((OP *o)); +OP *ck_shift _((OP *o)); +OP *ck_sort _((OP *o)); +OP *ck_split _((OP *o)); +OP *ck_subr _((OP *o)); +OP *ck_svconst _((OP *o)); +OP *ck_trunc _((OP *o)); +void unwind_handler_stack _((void *p)); +void restore_magic _((void *p)); +void restore_rsfp _((void *f)); +void restore_expect _((void *e)); +void restore_lex_expect _((void *e)); +void yydestruct _((void *ptr)); +VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...)); +VIRTUAL SV** get_specialsv_list _((void)); + +#ifdef WIN32 +VIRTUAL int& ErrorNo _((void)); +#endif /* WIN32 */ +#else /* !PERL_OBJECT */ +END_EXTERN_C +#endif /* PERL_OBJECT */ + +#ifdef INDIRECT_BGET_MACROS +VIRTUAL void byterun _((struct bytestream bs)); +#else +VIRTUAL void byterun _((PerlIO *fp)); +#endif /* INDIRECT_BGET_MACROS */ + +VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...)); +VIRTUAL void sv_catpv_mg _((SV *sv, char *ptr)); +VIRTUAL void sv_catpvn_mg _((SV *sv, char *ptr, STRLEN len)); +VIRTUAL void sv_catsv_mg _((SV *dstr, SV *sstr)); +VIRTUAL void sv_setpvf_mg _((SV *sv, const char* pat, ...)); +VIRTUAL void sv_setiv_mg _((SV *sv, IV i)); +VIRTUAL void sv_setpviv_mg _((SV *sv, IV iv)); +VIRTUAL void sv_setuv_mg _((SV *sv, UV u)); +VIRTUAL void sv_setnv_mg _((SV *sv, double num)); +VIRTUAL void sv_setpv_mg _((SV *sv, const char *ptr)); +VIRTUAL void sv_setpvn_mg _((SV *sv, const char *ptr, STRLEN len)); +VIRTUAL void sv_setsv_mg _((SV *dstr, SV *sstr)); +VIRTUAL void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len)); + +/* New virtual functions must be added here to maintain binary + * compatablity with PERL_OBJECT + */ + diff --git a/contrib/perl5/regcomp.c b/contrib/perl5/regcomp.c new file mode 100644 index 00000000000..f2f51a44201 --- /dev/null +++ b/contrib/perl5/regcomp.c @@ -0,0 +1,2672 @@ +/* regcomp.c + */ + +/* + * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee + */ + +/* NOTE: this is derived from Henry Spencer's regexp code, and should not + * confused with the original package (see point 3 below). Thanks, Henry! + */ + +/* Additional note: this code is very heavily munged from Henry's version + * in places. In some spots I've traded clarity for efficiency, so don't + * blame Henry for some of the lack of readability. + */ + +/* The names of the functions have been changed from regcomp and + * regexec to pregcomp and pregexec in order to avoid conflicts + * with the POSIX routines of the same names. +*/ + +#ifdef PERL_EXT_RE_BUILD +/* need to replace pregcomp et al, so enable that */ +# ifndef PERL_IN_XSUB_RE +# define PERL_IN_XSUB_RE +# endif +/* need access to debugger hooks */ +# ifndef DEBUGGING +# define DEBUGGING +# endif +#endif + +#ifdef PERL_IN_XSUB_RE +/* We *really* need to overwrite these symbols: */ +# define Perl_pregcomp my_regcomp +# define Perl_regdump my_regdump +# define Perl_regprop my_regprop +/* *These* symbols are masked to allow static link. */ +# define Perl_pregfree my_regfree +# define Perl_regnext my_regnext +#endif + +/*SUPPRESS 112*/ +/* + * pregcomp and pregexec -- regsub and regerror are not used in perl + * + * Copyright (c) 1986 by University of Toronto. + * Written by Henry Spencer. Not derived from licensed software. + * + * Permission is granted to anyone to use this software for any + * purpose on any computer system, and to redistribute it freely, + * subject to the following restrictions: + * + * 1. The author is not responsible for the consequences of use of + * this software, no matter how awful, even if they arise + * from defects in it. + * + * 2. The origin of this software must not be misrepresented, either + * by explicit claim or by omission. + * + * 3. Altered versions must be plainly marked as such, and must not + * be misrepresented as being the original software. + * + * + **** Alterations to Henry's code are... + **** + **** Copyright (c) 1991-1997, Larry Wall + **** + **** You may distribute under the terms of either the GNU General Public + **** License or the Artistic License, as specified in the README file. + + * + * Beware that some of this code is subtly aware of the way operator + * precedence is structured in regular expressions. Serious changes in + * regular-expression syntax might require a total rethink. + */ +#include "EXTERN.h" +#include "perl.h" + +#ifndef PERL_IN_XSUB_RE +# include "INTERN.h" +#endif + +#define REG_COMP_C +#include "regcomp.h" + +#ifdef op +#undef op +#endif /* op */ + +#ifdef MSDOS +# if defined(BUGGY_MSC6) + /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */ + # pragma optimize("a",off) + /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/ + # pragma optimize("w",on ) +# endif /* BUGGY_MSC6 */ +#endif /* MSDOS */ + +#ifndef STATIC +#define STATIC static +#endif + +#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?') +#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \ + ((*s) == '{' && regcurly(s))) +#ifdef atarist +#define PERL_META "^$.[()|?+*\\" +#else +#define META "^$.[()|?+*\\" +#endif + +#ifdef SPSTART +#undef SPSTART /* dratted cpp namespace... */ +#endif +/* + * Flags to be passed up and down. + */ +#define WORST 0 /* Worst case. */ +#define HASWIDTH 0x1 /* Known to match non-null strings. */ +#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */ +#define SPSTART 0x4 /* Starts with * or +. */ +#define TRYAGAIN 0x8 /* Weeded out a declaration. */ + +/* + * Forward declarations for pregcomp()'s friends. + */ + +#ifndef PERL_OBJECT +static regnode *reg _((I32, I32 *)); +static regnode *reganode _((U8, U32)); +static regnode *regatom _((I32 *)); +static regnode *regbranch _((I32 *, I32)); +static void regc _((U8, char *)); +static regnode *regclass _((void)); +STATIC I32 regcurly _((char *)); +static regnode *reg_node _((U8)); +static regnode *regpiece _((I32 *)); +static void reginsert _((U8, regnode *)); +static void regoptail _((regnode *, regnode *)); +static void regtail _((regnode *, regnode *)); +static char* regwhite _((char *, char *)); +static char* nextchar _((void)); +static void re_croak2 _((const char* pat1,const char* pat2,...)) __attribute__((noreturn)); +#endif + +/* Length of a variant. */ + +#ifndef PERL_OBJECT +typedef struct { + I32 len_min; + I32 len_delta; + I32 pos_min; + I32 pos_delta; + SV *last_found; + I32 last_end; /* min value, <0 unless valid. */ + I32 last_start_min; + I32 last_start_max; + SV **longest; /* Either &l_fixed, or &l_float. */ + SV *longest_fixed; + I32 offset_fixed; + SV *longest_float; + I32 offset_float_min; + I32 offset_float_max; + I32 flags; +} scan_data_t; +#endif + +static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; + +#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) +#define SF_BEFORE_SEOL 0x1 +#define SF_BEFORE_MEOL 0x2 +#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL) +#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL) + +#ifdef NO_UNARY_PLUS +# define SF_FIX_SHIFT_EOL (0+2) +# define SF_FL_SHIFT_EOL (0+4) +#else +# define SF_FIX_SHIFT_EOL (+2) +# define SF_FL_SHIFT_EOL (+4) +#endif + +#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL) +#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL) + +#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL) +#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */ +#define SF_IS_INF 0x40 +#define SF_HAS_PAR 0x80 +#define SF_IN_PAR 0x100 +#define SF_HAS_EVAL 0x200 +#define SCF_DO_SUBSTR 0x400 + +STATIC void +scan_commit(scan_data_t *data) +{ + STRLEN l = SvCUR(data->last_found); + STRLEN old_l = SvCUR(*data->longest); + + if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) { + sv_setsv(*data->longest, data->last_found); + if (*data->longest == data->longest_fixed) { + data->offset_fixed = l ? data->last_start_min : data->pos_min; + if (data->flags & SF_BEFORE_EOL) + data->flags + |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL); + else + data->flags &= ~SF_FIX_BEFORE_EOL; + } else { + data->offset_float_min = l ? data->last_start_min : data->pos_min; + data->offset_float_max = (l + ? data->last_start_max + : data->pos_min + data->pos_delta); + if (data->flags & SF_BEFORE_EOL) + data->flags + |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL); + else + data->flags &= ~SF_FL_BEFORE_EOL; + } + } + SvCUR_set(data->last_found, 0); + data->last_end = -1; + data->flags &= ~SF_BEFORE_EOL; +} + +/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set + to the position after last scanned or to NULL. */ + +STATIC I32 +study_chunk(regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags) + /* scanp: Start here (read-write). */ + /* deltap: Write maxlen-minlen here. */ + /* last: Stop before this one. */ +{ + dTHR; + I32 min = 0, pars = 0, code; + regnode *scan = *scanp, *next; + I32 delta = 0; + int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF); + I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0; + scan_data_t data_fake; + + while (scan && OP(scan) != END && scan < last) { + /* Peephole optimizer: */ + + if (regkind[(U8)OP(scan)] == EXACT) { + regnode *n = regnext(scan); + U32 stringok = 1; +#ifdef DEBUGGING + regnode *stop = scan; +#endif + + next = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2; + /* Skip NOTHING, merge EXACT*. */ + while (n && + ( regkind[(U8)OP(n)] == NOTHING || + (stringok && (OP(n) == OP(scan)))) + && NEXT_OFF(n) + && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) { + if (OP(n) == TAIL || n > next) + stringok = 0; + if (regkind[(U8)OP(n)] == NOTHING) { + NEXT_OFF(scan) += NEXT_OFF(n); + next = n + NODE_STEP_REGNODE; +#ifdef DEBUGGING + if (stringok) + stop = n; +#endif + n = regnext(n); + } else { + int oldl = *OPERAND(scan); + regnode *nnext = regnext(n); + + if (oldl + *OPERAND(n) > U8_MAX) + break; + NEXT_OFF(scan) += NEXT_OFF(n); + *OPERAND(scan) += *OPERAND(n); + next = n + (*OPERAND(n) + 2 - 1)/sizeof(regnode) + 2; + /* Now we can overwrite *n : */ + Move(OPERAND(n) + 1, OPERAND(scan) + oldl + 1, + *OPERAND(n) + 1, char); +#ifdef DEBUGGING + if (stringok) + stop = next - 1; +#endif + n = nnext; + } + } +#ifdef DEBUGGING + /* Allow dumping */ + n = scan + (*OPERAND(scan) + 2 - 1)/sizeof(regnode) + 2; + while (n <= stop) { + /* Purify reports a benign UMR here sometimes, because we + * don't initialize the OP() slot of a node when that node + * is occupied by just the trailing null of the string in + * an EXACT node */ + if (regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) { + OP(n) = OPTIMIZED; + NEXT_OFF(n) = 0; + } + n++; + } +#endif + + } + if (OP(scan) != CURLYX) { + int max = (reg_off_by_arg[OP(scan)] + ? I32_MAX + /* I32 may be smaller than U16 on CRAYs! */ + : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX)); + int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan)); + int noff; + regnode *n = scan; + + /* Skip NOTHING and LONGJMP. */ + while ((n = regnext(n)) + && ((regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n))) + || ((OP(n) == LONGJMP) && (noff = ARG(n)))) + && off + noff < max) + off += noff; + if (reg_off_by_arg[OP(scan)]) + ARG(scan) = off; + else + NEXT_OFF(scan) = off; + } + if (OP(scan) == BRANCH || OP(scan) == BRANCHJ + || OP(scan) == IFTHEN || OP(scan) == SUSPEND) { + next = regnext(scan); + code = OP(scan); + + if (OP(next) == code || code == IFTHEN || code == SUSPEND) { + I32 max1 = 0, min1 = I32_MAX, num = 0; + + if (flags & SCF_DO_SUBSTR) + scan_commit(data); + while (OP(scan) == code) { + I32 deltanext, minnext; + + num++; + data_fake.flags = 0; + next = regnext(scan); + scan = NEXTOPER(scan); + if (code != BRANCH) + scan = NEXTOPER(scan); + /* We suppose the run is continuous, last=next...*/ + minnext = study_chunk(&scan, &deltanext, next, + &data_fake, 0); + if (min1 > minnext) + min1 = minnext; + if (max1 < minnext + deltanext) + max1 = minnext + deltanext; + if (deltanext == I32_MAX) + is_inf = 1; + scan = next; + if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (data && (data_fake.flags & SF_HAS_EVAL)) + data->flags |= SF_HAS_EVAL; + if (code == SUSPEND) + break; + } + if (code == IFTHEN && num < 2) /* Empty ELSE branch */ + min1 = 0; + if (flags & SCF_DO_SUBSTR) { + data->pos_min += min1; + data->pos_delta += max1 - min1; + if (max1 != min1 || is_inf) + data->longest = &(data->longest_float); + } + min += min1; + delta += max1 - min1; + } else if (code == BRANCHJ) /* single branch is optimized. */ + scan = NEXTOPER(NEXTOPER(scan)); + else /* single branch is optimized. */ + scan = NEXTOPER(scan); + continue; + } else if (OP(scan) == EXACT) { + min += *OPERAND(scan); + if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ + I32 l = *OPERAND(scan); + + /* The code below prefers earlier match for fixed + offset, later match for variable offset. */ + if (data->last_end == -1) { /* Update the start info. */ + data->last_start_min = data->pos_min; + data->last_start_max = is_inf + ? I32_MAX : data->pos_min + data->pos_delta; + } + sv_catpvn(data->last_found, (char *)(OPERAND(scan)+1), l); + data->last_end = data->pos_min + l; + data->pos_min += l; /* As in the first entry. */ + data->flags &= ~SF_BEFORE_EOL; + } + } else if (regkind[(U8)OP(scan)] == EXACT) { + if (flags & SCF_DO_SUBSTR) + scan_commit(data); + min += *OPERAND(scan); + if (data && (flags & SCF_DO_SUBSTR)) + data->pos_min += *OPERAND(scan); + } else if (strchr(varies,OP(scan))) { + I32 mincount, maxcount, minnext, deltanext, pos_before, fl; + regnode *oscan = scan; + + switch (regkind[(U8)OP(scan)]) { + case WHILEM: + scan = NEXTOPER(scan); + goto finish; + case PLUS: + if (flags & SCF_DO_SUBSTR) { + next = NEXTOPER(scan); + if (OP(next) == EXACT) { + mincount = 1; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } + } + if (flags & SCF_DO_SUBSTR) + data->pos_min++; + min++; + /* Fall through. */ + case STAR: + is_inf = 1; + scan = regnext(scan); + if (flags & SCF_DO_SUBSTR) { + scan_commit(data); + data->longest = &(data->longest_float); + } + goto optimize_curly_tail; + case CURLY: + mincount = ARG1(scan); + maxcount = ARG2(scan); + next = regnext(scan); + scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; + do_curly: + if (flags & SCF_DO_SUBSTR) { + if (mincount == 0) scan_commit(data); + pos_before = data->pos_min; + } + if (data) { + fl = data->flags; + data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL); + if (is_inf) + data->flags |= SF_IS_INF; + } + /* This will finish on WHILEM, setting scan, or on NULL: */ + minnext = study_chunk(&scan, &deltanext, last, data, + mincount == 0 + ? (flags & ~SCF_DO_SUBSTR) : flags); + if (!scan) /* It was not CURLYX, but CURLY. */ + scan = next; + if (PL_dowarn && (minnext + deltanext == 0) + && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) + && maxcount <= 10000) /* Complement check for big count */ + warn("Strange *+?{} on zero-length expression"); + min += minnext * mincount; + is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0 + || deltanext == I32_MAX); + delta += (minnext + deltanext) * maxcount - minnext * mincount; + + /* Try powerful optimization CURLYX => CURLYN. */ + if ( OP(oscan) == CURLYX && data + && data->flags & SF_IN_PAR + && !(data->flags & SF_HAS_EVAL) + && !deltanext && minnext == 1 ) { + /* Try to optimize to CURLYN. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; + regnode *nxt1 = nxt, *nxt2; + + /* Skip open. */ + nxt = regnext(nxt); + if (!strchr(simple,OP(nxt)) + && !(regkind[(U8)OP(nxt)] == EXACT + && *OPERAND(nxt) == 1)) + goto nogo; + nxt2 = nxt; + nxt = regnext(nxt); + if (OP(nxt) != CLOSE) + goto nogo; + /* Now we know that nxt2 is the only contents: */ + oscan->flags = ARG(nxt); + OP(oscan) = CURLYN; + OP(nxt1) = NOTHING; /* was OPEN. */ +#ifdef DEBUGGING + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */ + NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */ +#endif + } + nogo: + + /* Try optimization CURLYX => CURLYM. */ + if ( OP(oscan) == CURLYX && data + && !(data->flags & SF_HAS_PAR) + && !(data->flags & SF_HAS_EVAL) + && !deltanext ) { + /* XXXX How to optimize if data == 0? */ + /* Optimize to a simpler form. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */ + regnode *nxt2; + + OP(oscan) = CURLYM; + while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ + && (OP(nxt2) != WHILEM)) + nxt = nxt2; + OP(nxt2) = SUCCEED; /* Whas WHILEM */ + /* Need to optimize away parenths. */ + if (data->flags & SF_IN_PAR) { + /* Set the parenth number. */ + regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ + + if (OP(nxt) != CLOSE) + FAIL("panic opt close"); + oscan->flags = ARG(nxt); + OP(nxt1) = OPTIMIZED; /* was OPEN. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ +#ifdef DEBUGGING + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */ + NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */ +#endif +#if 0 + while ( nxt1 && (OP(nxt1) != WHILEM)) { + regnode *nnxt = regnext(nxt1); + + if (nnxt == nxt) { + if (reg_off_by_arg[OP(nxt1)]) + ARG_SET(nxt1, nxt2 - nxt1); + else if (nxt2 - nxt1 < U16_MAX) + NEXT_OFF(nxt1) = nxt2 - nxt1; + else + OP(nxt) = NOTHING; /* Cannot beautify */ + } + nxt1 = nnxt; + } +#endif + /* Optimize again: */ + study_chunk(&nxt1, &deltanext, nxt, NULL, 0); + } else + oscan->flags = 0; + } + if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (flags & SCF_DO_SUBSTR) { + SV *last_str = Nullsv; + int counted = mincount != 0; + + if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */ + I32 b = pos_before >= data->last_start_min + ? pos_before : data->last_start_min; + STRLEN l; + char *s = SvPV(data->last_found, l); + + l -= b - data->last_start_min; + /* Get the added string: */ + last_str = newSVpv(s + b - data->last_start_min, l); + if (deltanext == 0 && pos_before == b) { + /* What was added is a constant string */ + if (mincount > 1) { + SvGROW(last_str, (mincount * l) + 1); + repeatcpy(SvPVX(last_str) + l, + SvPVX(last_str), l, mincount - 1); + SvCUR(last_str) *= mincount; + /* Add additional parts. */ + SvCUR_set(data->last_found, + SvCUR(data->last_found) - l); + sv_catsv(data->last_found, last_str); + data->last_end += l * (mincount - 1); + } + } + } + /* It is counted once already... */ + data->pos_min += minnext * (mincount - counted); + data->pos_delta += - counted * deltanext + + (minnext + deltanext) * maxcount - minnext * mincount; + if (mincount != maxcount) { + scan_commit(data); + if (mincount && last_str) { + sv_setsv(data->last_found, last_str); + data->last_end = data->pos_min; + data->last_start_min = + data->pos_min - SvCUR(last_str); + data->last_start_max = is_inf + ? I32_MAX + : data->pos_min + data->pos_delta + - SvCUR(last_str); + } + data->longest = &(data->longest_float); + } + } + if (data && (fl & SF_HAS_EVAL)) + data->flags |= SF_HAS_EVAL; + optimize_curly_tail: + if (OP(oscan) != CURLYX) { + while (regkind[(U8)OP(next = regnext(oscan))] == NOTHING + && NEXT_OFF(next)) + NEXT_OFF(oscan) += NEXT_OFF(next); + } + continue; + default: /* REF only? */ + if (flags & SCF_DO_SUBSTR) { + scan_commit(data); + data->longest = &(data->longest_float); + } + is_inf = 1; + break; + } + } else if (strchr(simple,OP(scan))) { + if (flags & SCF_DO_SUBSTR) { + scan_commit(data); + data->pos_min++; + } + min++; + } else if (regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { + data->flags |= (OP(scan) == MEOL + ? SF_BEFORE_MEOL + : SF_BEFORE_SEOL); + } else if (regkind[(U8)OP(scan)] == BRANCHJ + && (scan->flags || data) + && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) { + I32 deltanext, minnext; + regnode *nscan; + + data_fake.flags = 0; + next = regnext(scan); + nscan = NEXTOPER(NEXTOPER(scan)); + minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0); + if (scan->flags) { + if (deltanext) { + FAIL("variable length lookbehind not implemented"); + } else if (minnext > U8_MAX) { + FAIL2("lookbehind longer than %d not implemented", U8_MAX); + } + scan->flags = minnext; + } + if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (data && (data_fake.flags & SF_HAS_EVAL)) + data->flags |= SF_HAS_EVAL; + } else if (OP(scan) == OPEN) { + pars++; + } else if (OP(scan) == CLOSE && ARG(scan) == is_par) { + next = regnext(scan); + + if ( next && (OP(next) != WHILEM) && next < last) + is_par = 0; /* Disable optimization */ + } else if (OP(scan) == EVAL) { + if (data) + data->flags |= SF_HAS_EVAL; + } + /* Else: zero-length, ignore. */ + scan = regnext(scan); + } + + finish: + *scanp = scan; + *deltap = is_inf ? I32_MAX : delta; + if (flags & SCF_DO_SUBSTR && is_inf) + data->pos_delta = I32_MAX - data->pos_min; + if (is_par > U8_MAX) + is_par = 0; + if (is_par && pars==1 && data) { + data->flags |= SF_IN_PAR; + data->flags &= ~SF_HAS_PAR; + } else if (pars && data) { + data->flags |= SF_HAS_PAR; + data->flags &= ~SF_IN_PAR; + } + return min; +} + +STATIC I32 +add_data(I32 n, char *s) +{ + dTHR; + if (PL_regcomp_rx->data) { + Renewc(PL_regcomp_rx->data, + sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (PL_regcomp_rx->data->count + n - 1), + char, struct reg_data); + Renew(PL_regcomp_rx->data->what, PL_regcomp_rx->data->count + n, U8); + PL_regcomp_rx->data->count += n; + } else { + Newc(1207, PL_regcomp_rx->data, sizeof(*PL_regcomp_rx->data) + sizeof(void*) * (n - 1), + char, struct reg_data); + New(1208, PL_regcomp_rx->data->what, n, U8); + PL_regcomp_rx->data->count = n; + } + Copy(s, PL_regcomp_rx->data->what + PL_regcomp_rx->data->count - n, n, U8); + return PL_regcomp_rx->data->count - n; +} + +/* + - pregcomp - compile a regular expression into internal code + * + * We can't allocate space until we know how big the compiled form will be, + * but we can't compile it (and thus know how big it is) until we've got a + * place to put the code. So we cheat: we compile it twice, once with code + * generation turned off and size counting turned on, and once "for real". + * This also means that we don't allocate space until we are sure that the + * thing really will compile successfully, and we never have to move the + * code and thus invalidate pointers into it. (Note that it has to be in + * one piece because free() must be able to free it all.) [NB: not true in perl] + * + * Beware that the optimization-preparation code in here knows about some + * of the structure of the compiled regexp. [I'll say.] + */ +regexp * +pregcomp(char *exp, char *xend, PMOP *pm) +{ + dTHR; + register regexp *r; + regnode *scan; + SV **longest; + SV *longest_fixed; + SV *longest_float; + regnode *first; + I32 flags; + I32 minlen = 0; + I32 sawplus = 0; + I32 sawopen = 0; + + if (exp == NULL) + FAIL("NULL regexp argument"); + + PL_regprecomp = savepvn(exp, xend - exp); + DEBUG_r(PerlIO_printf(Perl_debug_log, "compiling RE `%*s'\n", + xend - exp, PL_regprecomp)); + PL_regflags = pm->op_pmflags; + PL_regsawback = 0; + + PL_regseen = 0; + PL_seen_zerolen = *exp == '^' ? -1 : 0; + PL_seen_evals = 0; + PL_extralen = 0; + + /* First pass: determine size, legality. */ + PL_regcomp_parse = exp; + PL_regxend = xend; + PL_regnaughty = 0; + PL_regnpar = 1; + PL_regsize = 0L; + PL_regcode = &PL_regdummy; + regc((U8)MAGIC, (char*)PL_regcode); + if (reg(0, &flags) == NULL) { + Safefree(PL_regprecomp); + PL_regprecomp = Nullch; + return(NULL); + } + DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize)); + + DEBUG_r( + if (!PL_colorset) { + int i = 0; + char *s = PerlEnv_getenv("TERMCAP_COLORS"); + + PL_colorset = 1; + if (s) { + PL_colors[0] = s = savepv(s); + while (++i < 4) { + s = strchr(s, '\t'); + if (!s) + FAIL("Not enough TABs in TERMCAP_COLORS"); + *s = '\0'; + PL_colors[i] = ++s; + } + } else { + while (i < 4) + PL_colors[i++] = ""; + } + /* Reset colors: */ + PerlIO_printf(Perl_debug_log, "%s%s%s%s", + PL_colors[0],PL_colors[1],PL_colors[2],PL_colors[3]); + } + ); + + /* Small enough for pointer-storage convention? + If extralen==0, this means that we will not need long jumps. */ + if (PL_regsize >= 0x10000L && PL_extralen) + PL_regsize += PL_extralen; + else + PL_extralen = 0; + + /* Allocate space and initialize. */ + Newc(1001, r, sizeof(regexp) + (unsigned)PL_regsize * sizeof(regnode), + char, regexp); + if (r == NULL) + FAIL("regexp out of space"); + r->refcnt = 1; + r->prelen = xend - exp; + r->precomp = PL_regprecomp; + r->subbeg = r->subbase = NULL; + r->nparens = PL_regnpar - 1; /* set early to validate backrefs */ + PL_regcomp_rx = r; + + /* Second pass: emit code. */ + PL_regcomp_parse = exp; + PL_regxend = xend; + PL_regnaughty = 0; + PL_regnpar = 1; + PL_regcode = r->program; + /* Store the count of eval-groups for security checks: */ + PL_regcode->next_off = ((PL_seen_evals > U16_MAX) ? U16_MAX : PL_seen_evals); + regc((U8)MAGIC, (char*) PL_regcode++); + r->data = 0; + if (reg(0, &flags) == NULL) + return(NULL); + + /* Dig out information for optimizations. */ + r->reganch = pm->op_pmflags & PMf_COMPILETIME; + pm->op_pmflags = PL_regflags; + r->regstclass = NULL; + r->naughty = PL_regnaughty >= 10; /* Probably an expensive pattern. */ + scan = r->program + 1; /* First BRANCH. */ + + /* XXXX To minimize changes to RE engine we always allocate + 3-units-long substrs field. */ + Newz(1004, r->substrs, 1, struct reg_substr_data); + + if (OP(scan) != BRANCH) { /* Only one top-level choice. */ + scan_data_t data; + I32 fake; + STRLEN longest_float_length, longest_fixed_length; + + StructCopy(&zero_scan_data, &data, scan_data_t); + first = scan; + /* Skip introductions and multiplicators >= 1. */ + while ((OP(first) == OPEN && (sawopen = 1)) || + (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) || + (OP(first) == PLUS) || + (OP(first) == MINMOD) || + (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) { + if (OP(first) == PLUS) + sawplus = 1; + else + first += regarglen[(U8)OP(first)]; + first = NEXTOPER(first); + } + + /* Starting-point info. */ + again: + if (OP(first) == EXACT); /* Empty, get anchored substr later. */ + else if (strchr(simple+2,OP(first))) + r->regstclass = first; + else if (regkind[(U8)OP(first)] == BOUND || + regkind[(U8)OP(first)] == NBOUND) + r->regstclass = first; + else if (regkind[(U8)OP(first)] == BOL) { + r->reganch |= (OP(first) == MBOL ? ROPT_ANCH_MBOL: ROPT_ANCH_BOL); + first = NEXTOPER(first); + goto again; + } + else if (OP(first) == GPOS) { + r->reganch |= ROPT_ANCH_GPOS; + first = NEXTOPER(first); + goto again; + } + else if ((OP(first) == STAR && + regkind[(U8)OP(NEXTOPER(first))] == ANY) && + !(r->reganch & ROPT_ANCH) ) + { + /* turn .* into ^.* with an implied $*=1 */ + r->reganch |= ROPT_ANCH_BOL | ROPT_IMPLICIT; + first = NEXTOPER(first); + goto again; + } + if (sawplus && (!sawopen || !PL_regsawback)) + r->reganch |= ROPT_SKIP; /* x+ must match 1st of run */ + + /* Scan is after the zeroth branch, first is atomic matcher. */ + DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n", + first - scan + 1)); + /* + * If there's something expensive in the r.e., find the + * longest literal string that must appear and make it the + * regmust. Resolve ties in favor of later strings, since + * the regstart check works with the beginning of the r.e. + * and avoiding duplication strengthens checking. Not a + * strong reason, but sufficient in the absence of others. + * [Now we resolve ties in favor of the earlier string if + * it happens that c_offset_min has been invalidated, since the + * earlier string may buy us something the later one won't.] + */ + minlen = 0; + + data.longest_fixed = newSVpv("",0); + data.longest_float = newSVpv("",0); + data.last_found = newSVpv("",0); + data.longest = &(data.longest_fixed); + first = scan; + + minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */ + &data, SCF_DO_SUBSTR); + if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed) + && data.last_start_min == 0 && data.last_end > 0 + && !PL_seen_zerolen + && (!(PL_regseen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS))) + r->reganch |= ROPT_CHECK_ALL; + scan_commit(&data); + SvREFCNT_dec(data.last_found); + + longest_float_length = SvCUR(data.longest_float); + if (longest_float_length + || (data.flags & SF_FL_BEFORE_EOL + && (!(data.flags & SF_FL_BEFORE_MEOL) + || (PL_regflags & PMf_MULTILINE)))) { + if (SvCUR(data.longest_fixed) + && data.offset_fixed == data.offset_float_min) + goto remove; /* Like in (a)+. */ + + r->float_substr = data.longest_float; + r->float_min_offset = data.offset_float_min; + r->float_max_offset = data.offset_float_max; + fbm_compile(r->float_substr, 0); + BmUSEFUL(r->float_substr) = 100; + if (data.flags & SF_FL_BEFORE_EOL /* Cannot have SEOL and MULTI */ + && (!(data.flags & SF_FL_BEFORE_MEOL) + || (PL_regflags & PMf_MULTILINE))) + SvTAIL_on(r->float_substr); + } else { + remove: + r->float_substr = Nullsv; + SvREFCNT_dec(data.longest_float); + longest_float_length = 0; + } + + longest_fixed_length = SvCUR(data.longest_fixed); + if (longest_fixed_length + || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */ + && (!(data.flags & SF_FIX_BEFORE_MEOL) + || (PL_regflags & PMf_MULTILINE)))) { + r->anchored_substr = data.longest_fixed; + r->anchored_offset = data.offset_fixed; + fbm_compile(r->anchored_substr, 0); + BmUSEFUL(r->anchored_substr) = 100; + if (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */ + && (!(data.flags & SF_FIX_BEFORE_MEOL) + || (PL_regflags & PMf_MULTILINE))) + SvTAIL_on(r->anchored_substr); + } else { + r->anchored_substr = Nullsv; + SvREFCNT_dec(data.longest_fixed); + longest_fixed_length = 0; + } + + /* A temporary algorithm prefers floated substr to fixed one to dig more info. */ + if (longest_fixed_length > longest_float_length) { + r->check_substr = r->anchored_substr; + r->check_offset_min = r->check_offset_max = r->anchored_offset; + if (r->reganch & ROPT_ANCH_SINGLE) + r->reganch |= ROPT_NOSCAN; + } else { + r->check_substr = r->float_substr; + r->check_offset_min = data.offset_float_min; + r->check_offset_max = data.offset_float_max; + } + } else { + /* Several toplevels. Best we can is to set minlen. */ + I32 fake; + + DEBUG_r(PerlIO_printf(Perl_debug_log, "\n")); + scan = r->program + 1; + minlen = study_chunk(&scan, &fake, scan + PL_regsize, NULL, 0); + r->check_substr = r->anchored_substr = r->float_substr = Nullsv; + } + + r->minlen = minlen; + if (PL_regseen & REG_SEEN_GPOS) + r->reganch |= ROPT_GPOS_SEEN; + if (PL_regseen & REG_SEEN_LOOKBEHIND) + r->reganch |= ROPT_LOOKBEHIND_SEEN; + if (PL_regseen & REG_SEEN_EVAL) + r->reganch |= ROPT_EVAL_SEEN; + Newz(1002, r->startp, PL_regnpar, char*); + Newz(1002, r->endp, PL_regnpar, char*); + DEBUG_r(regdump(r)); + return(r); +} + +/* + - reg - regular expression, i.e. main body or parenthesized thing + * + * Caller must absorb opening parenthesis. + * + * Combining parenthesis handling with the base level of regular expression + * is a trifle forced, but the need to tie the tails of the branches to what + * follows makes it hard to avoid. + */ +STATIC regnode * +reg(I32 paren, I32 *flagp) + /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */ +{ + dTHR; + register regnode *ret; /* Will be the head of the group. */ + register regnode *br; + register regnode *lastbr; + register regnode *ender = 0; + register I32 parno = 0; + I32 flags, oregflags = PL_regflags, have_branch = 0, open = 0; + char c; + + *flagp = 0; /* Tentatively. */ + + /* Make an OPEN node, if parenthesized. */ + if (paren) { + if (*PL_regcomp_parse == '?') { + U16 posflags = 0, negflags = 0; + U16 *flagsp = &posflags; + + PL_regcomp_parse++; + paren = *PL_regcomp_parse++; + ret = NULL; /* For look-ahead/behind. */ + switch (paren) { + case '<': + PL_regseen |= REG_SEEN_LOOKBEHIND; + if (*PL_regcomp_parse == '!') + paren = ','; + if (*PL_regcomp_parse != '=' && *PL_regcomp_parse != '!') + goto unknown; + PL_regcomp_parse++; + case '=': + case '!': + PL_seen_zerolen++; + case ':': + case '>': + break; + case '$': + case '@': + FAIL2("Sequence (?%c...) not implemented", (int)paren); + break; + case '#': + while (*PL_regcomp_parse && *PL_regcomp_parse != ')') + PL_regcomp_parse++; + if (*PL_regcomp_parse != ')') + FAIL("Sequence (?#... not terminated"); + nextchar(); + *flagp = TRYAGAIN; + return NULL; + case '{': + { + dTHR; + I32 count = 1, n = 0; + char c; + char *s = PL_regcomp_parse; + SV *sv; + OP_4tree *sop, *rop; + + PL_seen_zerolen++; + PL_regseen |= REG_SEEN_EVAL; + while (count && (c = *PL_regcomp_parse)) { + if (c == '\\' && PL_regcomp_parse[1]) + PL_regcomp_parse++; + else if (c == '{') + count++; + else if (c == '}') + count--; + PL_regcomp_parse++; + } + if (*PL_regcomp_parse != ')') + FAIL("Sequence (?{...}) not terminated or not {}-balanced"); + if (!SIZE_ONLY) { + AV *av; + + if (PL_regcomp_parse - 1 - s) + sv = newSVpv(s, PL_regcomp_parse - 1 - s); + else + sv = newSVpv("", 0); + + rop = sv_compile_2op(sv, &sop, "re", &av); + + n = add_data(3, "nso"); + PL_regcomp_rx->data->data[n] = (void*)rop; + PL_regcomp_rx->data->data[n+1] = (void*)av; + PL_regcomp_rx->data->data[n+2] = (void*)sop; + SvREFCNT_dec(sv); + } else { /* First pass */ + if (PL_reginterp_cnt < ++PL_seen_evals && PL_curcop != &PL_compiling) + /* No compiled RE interpolated, has runtime + components ===> unsafe. */ + FAIL("Eval-group not allowed at runtime, use re 'eval'"); + if (PL_tainted) + FAIL("Eval-group in insecure regular expression"); + } + + nextchar(); + return reganode(EVAL, n); + } + case '(': + { + if (PL_regcomp_parse[0] == '?') { + if (PL_regcomp_parse[1] == '=' || PL_regcomp_parse[1] == '!' + || PL_regcomp_parse[1] == '<' + || PL_regcomp_parse[1] == '{') { /* Lookahead or eval. */ + I32 flag; + + ret = reg_node(LOGICAL); + regtail(ret, reg(1, &flag)); + goto insert_if; + } + } else if (PL_regcomp_parse[0] >= '1' && PL_regcomp_parse[0] <= '9' ) { + parno = atoi(PL_regcomp_parse++); + + while (isDIGIT(*PL_regcomp_parse)) + PL_regcomp_parse++; + ret = reganode(GROUPP, parno); + if ((c = *nextchar()) != ')') + FAIL2("Switch (?(number%c not recognized", c); + insert_if: + regtail(ret, reganode(IFTHEN, 0)); + br = regbranch(&flags, 1); + if (br == NULL) + br = reganode(LONGJMP, 0); + else + regtail(br, reganode(LONGJMP, 0)); + c = *nextchar(); + if (c == '|') { + lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */ + regbranch(&flags, 1); + regtail(ret, lastbr); + c = *nextchar(); + } else + lastbr = NULL; + if (c != ')') + FAIL("Switch (?(condition)... contains too many branches"); + ender = reg_node(TAIL); + regtail(br, ender); + if (lastbr) { + regtail(lastbr, ender); + regtail(NEXTOPER(NEXTOPER(lastbr)), ender); + } else + regtail(ret, ender); + return ret; + } else { + FAIL2("Unknown condition for (?(%.2s", PL_regcomp_parse); + } + } + case 0: + FAIL("Sequence (? incomplete"); + break; + default: + --PL_regcomp_parse; + parse_flags: + while (*PL_regcomp_parse && strchr("iogcmsx", *PL_regcomp_parse)) { + if (*PL_regcomp_parse != 'o') + pmflag(flagsp, *PL_regcomp_parse); + ++PL_regcomp_parse; + } + if (*PL_regcomp_parse == '-') { + flagsp = &negflags; + ++PL_regcomp_parse; + goto parse_flags; + } + PL_regflags |= posflags; + PL_regflags &= ~negflags; + if (*PL_regcomp_parse == ':') { + PL_regcomp_parse++; + paren = ':'; + break; + } + unknown: + if (*PL_regcomp_parse != ')') + FAIL2("Sequence (?%c...) not recognized", *PL_regcomp_parse); + nextchar(); + *flagp = TRYAGAIN; + return NULL; + } + } + else { + parno = PL_regnpar; + PL_regnpar++; + ret = reganode(OPEN, parno); + open = 1; + } + } else + ret = NULL; + + /* Pick up the branches, linking them together. */ + br = regbranch(&flags, 1); + if (br == NULL) + return(NULL); + if (*PL_regcomp_parse == '|') { + if (!SIZE_ONLY && PL_extralen) { + reginsert(BRANCHJ, br); + } else + reginsert(BRANCH, br); + have_branch = 1; + if (SIZE_ONLY) + PL_extralen += 1; /* For BRANCHJ-BRANCH. */ + } else if (paren == ':') { + *flagp |= flags&SIMPLE; + } + if (open) { /* Starts with OPEN. */ + regtail(ret, br); /* OPEN -> first. */ + } else if (paren != '?') /* Not Conditional */ + ret = br; + if (flags&HASWIDTH) + *flagp |= HASWIDTH; + *flagp |= flags&SPSTART; + lastbr = br; + while (*PL_regcomp_parse == '|') { + if (!SIZE_ONLY && PL_extralen) { + ender = reganode(LONGJMP,0); + regtail(NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */ + } + if (SIZE_ONLY) + PL_extralen += 2; /* Account for LONGJMP. */ + nextchar(); + br = regbranch(&flags, 0); + if (br == NULL) + return(NULL); + regtail(lastbr, br); /* BRANCH -> BRANCH. */ + lastbr = br; + if (flags&HASWIDTH) + *flagp |= HASWIDTH; + *flagp |= flags&SPSTART; + } + + if (have_branch || paren != ':') { + /* Make a closing node, and hook it on the end. */ + switch (paren) { + case ':': + ender = reg_node(TAIL); + break; + case 1: + ender = reganode(CLOSE, parno); + break; + case '<': + case ',': + case '=': + case '!': + *flagp &= ~HASWIDTH; + /* FALL THROUGH */ + case '>': + ender = reg_node(SUCCEED); + break; + case 0: + ender = reg_node(END); + break; + } + regtail(lastbr, ender); + + if (have_branch) { + /* Hook the tails of the branches to the closing node. */ + for (br = ret; br != NULL; br = regnext(br)) { + regoptail(br, ender); + } + } + } + + { + char *p; + static char parens[] = "=!<,>"; + + if (paren && (p = strchr(parens, paren))) { + int node = ((p - parens) % 2) ? UNLESSM : IFMATCH; + int flag = (p - parens) > 1; + + if (paren == '>') + node = SUSPEND, flag = 0; + reginsert(node,ret); + ret->flags = flag; + regtail(ret, reg_node(TAIL)); + } + } + + /* Check for proper termination. */ + if (paren && (PL_regcomp_parse >= PL_regxend || *nextchar() != ')')) { + FAIL("unmatched () in regexp"); + } else if (!paren && PL_regcomp_parse < PL_regxend) { + if (*PL_regcomp_parse == ')') { + FAIL("unmatched () in regexp"); + } else + FAIL("junk on end of regexp"); /* "Can't happen". */ + /* NOTREACHED */ + } + if (paren != 0) { + PL_regflags = oregflags; + } + + return(ret); +} + +/* + - regbranch - one alternative of an | operator + * + * Implements the concatenation operator. + */ +STATIC regnode * +regbranch(I32 *flagp, I32 first) +{ + dTHR; + register regnode *ret; + register regnode *chain = NULL; + register regnode *latest; + I32 flags = 0, c = 0; + + if (first) + ret = NULL; + else { + if (!SIZE_ONLY && PL_extralen) + ret = reganode(BRANCHJ,0); + else + ret = reg_node(BRANCH); + } + + if (!first && SIZE_ONLY) + PL_extralen += 1; /* BRANCHJ */ + + *flagp = WORST; /* Tentatively. */ + + PL_regcomp_parse--; + nextchar(); + while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '|' && *PL_regcomp_parse != ')') { + flags &= ~TRYAGAIN; + latest = regpiece(&flags); + if (latest == NULL) { + if (flags & TRYAGAIN) + continue; + return(NULL); + } else if (ret == NULL) + ret = latest; + *flagp |= flags&HASWIDTH; + if (chain == NULL) /* First piece. */ + *flagp |= flags&SPSTART; + else { + PL_regnaughty++; + regtail(chain, latest); + } + chain = latest; + c++; + } + if (chain == NULL) { /* Loop ran zero times. */ + chain = reg_node(NOTHING); + if (ret == NULL) + ret = chain; + } + if (c == 1) { + *flagp |= flags&SIMPLE; + } + + return(ret); +} + +/* + - regpiece - something followed by possible [*+?] + * + * Note that the branching code sequences used for ? and the general cases + * of * and + are somewhat optimized: they use the same NOTHING node as + * both the endmarker for their branch list and the body of the last branch. + * It might seem that this node could be dispensed with entirely, but the + * endmarker role is not redundant. + */ +STATIC regnode * +regpiece(I32 *flagp) +{ + dTHR; + register regnode *ret; + register char op; + register char *next; + I32 flags; + char *origparse = PL_regcomp_parse; + char *maxpos; + I32 min; + I32 max = REG_INFTY; + + ret = regatom(&flags); + if (ret == NULL) { + if (flags & TRYAGAIN) + *flagp |= TRYAGAIN; + return(NULL); + } + + op = *PL_regcomp_parse; + + if (op == '{' && regcurly(PL_regcomp_parse)) { + next = PL_regcomp_parse + 1; + maxpos = Nullch; + while (isDIGIT(*next) || *next == ',') { + if (*next == ',') { + if (maxpos) + break; + else + maxpos = next; + } + next++; + } + if (*next == '}') { /* got one */ + if (!maxpos) + maxpos = next; + PL_regcomp_parse++; + min = atoi(PL_regcomp_parse); + if (*maxpos == ',') + maxpos++; + else + maxpos = PL_regcomp_parse; + max = atoi(maxpos); + if (!max && *maxpos != '0') + max = REG_INFTY; /* meaning "infinity" */ + else if (max >= REG_INFTY) + FAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1); + PL_regcomp_parse = next; + nextchar(); + + do_curly: + if ((flags&SIMPLE)) { + PL_regnaughty += 2 + PL_regnaughty / 2; + reginsert(CURLY, ret); + } + else { + PL_regnaughty += 4 + PL_regnaughty; /* compound interest */ + regtail(ret, reg_node(WHILEM)); + if (!SIZE_ONLY && PL_extralen) { + reginsert(LONGJMP,ret); + reginsert(NOTHING,ret); + NEXT_OFF(ret) = 3; /* Go over LONGJMP. */ + } + reginsert(CURLYX,ret); + if (!SIZE_ONLY && PL_extralen) + NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */ + regtail(ret, reg_node(NOTHING)); + if (SIZE_ONLY) + PL_extralen += 3; + } + ret->flags = 0; + + if (min > 0) + *flagp = WORST; + if (max > 0) + *flagp |= HASWIDTH; + if (max && max < min) + FAIL("Can't do {n,m} with n > m"); + if (!SIZE_ONLY) { + ARG1_SET(ret, min); + ARG2_SET(ret, max); + } + + goto nest_check; + } + } + + if (!ISMULT1(op)) { + *flagp = flags; + return(ret); + } + +#if 0 /* Now runtime fix should be reliable. */ + if (!(flags&HASWIDTH) && op != '?') + FAIL("regexp *+ operand could be empty"); +#endif + + nextchar(); + + *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH); + + if (op == '*' && (flags&SIMPLE)) { + reginsert(STAR, ret); + ret->flags = 0; + PL_regnaughty += 4; + } + else if (op == '*') { + min = 0; + goto do_curly; + } else if (op == '+' && (flags&SIMPLE)) { + reginsert(PLUS, ret); + ret->flags = 0; + PL_regnaughty += 3; + } + else if (op == '+') { + min = 1; + goto do_curly; + } else if (op == '?') { + min = 0; max = 1; + goto do_curly; + } + nest_check: + if (PL_dowarn && !SIZE_ONLY && !(flags&HASWIDTH) && max > 10000) { + warn("%.*s matches null string many times", + PL_regcomp_parse - origparse, origparse); + } + + if (*PL_regcomp_parse == '?') { + nextchar(); + reginsert(MINMOD, ret); + regtail(ret, ret + NODE_STEP_REGNODE); + } + if (ISMULT2(PL_regcomp_parse)) + FAIL("nested *?+ in regexp"); + + return(ret); +} + +/* + - regatom - the lowest level + * + * Optimization: gobbles an entire sequence of ordinary characters so that + * it can turn them into a single node, which is smaller to store and + * faster to run. Backslashed characters are exceptions, each becoming a + * separate node; the code is simpler that way and it's not worth fixing. + * + * [Yes, it is worth fixing, some scripts can run twice the speed.] + */ +STATIC regnode * +regatom(I32 *flagp) +{ + dTHR; + register regnode *ret = 0; + I32 flags; + + *flagp = WORST; /* Tentatively. */ + +tryagain: + switch (*PL_regcomp_parse) { + case '^': + PL_seen_zerolen++; + nextchar(); + if (PL_regflags & PMf_MULTILINE) + ret = reg_node(MBOL); + else if (PL_regflags & PMf_SINGLELINE) + ret = reg_node(SBOL); + else + ret = reg_node(BOL); + break; + case '$': + if (PL_regcomp_parse[1]) + PL_seen_zerolen++; + nextchar(); + if (PL_regflags & PMf_MULTILINE) + ret = reg_node(MEOL); + else if (PL_regflags & PMf_SINGLELINE) + ret = reg_node(SEOL); + else + ret = reg_node(EOL); + break; + case '.': + nextchar(); + if (PL_regflags & PMf_SINGLELINE) + ret = reg_node(SANY); + else + ret = reg_node(ANY); + PL_regnaughty++; + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': + PL_regcomp_parse++; + ret = regclass(); + *flagp |= HASWIDTH|SIMPLE; + break; + case '(': + nextchar(); + ret = reg(1, &flags); + if (ret == NULL) { + if (flags & TRYAGAIN) + goto tryagain; + return(NULL); + } + *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE); + break; + case '|': + case ')': + if (flags & TRYAGAIN) { + *flagp |= TRYAGAIN; + return NULL; + } + FAIL2("internal urp in regexp at /%s/", PL_regcomp_parse); + /* Supposed to be caught earlier. */ + break; + case '{': + if (!regcurly(PL_regcomp_parse)) { + PL_regcomp_parse++; + goto defchar; + } + /* FALL THROUGH */ + case '?': + case '+': + case '*': + FAIL("?+*{} follows nothing in regexp"); + break; + case '\\': + switch (*++PL_regcomp_parse) { + case 'A': + PL_seen_zerolen++; + ret = reg_node(SBOL); + *flagp |= SIMPLE; + nextchar(); + break; + case 'G': + ret = reg_node(GPOS); + PL_regseen |= REG_SEEN_GPOS; + *flagp |= SIMPLE; + nextchar(); + break; + case 'Z': + ret = reg_node(SEOL); + *flagp |= SIMPLE; + nextchar(); + break; + case 'z': + ret = reg_node(EOS); + *flagp |= SIMPLE; + PL_seen_zerolen++; /* Do not optimize RE away */ + nextchar(); + break; + case 'w': + ret = reg_node((PL_regflags & PMf_LOCALE) ? ALNUML : ALNUM); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'W': + ret = reg_node((PL_regflags & PMf_LOCALE) ? NALNUML : NALNUM); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'b': + PL_seen_zerolen++; + ret = reg_node((PL_regflags & PMf_LOCALE) ? BOUNDL : BOUND); + *flagp |= SIMPLE; + nextchar(); + break; + case 'B': + PL_seen_zerolen++; + ret = reg_node((PL_regflags & PMf_LOCALE) ? NBOUNDL : NBOUND); + *flagp |= SIMPLE; + nextchar(); + break; + case 's': + ret = reg_node((PL_regflags & PMf_LOCALE) ? SPACEL : SPACE); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'S': + ret = reg_node((PL_regflags & PMf_LOCALE) ? NSPACEL : NSPACE); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'd': + ret = reg_node(DIGIT); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'D': + ret = reg_node(NDIGIT); + *flagp |= HASWIDTH|SIMPLE; + nextchar(); + break; + case 'n': + case 'r': + case 't': + case 'f': + case 'e': + case 'a': + case 'x': + case 'c': + case '0': + goto defchar; + case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + { + I32 num = atoi(PL_regcomp_parse); + + if (num > 9 && num >= PL_regnpar) + goto defchar; + else { + if (!SIZE_ONLY && num > PL_regcomp_rx->nparens) + FAIL("reference to nonexistent group"); + PL_regsawback = 1; + ret = reganode((PL_regflags & PMf_FOLD) + ? ((PL_regflags & PMf_LOCALE) ? REFFL : REFF) + : REF, num); + *flagp |= HASWIDTH; + while (isDIGIT(*PL_regcomp_parse)) + PL_regcomp_parse++; + PL_regcomp_parse--; + nextchar(); + } + } + break; + case '\0': + if (PL_regcomp_parse >= PL_regxend) + FAIL("trailing \\ in regexp"); + /* FALL THROUGH */ + default: + goto defchar; + } + break; + + case '#': + if (PL_regflags & PMf_EXTENDED) { + while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != '\n') PL_regcomp_parse++; + if (PL_regcomp_parse < PL_regxend) + goto tryagain; + } + /* FALL THROUGH */ + + default: { + register I32 len; + register U8 ender; + register char *p; + char *oldp, *s; + I32 numlen; + + PL_regcomp_parse++; + + defchar: + ret = reg_node((PL_regflags & PMf_FOLD) + ? ((PL_regflags & PMf_LOCALE) ? EXACTFL : EXACTF) + : EXACT); + s = (char *) OPERAND(ret); + regc(0, s++); /* save spot for len */ + for (len = 0, p = PL_regcomp_parse - 1; + len < 127 && p < PL_regxend; + len++) + { + oldp = p; + + if (PL_regflags & PMf_EXTENDED) + p = regwhite(p, PL_regxend); + switch (*p) { + case '^': + case '$': + case '.': + case '[': + case '(': + case ')': + case '|': + goto loopdone; + case '\\': + switch (*++p) { + case 'A': + case 'G': + case 'Z': + case 'z': + case 'w': + case 'W': + case 'b': + case 'B': + case 's': + case 'S': + case 'd': + case 'D': + --p; + goto loopdone; + case 'n': + ender = '\n'; + p++; + break; + case 'r': + ender = '\r'; + p++; + break; + case 't': + ender = '\t'; + p++; + break; + case 'f': + ender = '\f'; + p++; + break; + case 'e': + ender = '\033'; + p++; + break; + case 'a': + ender = '\007'; + p++; + break; + case 'x': + ender = scan_hex(++p, 2, &numlen); + p += numlen; + break; + case 'c': + p++; + ender = UCHARAT(p++); + ender = toCTRL(ender); + break; + case '0': case '1': case '2': case '3':case '4': + case '5': case '6': case '7': case '8':case '9': + if (*p == '0' || + (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) { + ender = scan_oct(p, 3, &numlen); + p += numlen; + } + else { + --p; + goto loopdone; + } + break; + case '\0': + if (p >= PL_regxend) + FAIL("trailing \\ in regexp"); + /* FALL THROUGH */ + default: + ender = *p++; + break; + } + break; + default: + ender = *p++; + break; + } + if (PL_regflags & PMf_EXTENDED) + p = regwhite(p, PL_regxend); + if (ISMULT2(p)) { /* Back off on ?+*. */ + if (len) + p = oldp; + else { + len++; + regc(ender, s++); + } + break; + } + regc(ender, s++); + } + loopdone: + PL_regcomp_parse = p - 1; + nextchar(); + if (len < 0) + FAIL("internal disaster in regexp"); + if (len > 0) + *flagp |= HASWIDTH; + if (len == 1) + *flagp |= SIMPLE; + if (!SIZE_ONLY) + *OPERAND(ret) = len; + regc('\0', s++); + if (SIZE_ONLY) { + PL_regsize += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode); + } else { + PL_regcode += (len + 2 + sizeof(regnode) - 1) / sizeof(regnode); + } + } + break; + } + + return(ret); +} + +STATIC char * +regwhite(char *p, char *e) +{ + while (p < e) { + if (isSPACE(*p)) + ++p; + else if (*p == '#') { + do { + p++; + } while (p < e && *p != '\n'); + } + else + break; + } + return p; +} + +STATIC regnode * +regclass(void) +{ + dTHR; + register char *opnd, *s; + register I32 Class; + register I32 lastclass = 1234; + register I32 range = 0; + register regnode *ret; + register I32 def; + I32 numlen; + + s = opnd = (char *) OPERAND(PL_regcode); + ret = reg_node(ANYOF); + for (Class = 0; Class < 33; Class++) + regc(0, s++); + if (*PL_regcomp_parse == '^') { /* Complement of range. */ + PL_regnaughty++; + PL_regcomp_parse++; + if (!SIZE_ONLY) + *opnd |= ANYOF_INVERT; + } + if (!SIZE_ONLY) { + PL_regcode += ANY_SKIP; + if (PL_regflags & PMf_FOLD) + *opnd |= ANYOF_FOLD; + if (PL_regflags & PMf_LOCALE) + *opnd |= ANYOF_LOCALE; + } else { + PL_regsize += ANY_SKIP; + } + if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-') + goto skipcond; /* allow 1st char to be ] or - */ + while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') { + skipcond: + Class = UCHARAT(PL_regcomp_parse++); + if (Class == '[' && PL_regcomp_parse + 1 < PL_regxend && + /* I smell either [: or [= or [. -- POSIX has been here, right? */ + (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) { + char posixccc = *PL_regcomp_parse; + char* posixccs = PL_regcomp_parse++; + + while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != posixccc) + PL_regcomp_parse++; + if (PL_regcomp_parse == PL_regxend) + /* Grandfather lone [:, [=, [. */ + PL_regcomp_parse = posixccs; + else { + PL_regcomp_parse++; /* skip over the posixccc */ + if (*PL_regcomp_parse == ']') { + /* Not Implemented Yet. + * (POSIX Extended Character Classes, that is) + * The text between e.g. [: and :] would start + * at posixccs + 1 and stop at regcomp_parse - 2. */ + if (PL_dowarn && !SIZE_ONLY) + warn("Character class syntax [%c %c] is reserved for future extensions", posixccc, posixccc); + PL_regcomp_parse++; /* skip over the ending ] */ + } + } + } + if (Class == '\\') { + Class = UCHARAT(PL_regcomp_parse++); + switch (Class) { + case 'w': + if (!SIZE_ONLY) { + if (PL_regflags & PMf_LOCALE) + *opnd |= ANYOF_ALNUML; + else { + for (Class = 0; Class < 256; Class++) + if (isALNUM(Class)) + ANYOF_SET(opnd, Class); + } + } + lastclass = 1234; + continue; + case 'W': + if (!SIZE_ONLY) { + if (PL_regflags & PMf_LOCALE) + *opnd |= ANYOF_NALNUML; + else { + for (Class = 0; Class < 256; Class++) + if (!isALNUM(Class)) + ANYOF_SET(opnd, Class); + } + } + lastclass = 1234; + continue; + case 's': + if (!SIZE_ONLY) { + if (PL_regflags & PMf_LOCALE) + *opnd |= ANYOF_SPACEL; + else { + for (Class = 0; Class < 256; Class++) + if (isSPACE(Class)) + ANYOF_SET(opnd, Class); + } + } + lastclass = 1234; + continue; + case 'S': + if (!SIZE_ONLY) { + if (PL_regflags & PMf_LOCALE) + *opnd |= ANYOF_NSPACEL; + else { + for (Class = 0; Class < 256; Class++) + if (!isSPACE(Class)) + ANYOF_SET(opnd, Class); + } + } + lastclass = 1234; + continue; + case 'd': + if (!SIZE_ONLY) { + for (Class = '0'; Class <= '9'; Class++) + ANYOF_SET(opnd, Class); + } + lastclass = 1234; + continue; + case 'D': + if (!SIZE_ONLY) { + for (Class = 0; Class < '0'; Class++) + ANYOF_SET(opnd, Class); + for (Class = '9' + 1; Class < 256; Class++) + ANYOF_SET(opnd, Class); + } + lastclass = 1234; + continue; + case 'n': + Class = '\n'; + break; + case 'r': + Class = '\r'; + break; + case 't': + Class = '\t'; + break; + case 'f': + Class = '\f'; + break; + case 'b': + Class = '\b'; + break; + case 'e': + Class = '\033'; + break; + case 'a': + Class = '\007'; + break; + case 'x': + Class = scan_hex(PL_regcomp_parse, 2, &numlen); + PL_regcomp_parse += numlen; + break; + case 'c': + Class = UCHARAT(PL_regcomp_parse++); + Class = toCTRL(Class); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + Class = scan_oct(--PL_regcomp_parse, 3, &numlen); + PL_regcomp_parse += numlen; + break; + } + } + if (range) { + if (lastclass > Class) + FAIL("invalid [] range in regexp"); + range = 0; + } + else { + lastclass = Class; + if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend && + PL_regcomp_parse[1] != ']') { + PL_regcomp_parse++; + range = 1; + continue; /* do it next time */ + } + } + if (!SIZE_ONLY) { + for ( ; lastclass <= Class; lastclass++) + ANYOF_SET(opnd, lastclass); + } + lastclass = Class; + } + if (*PL_regcomp_parse != ']') + FAIL("unmatched [] in regexp"); + nextchar(); + /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */ + if (!SIZE_ONLY && (*opnd & (0xFF ^ ANYOF_INVERT)) == ANYOF_FOLD) { + for (Class = 0; Class < 256; ++Class) { + if (ANYOF_TEST(opnd, Class)) { + I32 cf = fold[Class]; + ANYOF_SET(opnd, cf); + } + } + *opnd &= ~ANYOF_FOLD; + } + /* optimize inverted simple patterns (e.g. [^a-z]) */ + if (!SIZE_ONLY && (*opnd & 0xFF) == ANYOF_INVERT) { + for (Class = 0; Class < 32; ++Class) + opnd[1 + Class] ^= 0xFF; + *opnd = 0; + } + return ret; +} + +STATIC char* +nextchar(void) +{ + dTHR; + char* retval = PL_regcomp_parse++; + + for (;;) { + if (*PL_regcomp_parse == '(' && PL_regcomp_parse[1] == '?' && + PL_regcomp_parse[2] == '#') { + while (*PL_regcomp_parse && *PL_regcomp_parse != ')') + PL_regcomp_parse++; + PL_regcomp_parse++; + continue; + } + if (PL_regflags & PMf_EXTENDED) { + if (isSPACE(*PL_regcomp_parse)) { + PL_regcomp_parse++; + continue; + } + else if (*PL_regcomp_parse == '#') { + while (*PL_regcomp_parse && *PL_regcomp_parse != '\n') + PL_regcomp_parse++; + PL_regcomp_parse++; + continue; + } + } + return retval; + } +} + +/* +- reg_node - emit a node +*/ +STATIC regnode * /* Location. */ +reg_node(U8 op) +{ + dTHR; + register regnode *ret; + register regnode *ptr; + + ret = PL_regcode; + if (SIZE_ONLY) { + SIZE_ALIGN(PL_regsize); + PL_regsize += 1; + return(ret); + } + + NODE_ALIGN_FILL(ret); + ptr = ret; + FILL_ADVANCE_NODE(ptr, op); + PL_regcode = ptr; + + return(ret); +} + +/* +- reganode - emit a node with an argument +*/ +STATIC regnode * /* Location. */ +reganode(U8 op, U32 arg) +{ + dTHR; + register regnode *ret; + register regnode *ptr; + + ret = PL_regcode; + if (SIZE_ONLY) { + SIZE_ALIGN(PL_regsize); + PL_regsize += 2; + return(ret); + } + + NODE_ALIGN_FILL(ret); + ptr = ret; + FILL_ADVANCE_NODE_ARG(ptr, op, arg); + PL_regcode = ptr; + + return(ret); +} + +/* +- regc - emit (if appropriate) a byte of code +*/ +STATIC void +regc(U8 b, char* s) +{ + dTHR; + if (!SIZE_ONLY) + *s = b; +} + +/* +- reginsert - insert an operator in front of already-emitted operand +* +* Means relocating the operand. +*/ +STATIC void +reginsert(U8 op, regnode *opnd) +{ + dTHR; + register regnode *src; + register regnode *dst; + register regnode *place; + register int offset = regarglen[(U8)op]; + +/* (regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */ + + if (SIZE_ONLY) { + PL_regsize += NODE_STEP_REGNODE + offset; + return; + } + + src = PL_regcode; + PL_regcode += NODE_STEP_REGNODE + offset; + dst = PL_regcode; + while (src > opnd) + StructCopy(--src, --dst, regnode); + + place = opnd; /* Op node, where operand used to be. */ + src = NEXTOPER(place); + FILL_ADVANCE_NODE(place, op); + Zero(src, offset, regnode); +} + +/* +- regtail - set the next-pointer at the end of a node chain of p to val. +*/ +STATIC void +regtail(regnode *p, regnode *val) +{ + dTHR; + register regnode *scan; + register regnode *temp; + register I32 offset; + + if (SIZE_ONLY) + return; + + /* Find last node. */ + scan = p; + for (;;) { + temp = regnext(scan); + if (temp == NULL) + break; + scan = temp; + } + + if (reg_off_by_arg[OP(scan)]) { + ARG_SET(scan, val - scan); + } else { + NEXT_OFF(scan) = val - scan; + } +} + +/* +- regoptail - regtail on operand of first argument; nop if operandless +*/ +STATIC void +regoptail(regnode *p, regnode *val) +{ + dTHR; + /* "Operandless" and "op != BRANCH" are synonymous in practice. */ + if (p == NULL || SIZE_ONLY) + return; + if (regkind[(U8)OP(p)] == BRANCH) { + regtail(NEXTOPER(p), val); + } else if ( regkind[(U8)OP(p)] == BRANCHJ) { + regtail(NEXTOPER(NEXTOPER(p)), val); + } else + return; +} + +/* + - regcurly - a little FSA that accepts {\d+,?\d*} + */ +STATIC I32 +regcurly(register char *s) +{ + if (*s++ != '{') + return FALSE; + if (!isDIGIT(*s)) + return FALSE; + while (isDIGIT(*s)) + s++; + if (*s == ',') + s++; + while (isDIGIT(*s)) + s++; + if (*s != '}') + return FALSE; + return TRUE; +} + + +STATIC regnode * +dumpuntil(regnode *start, regnode *node, regnode *last, SV* sv, I32 l) +{ +#ifdef DEBUGGING + register char op = EXACT; /* Arbitrary non-END op. */ + register regnode *next, *onode; + + while (op != END && (!last || node < last)) { + /* While that wasn't END last time... */ + + NODE_ALIGN(node); + op = OP(node); + if (op == CLOSE) + l--; + next = regnext(node); + /* Where, what. */ + if (OP(node) == OPTIMIZED) + goto after_print; + regprop(sv, node); + PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start, + 2*l + 1, "", SvPVX(sv)); + if (next == NULL) /* Next ptr. */ + PerlIO_printf(Perl_debug_log, "(0)"); + else + PerlIO_printf(Perl_debug_log, "(%d)", next - start); + (void)PerlIO_putc(Perl_debug_log, '\n'); + after_print: + if (regkind[(U8)op] == BRANCHJ) { + register regnode *nnode = (OP(next) == LONGJMP + ? regnext(next) + : next); + if (last && nnode > last) + nnode = last; + node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1); + } else if (regkind[(U8)op] == BRANCH) { + node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1); + } else if ( op == CURLY) { /* `next' might be very big: optimizer */ + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1); + } else if (regkind[(U8)op] == CURLY && op != CURLYX) { + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + next, sv, l + 1); + } else if ( op == PLUS || op == STAR) { + node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); + } else if (op == ANYOF) { + node = NEXTOPER(node); + node += ANY_SKIP; + } else if (regkind[(U8)op] == EXACT) { + /* Literal string, where present. */ + node += ((*OPERAND(node)) + 2 + sizeof(regnode) - 1) / sizeof(regnode); + node = NEXTOPER(node); + } else { + node = NEXTOPER(node); + node += regarglen[(U8)op]; + } + if (op == CURLYX || op == OPEN) + l++; + else if (op == WHILEM) + l--; + } +#endif /* DEBUGGING */ + return node; +} + +/* + - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form + */ +void +regdump(regexp *r) +{ +#ifdef DEBUGGING + dTHR; + SV *sv = sv_newmortal(); + + (void)dumpuntil(r->program, r->program + 1, NULL, sv, 0); + + /* Header fields of interest. */ + if (r->anchored_substr) + PerlIO_printf(Perl_debug_log, "anchored `%s%s%s'%s at %d ", + PL_colors[0], + SvPVX(r->anchored_substr), + PL_colors[1], + SvTAIL(r->anchored_substr) ? "$" : "", + r->anchored_offset); + if (r->float_substr) + PerlIO_printf(Perl_debug_log, "floating `%s%s%s'%s at %d..%u ", + PL_colors[0], + SvPVX(r->float_substr), + PL_colors[1], + SvTAIL(r->float_substr) ? "$" : "", + r->float_min_offset, r->float_max_offset); + if (r->check_substr) + PerlIO_printf(Perl_debug_log, + r->check_substr == r->float_substr + ? "(checking floating" : "(checking anchored"); + if (r->reganch & ROPT_NOSCAN) + PerlIO_printf(Perl_debug_log, " noscan"); + if (r->reganch & ROPT_CHECK_ALL) + PerlIO_printf(Perl_debug_log, " isall"); + if (r->check_substr) + PerlIO_printf(Perl_debug_log, ") "); + + if (r->regstclass) { + regprop(sv, r->regstclass); + PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv)); + } + if (r->reganch & ROPT_ANCH) { + PerlIO_printf(Perl_debug_log, "anchored"); + if (r->reganch & ROPT_ANCH_BOL) + PerlIO_printf(Perl_debug_log, "(BOL)"); + if (r->reganch & ROPT_ANCH_MBOL) + PerlIO_printf(Perl_debug_log, "(MBOL)"); + if (r->reganch & ROPT_ANCH_GPOS) + PerlIO_printf(Perl_debug_log, "(GPOS)"); + PerlIO_putc(Perl_debug_log, ' '); + } + if (r->reganch & ROPT_GPOS_SEEN) + PerlIO_printf(Perl_debug_log, "GPOS "); + if (r->reganch & ROPT_SKIP) + PerlIO_printf(Perl_debug_log, "plus "); + if (r->reganch & ROPT_IMPLICIT) + PerlIO_printf(Perl_debug_log, "implicit "); + PerlIO_printf(Perl_debug_log, "minlen %ld ", (long) r->minlen); + if (r->reganch & ROPT_EVAL_SEEN) + PerlIO_printf(Perl_debug_log, "with eval "); + PerlIO_printf(Perl_debug_log, "\n"); +#endif /* DEBUGGING */ +} + +/* +- regprop - printable representation of opcode +*/ +void +regprop(SV *sv, regnode *o) +{ +#ifdef DEBUGGING + dTHR; + register char *p = 0; + + sv_setpvn(sv, "", 0); + switch (OP(o)) { + case BOL: + p = "BOL"; + break; + case MBOL: + p = "MBOL"; + break; + case SBOL: + p = "SBOL"; + break; + case EOL: + p = "EOL"; + break; + case EOS: + p = "EOS"; + break; + case MEOL: + p = "MEOL"; + break; + case SEOL: + p = "SEOL"; + break; + case ANY: + p = "ANY"; + break; + case SANY: + p = "SANY"; + break; + case ANYOF: + p = "ANYOF"; + break; + case BRANCH: + p = "BRANCH"; + break; + case EXACT: + sv_catpvf(sv, "EXACT <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]); + break; + case EXACTF: + sv_catpvf(sv, "EXACTF <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]); + break; + case EXACTFL: + sv_catpvf(sv, "EXACTFL <%s%s%s>", PL_colors[0], OPERAND(o) + 1, PL_colors[1]); + break; + case NOTHING: + p = "NOTHING"; + break; + case TAIL: + p = "TAIL"; + break; + case BACK: + p = "BACK"; + break; + case END: + p = "END"; + break; + case BOUND: + p = "BOUND"; + break; + case BOUNDL: + p = "BOUNDL"; + break; + case NBOUND: + p = "NBOUND"; + break; + case NBOUNDL: + p = "NBOUNDL"; + break; + case CURLY: + sv_catpvf(sv, "CURLY {%d,%d}", ARG1(o), ARG2(o)); + break; + case CURLYM: + sv_catpvf(sv, "CURLYM[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o)); + break; + case CURLYN: + sv_catpvf(sv, "CURLYN[%d] {%d,%d}", o->flags, ARG1(o), ARG2(o)); + break; + case CURLYX: + sv_catpvf(sv, "CURLYX {%d,%d}", ARG1(o), ARG2(o)); + break; + case REF: + sv_catpvf(sv, "REF%d", ARG(o)); + break; + case REFF: + sv_catpvf(sv, "REFF%d", ARG(o)); + break; + case REFFL: + sv_catpvf(sv, "REFFL%d", ARG(o)); + break; + case OPEN: + sv_catpvf(sv, "OPEN%d", ARG(o)); + break; + case CLOSE: + sv_catpvf(sv, "CLOSE%d", ARG(o)); + p = NULL; + break; + case STAR: + p = "STAR"; + break; + case PLUS: + p = "PLUS"; + break; + case MINMOD: + p = "MINMOD"; + break; + case GPOS: + p = "GPOS"; + break; + case UNLESSM: + sv_catpvf(sv, "UNLESSM[-%d]", o->flags); + break; + case IFMATCH: + sv_catpvf(sv, "IFMATCH[-%d]", o->flags); + break; + case SUCCEED: + p = "SUCCEED"; + break; + case WHILEM: + p = "WHILEM"; + break; + case DIGIT: + p = "DIGIT"; + break; + case NDIGIT: + p = "NDIGIT"; + break; + case ALNUM: + p = "ALNUM"; + break; + case NALNUM: + p = "NALNUM"; + break; + case SPACE: + p = "SPACE"; + break; + case NSPACE: + p = "NSPACE"; + break; + case ALNUML: + p = "ALNUML"; + break; + case NALNUML: + p = "NALNUML"; + break; + case SPACEL: + p = "SPACEL"; + break; + case NSPACEL: + p = "NSPACEL"; + break; + case EVAL: + p = "EVAL"; + break; + case LONGJMP: + p = "LONGJMP"; + break; + case BRANCHJ: + p = "BRANCHJ"; + break; + case IFTHEN: + p = "IFTHEN"; + break; + case GROUPP: + sv_catpvf(sv, "GROUPP%d", ARG(o)); + break; + case LOGICAL: + p = "LOGICAL"; + break; + case SUSPEND: + p = "SUSPEND"; + break; + case RENUM: + p = "RENUM"; + break; + case OPTIMIZED: + p = "OPTIMIZED"; + break; + default: + FAIL("corrupted regexp opcode"); + } + if (p) + sv_catpv(sv, p); +#endif /* DEBUGGING */ +} + +void +pregfree(struct regexp *r) +{ + dTHR; + if (!r || (--r->refcnt > 0)) + return; + if (r->precomp) + Safefree(r->precomp); + if (r->subbase) + Safefree(r->subbase); + if (r->substrs) { + if (r->anchored_substr) + SvREFCNT_dec(r->anchored_substr); + if (r->float_substr) + SvREFCNT_dec(r->float_substr); + Safefree(r->substrs); + } + if (r->data) { + int n = r->data->count; + while (--n >= 0) { + switch (r->data->what[n]) { + case 's': + SvREFCNT_dec((SV*)r->data->data[n]); + break; + case 'o': + op_free((OP_4tree*)r->data->data[n]); + break; + case 'n': + break; + default: + FAIL2("panic: regfree data code '%c'", r->data->what[n]); + } + } + Safefree(r->data->what); + Safefree(r->data); + } + Safefree(r->startp); + Safefree(r->endp); + Safefree(r); +} + +/* + - regnext - dig the "next" pointer out of a node + * + * [Note, when REGALIGN is defined there are two places in regmatch() + * that bypass this code for speed.] + */ +regnode * +regnext(register regnode *p) +{ + dTHR; + register I32 offset; + + if (p == &PL_regdummy) + return(NULL); + + offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p)); + if (offset == 0) + return(NULL); + + return(p+offset); +} + +STATIC void +re_croak2(const char* pat1,const char* pat2,...) +{ + va_list args; + STRLEN l1 = strlen(pat1); + STRLEN l2 = strlen(pat2); + char buf[512]; + char *message; + + if (l1 > 510) + l1 = 510; + if (l1 + l2 > 510) + l2 = 510 - l1; + Copy(pat1, buf, l1 , char); + Copy(pat2, buf + l1, l2 , char); + buf[l1 + l2] = '\n'; + buf[l1 + l2 + 1] = '\0'; + va_start(args, pat2); + message = mess(buf, &args); + va_end(args); + l1 = strlen(message); + if (l1 > 512) + l1 = 512; + Copy(message, buf, l1 , char); + buf[l1] = '\0'; /* Overwrite \n */ + croak("%s", buf); +} diff --git a/contrib/perl5/regcomp.h b/contrib/perl5/regcomp.h new file mode 100644 index 00000000000..526b885eecf --- /dev/null +++ b/contrib/perl5/regcomp.h @@ -0,0 +1,222 @@ +/* regcomp.h + */ + +typedef OP OP_4tree; /* Will be redefined later. */ + +/* + * The "internal use only" fields in regexp.h are present to pass info from + * compile to execute that permits the execute phase to run lots faster on + * simple cases. They are: + * + * regstart sv that must begin a match; Nullch if none obvious + * reganch is the match anchored (at beginning-of-line only)? + * regmust string (pointer into program) that match must include, or NULL + * [regmust changed to SV* for bminstr()--law] + * regmlen length of regmust string + * [regmlen not used currently] + * + * Regstart and reganch permit very fast decisions on suitable starting points + * for a match, cutting down the work a lot. Regmust permits fast rejection + * of lines that cannot possibly match. The regmust tests are costly enough + * that pregcomp() supplies a regmust only if the r.e. contains something + * potentially expensive (at present, the only such thing detected is * or + + * at the start of the r.e., which can involve a lot of backup). Regmlen is + * supplied because the test in pregexec() needs it and pregcomp() is computing + * it anyway. + * [regmust is now supplied always. The tests that use regmust have a + * heuristic that disables the test if it usually matches.] + * + * [In fact, we now use regmust in many cases to locate where the search + * starts in the string, so if regback is >= 0, the regmust search is never + * wasted effort. The regback variable says how many characters back from + * where regmust matched is the earliest possible start of the match. + * For instance, /[a-z].foo/ has a regmust of 'foo' and a regback of 2.] + */ + +/* + * Structure for regexp "program". This is essentially a linear encoding + * of a nondeterministic finite-state machine (aka syntax charts or + * "railroad normal form" in parsing technology). Each node is an opcode + * plus a "next" pointer, possibly plus an operand. "Next" pointers of + * all nodes except BRANCH implement concatenation; a "next" pointer with + * a BRANCH on both ends of it is connecting two alternatives. (Here we + * have one of the subtle syntax dependencies: an individual BRANCH (as + * opposed to a collection of them) is never concatenated with anything + * because of operator precedence.) The operand of some types of node is + * a literal string; for others, it is a node leading into a sub-FSM. In + * particular, the operand of a BRANCH node is the first node of the branch. + * (NB this is *not* a tree structure: the tail of the branch connects + * to the thing following the set of BRANCHes.) The opcodes are: + */ + +/* + * A node is one char of opcode followed by two chars of "next" pointer. + * "Next" pointers are stored as two 8-bit pieces, high order first. The + * value is a positive offset from the opcode of the node containing it. + * An operand, if any, simply follows the node. (Note that much of the + * code generation knows about this implicit relationship.) + * + * Using two bytes for the "next" pointer is vast overkill for most things, + * but allows patterns to get big without disasters. + * + * [The "next" pointer is always aligned on an even + * boundary, and reads the offset directly as a short. Also, there is no + * special test to reverse the sign of BACK pointers since the offset is + * stored negative.] + */ + +struct regnode_string { + U8 flags; + U8 type; + U16 next_off; + U8 string[1]; +}; + +struct regnode_1 { + U8 flags; + U8 type; + U16 next_off; + U32 arg1; +}; + +struct regnode_2 { + U8 flags; + U8 type; + U16 next_off; + U16 arg1; + U16 arg2; +}; + +/* XXX fix this description. + Impose a limit of REG_INFTY on various pattern matching operations + to limit stack growth and to avoid "infinite" recursions. +*/ +/* The default size for REG_INFTY is I16_MAX, which is the same as + SHORT_MAX (see perl.h). Unfortunately I16 isn't necessarily 16 bits + (see handy.h). On the Cray C90, sizeof(short)==4 and hence I16_MAX is + ((1<<31)-1), while on the Cray T90, sizeof(short)==8 and I16_MAX is + ((1<<63)-1). To limit stack growth to reasonable sizes, supply a + smaller default. + --Andy Dougherty 11 June 1998 +*/ +#if SHORTSIZE > 2 +# ifndef REG_INFTY +# define REG_INFTY ((1<<15)-1) +# endif +#endif + +#ifndef REG_INFTY +# define REG_INFTY I16_MAX +#endif + +#define ARG_VALUE(arg) (arg) +#define ARG__SET(arg,val) ((arg) = (val)) + +#define ARG(p) ARG_VALUE(ARG_LOC(p)) +#define ARG1(p) ARG_VALUE(ARG1_LOC(p)) +#define ARG2(p) ARG_VALUE(ARG2_LOC(p)) +#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val)) +#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val)) +#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val)) + +#ifndef lint +# define NEXT_OFF(p) ((p)->next_off) +# define NODE_ALIGN(node) +# define NODE_ALIGN_FILL(node) ((node)->flags = 0xde) /* deadbeef */ +#else /* lint */ +# define NEXT_OFF(p) 0 +# define NODE_ALIGN(node) +# define NODE_ALIGN_FILL(node) +#endif /* lint */ + +#define SIZE_ALIGN NODE_ALIGN + +#define OP(p) ((p)->type) +#define OPERAND(p) (((struct regnode_string *)p)->string) +#define NODE_ALIGN(node) +#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1) +#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1) +#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2) +#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */ +#define EXTRA_STEP_2ARGS EXTRA_SIZE(struct regnode_2) + +#define NODE_STEP_B 4 + +#define NEXTOPER(p) ((p) + NODE_STEP_REGNODE) +#define PREVOPER(p) ((p) - NODE_STEP_REGNODE) + +#define FILL_ADVANCE_NODE(ptr, op) STMT_START { \ + (ptr)->type = op; (ptr)->next_off = 0; (ptr)++; } STMT_END +#define FILL_ADVANCE_NODE_ARG(ptr, op, arg) STMT_START { \ + ARG_SET(ptr, arg); FILL_ADVANCE_NODE(ptr, op); (ptr) += 1; } STMT_END + +#define MAGIC 0234 + +#define SIZE_ONLY (PL_regcode == &PL_regdummy) + +/* Flags for first parameter byte of ANYOF */ +#define ANYOF_INVERT 0x40 +#define ANYOF_FOLD 0x20 +#define ANYOF_LOCALE 0x10 +#define ANYOF_ISA 0x0F +#define ANYOF_ALNUML 0x08 +#define ANYOF_NALNUML 0x04 +#define ANYOF_SPACEL 0x02 +#define ANYOF_NSPACEL 0x01 + +/* Utility macros for bitmap of ANYOF */ +#define ANYOF_BYTE(p,c) (p)[1 + (((c) >> 3) & 31)] +#define ANYOF_BIT(c) (1 << ((c) & 7)) +#define ANYOF_SET(p,c) (ANYOF_BYTE(p,c) |= ANYOF_BIT(c)) +#define ANYOF_CLEAR(p,c) (ANYOF_BYTE(p,c) &= ~ANYOF_BIT(c)) +#define ANYOF_TEST(p,c) (ANYOF_BYTE(p,c) & ANYOF_BIT(c)) + +#define ANY_SKIP ((33 - 1)/sizeof(regnode) + 1) + +/* + * Utility definitions. + */ +#ifndef lint +#ifndef CHARMASK +#define UCHARAT(p) ((int)*(unsigned char *)(p)) +#else +#define UCHARAT(p) ((int)*(p)&CHARMASK) +#endif +#else /* lint */ +#define UCHARAT(p) PL_regdummy +#endif /* lint */ + +#define FAIL(m) croak ("/%.127s/: %s", PL_regprecomp,m) +#define FAIL2(pat,m) re_croak2("/%.127s/: ",pat,PL_regprecomp,m) + +#define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode)) + +#define REG_SEEN_ZERO_LEN 1 +#define REG_SEEN_LOOKBEHIND 2 +#define REG_SEEN_GPOS 4 +#define REG_SEEN_EVAL 8 + +#include "regnodes.h" + +/* The following have no fixed length. char* since we do strchr on it. */ +#ifndef DOINIT +EXTCONST char varies[]; +#else +EXTCONST char varies[] = { + BRANCH, BACK, STAR, PLUS, CURLY, CURLYX, REF, REFF, REFFL, + WHILEM, CURLYM, CURLYN, BRANCHJ, IFTHEN, SUSPEND, 0 +}; +#endif + +/* The following always have a length of 1. char* since we do strchr on it. */ +#ifndef DOINIT +EXTCONST char simple[]; +#else +EXTCONST char simple[] = { + ANY, SANY, ANYOF, + ALNUM, ALNUML, NALNUM, NALNUML, + SPACE, SPACEL, NSPACE, NSPACEL, + DIGIT, NDIGIT, 0 +}; +#endif + diff --git a/contrib/perl5/regcomp.pl b/contrib/perl5/regcomp.pl new file mode 100644 index 00000000000..cfe59adc221 --- /dev/null +++ b/contrib/perl5/regcomp.pl @@ -0,0 +1,98 @@ +#use Fatal qw(open close rename chmod unlink); +open DESC, 'regcomp.sym'; +$ind = 0; + +while () { + next if /^\s*($|\#)/; + $ind++; + chomp; + ($name[$ind], $desc, $rest[$ind]) = split /\t+/, $_, 3; + ($type[$ind], $code[$ind], $args[$ind], $longj[$ind]) + = split /[,\s]\s*/, $desc, 4; +} +close DESC; +$tot = $ind; + +$tmp_h = 'tmp_reg.h'; + +unlink $tmp_h if -f $tmp_h; + +open OUT, ">$tmp_h"; + +print OUT < parenfloor; p--) { + SSPUSHPTR(PL_regendp[p]); + SSPUSHPTR(PL_regstartp[p]); + SSPUSHPTR(PL_reg_start_tmp[p]); + SSPUSHINT(p); + } + SSPUSHINT(PL_regsize); + SSPUSHINT(*PL_reglastparen); + SSPUSHPTR(PL_reginput); + SSPUSHINT(i + 3); + SSPUSHINT(SAVEt_REGCONTEXT); + return retval; +} + +/* These are needed since we do not localize EVAL nodes: */ +# define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, \ + " Setting an EVAL scope, savestack=%i\n", \ + PL_savestack_ix)); lastcp = PL_savestack_ix + +# define REGCP_UNWIND DEBUG_r(lastcp != PL_savestack_ix ? \ + PerlIO_printf(Perl_debug_log, \ + " Clearing an EVAL scope, savestack=%i..%i\n", \ + lastcp, PL_savestack_ix) : 0); regcpblow(lastcp) + +STATIC char * +regcppop(void) +{ + dTHR; + I32 i = SSPOPINT; + U32 paren = 0; + char *input; + char *tmps; + assert(i == SAVEt_REGCONTEXT); + i = SSPOPINT; + input = (char *) SSPOPPTR; + *PL_reglastparen = SSPOPINT; + PL_regsize = SSPOPINT; + for (i -= 3; i > 0; i -= 4) { + paren = (U32)SSPOPINT; + PL_reg_start_tmp[paren] = (char *) SSPOPPTR; + PL_regstartp[paren] = (char *) SSPOPPTR; + tmps = (char*)SSPOPPTR; + if (paren <= *PL_reglastparen) + PL_regendp[paren] = tmps; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + " restoring \\%d to %d(%d)..%d%s\n", + paren, PL_regstartp[paren] - PL_regbol, + PL_reg_start_tmp[paren] - PL_regbol, + PL_regendp[paren] - PL_regbol, + (paren > *PL_reglastparen ? "(no)" : "")); + ); + } + DEBUG_r( + if (*PL_reglastparen + 1 <= PL_regnpar) { + PerlIO_printf(Perl_debug_log, + " restoring \\%d..\\%d to undef\n", + *PL_reglastparen + 1, PL_regnpar); + } + ); + for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) { + if (paren > PL_regsize) + PL_regstartp[paren] = Nullch; + PL_regendp[paren] = Nullch; + } + return input; +} + +#define regcpblow(cp) LEAVE_SCOPE(cp) + +/* + * pregexec and friends + */ + +/* + - pregexec - match a regexp against a string + */ +I32 +pregexec(register regexp *prog, char *stringarg, register char *strend, + char *strbeg, I32 minend, SV *screamer, U32 nosave) +/* strend: pointer to null at end of string */ +/* strbeg: real beginning of string */ +/* minend: end of match must be >=minend after stringarg. */ +/* nosave: For optimizations. */ +{ + return + regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL, + nosave ? 0 : REXEC_COPY_STR); +} + +/* + - regexec_flags - match a regexp against a string + */ +I32 +regexec_flags(register regexp *prog, char *stringarg, register char *strend, + char *strbeg, I32 minend, SV *screamer, void *data, U32 flags) +/* strend: pointer to null at end of string */ +/* strbeg: real beginning of string */ +/* minend: end of match must be >=minend after stringarg. */ +/* data: May be used for some additional optimizations. */ +/* nosave: For optimizations. */ +{ + dTHR; + register char *s; + register regnode *c; + register char *startpos = stringarg; + register I32 tmp; + I32 minlen; /* must match at least this many chars */ + I32 dontbother = 0; /* how many characters not to try at end */ + CURCUR cc; + I32 start_shift = 0; /* Offset of the start to find + constant substr. */ + I32 end_shift = 0; /* Same for the end. */ + I32 scream_pos = -1; /* Internal iterator of scream. */ + char *scream_olds; + SV* oreplsv = GvSV(PL_replgv); + + cc.cur = 0; + cc.oldcc = 0; + PL_regcc = &cc; + + PL_regprecomp = prog->precomp; /* Needed for error messages. */ +#ifdef DEBUGGING + PL_regnarrate = PL_debug & 512; + PL_regprogram = prog->program; +#endif + + /* Be paranoid... */ + if (prog == NULL || startpos == NULL) { + croak("NULL regexp parameter"); + return 0; + } + + minlen = prog->minlen; + if (strend - startpos < minlen) goto phooey; + + if (startpos == strbeg) /* is ^ valid at stringarg? */ + PL_regprev = '\n'; + else { + PL_regprev = stringarg[-1]; + if (!PL_multiline && PL_regprev == '\n') + PL_regprev = '\0'; /* force ^ to NOT match */ + } + + /* Check validity of program. */ + if (UCHARAT(prog->program) != MAGIC) { + FAIL("corrupted regexp program"); + } + + PL_regnpar = prog->nparens; + PL_reg_flags = 0; + PL_reg_eval_set = 0; + + /* If there is a "must appear" string, look for it. */ + s = startpos; + if (!(flags & REXEC_CHECKED) + && prog->check_substr != Nullsv && + !(prog->reganch & ROPT_ANCH_GPOS) && + (!(prog->reganch & (ROPT_ANCH_BOL | ROPT_ANCH_MBOL)) + || (PL_multiline && prog->check_substr == prog->anchored_substr)) ) + { + start_shift = prog->check_offset_min; + /* Should be nonnegative! */ + end_shift = minlen - start_shift - SvCUR(prog->check_substr); + if (screamer) { + if (PL_screamfirst[BmRARE(prog->check_substr)] >= 0) + s = screaminstr(screamer, prog->check_substr, + start_shift + (stringarg - strbeg), + end_shift, &scream_pos, 0); + else + s = Nullch; + scream_olds = s; + } + else + s = fbm_instr((unsigned char*)s + start_shift, + (unsigned char*)strend - end_shift, + prog->check_substr, 0); + if (!s) { + ++BmUSEFUL(prog->check_substr); /* hooray */ + goto phooey; /* not present */ + } else if ((s - stringarg) > prog->check_offset_max) { + ++BmUSEFUL(prog->check_substr); /* hooray/2 */ + s -= prog->check_offset_max; + } else if (!prog->naughty + && --BmUSEFUL(prog->check_substr) < 0 + && prog->check_substr == prog->float_substr) { /* boo */ + SvREFCNT_dec(prog->check_substr); + prog->check_substr = Nullsv; /* disable */ + prog->float_substr = Nullsv; /* clear */ + s = startpos; + } else s = startpos; + } + + /* Mark beginning of line for ^ and lookbehind. */ + PL_regbol = startpos; + PL_bostr = strbeg; + + /* Mark end of line for $ (and such) */ + PL_regeol = strend; + + /* see how far we have to get to not match where we matched before */ + PL_regtill = startpos+minend; + + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "Matching `%.60s%s' against `%.*s%s'\n", + prog->precomp, + (strlen(prog->precomp) > 60 ? "..." : ""), + (strend - startpos > 60 ? 60 : strend - startpos), + startpos, + (strend - startpos > 60 ? "..." : "")) + ); + + /* Simplest case: anchored match need be tried only once. */ + /* [unless only anchor is BOL and multiline is set] */ + if (prog->reganch & ROPT_ANCH) { + if (regtry(prog, startpos)) + goto got_it; + else if (!(prog->reganch & ROPT_ANCH_GPOS) && + (PL_multiline || (prog->reganch & ROPT_IMPLICIT) + || (prog->reganch & ROPT_ANCH_MBOL))) + { + if (minlen) + dontbother = minlen - 1; + strend -= dontbother; + /* for multiline we only have to try after newlines */ + if (s > startpos) + s--; + while (s < strend) { + if (*s++ == '\n') { + if (s < strend && regtry(prog, s)) + goto got_it; + } + } + } + goto phooey; + } + + /* Messy cases: unanchored match. */ + if (prog->anchored_substr && prog->reganch & ROPT_SKIP) { + /* we have /x+whatever/ */ + /* it must be a one character string */ + char ch = SvPVX(prog->anchored_substr)[0]; + while (s < strend) { + if (*s == ch) { + if (regtry(prog, s)) goto got_it; + s++; + while (s < strend && *s == ch) + s++; + } + s++; + } + } + /*SUPPRESS 560*/ + else if (prog->anchored_substr != Nullsv + || (prog->float_substr != Nullsv + && prog->float_max_offset < strend - s)) { + SV *must = prog->anchored_substr + ? prog->anchored_substr : prog->float_substr; + I32 back_max = + prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset; + I32 back_min = + prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset; + I32 delta = back_max - back_min; + char *last = strend - SvCUR(must) - back_min; /* Cannot start after this */ + char *last1 = s - 1; /* Last position checked before */ + + /* XXXX check_substr already used to find `s', can optimize if + check_substr==must. */ + scream_pos = -1; + dontbother = end_shift; + strend -= dontbother; + while ( (s <= last) && + (screamer + ? (s = screaminstr(screamer, must, s + back_min - strbeg, + end_shift, &scream_pos, 0)) + : (s = fbm_instr((unsigned char*)s + back_min, + (unsigned char*)strend, must, 0))) ) { + if (s - back_max > last1) { + last1 = s - back_min; + s = s - back_max; + } else { + char *t = last1 + 1; + + last1 = s - back_min; + s = t; + } + while (s <= last1) { + if (regtry(prog, s)) + goto got_it; + s++; + } + } + goto phooey; + } else if (c = prog->regstclass) { + I32 doevery = (prog->reganch & ROPT_SKIP) == 0; + char *Class; + + if (minlen) + dontbother = minlen - 1; + strend -= dontbother; /* don't bother with what can't match */ + tmp = 1; + /* We know what class it must start with. */ + switch (OP(c)) { + case ANYOF: + Class = (char *) OPERAND(c); + while (s < strend) { + if (REGINCLASS(Class, *s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case BOUNDL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case BOUND: + if (minlen) + dontbother++,strend--; + tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev; + tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); + while (s < strend) { + if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) { + tmp = !tmp; + if (regtry(prog, s)) + goto got_it; + } + s++; + } + if ((minlen || tmp) && regtry(prog,s)) + goto got_it; + break; + case NBOUNDL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case NBOUND: + if (minlen) + dontbother++,strend--; + tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev; + tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); + while (s < strend) { + if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s))) + tmp = !tmp; + else if (regtry(prog, s)) + goto got_it; + s++; + } + if ((minlen || !tmp) && regtry(prog,s)) + goto got_it; + break; + case ALNUM: + while (s < strend) { + if (isALNUM(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case ALNUML: + PL_reg_flags |= RF_tainted; + while (s < strend) { + if (isALNUM_LC(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case NALNUM: + while (s < strend) { + if (!isALNUM(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case NALNUML: + PL_reg_flags |= RF_tainted; + while (s < strend) { + if (!isALNUM_LC(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case SPACE: + while (s < strend) { + if (isSPACE(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case SPACEL: + PL_reg_flags |= RF_tainted; + while (s < strend) { + if (isSPACE_LC(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case NSPACE: + while (s < strend) { + if (!isSPACE(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case NSPACEL: + PL_reg_flags |= RF_tainted; + while (s < strend) { + if (!isSPACE_LC(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case DIGIT: + while (s < strend) { + if (isDIGIT(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case NDIGIT: + while (s < strend) { + if (!isDIGIT(*s)) { + if (tmp && regtry(prog, s)) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + } + } + else { + dontbother = 0; + if (prog->float_substr != Nullsv) { /* Trim the end. */ + char *last; + I32 oldpos = scream_pos; + + if (screamer) { + last = screaminstr(screamer, prog->float_substr, s - strbeg, + end_shift, &scream_pos, 1); /* last one */ + if (!last) { + last = scream_olds; /* Only one occurence. */ + } + } else { + STRLEN len; + char *little = SvPV(prog->float_substr, len); + if (len) + last = rninstr(s, strend, little, little + len); + else + last = strend; /* matching `$' */ + } + if (last == NULL) goto phooey; /* Should not happen! */ + dontbother = strend - last + prog->float_min_offset; + } + if (minlen && (dontbother < minlen)) + dontbother = minlen - 1; + strend -= dontbother; + /* We don't know much -- general case. */ + do { + if (regtry(prog, s)) + goto got_it; + } while (s++ < strend); + } + + /* Failure. */ + goto phooey; + +got_it: + prog->subbeg = strbeg; + prog->subend = PL_regeol; /* strend may have been modified */ + RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); + + /* make sure $`, $&, $', and $digit will work later */ + if (strbeg != prog->subbase) { /* second+ //g match. */ + if (!(flags & REXEC_COPY_STR)) { + if (prog->subbase) { + Safefree(prog->subbase); + prog->subbase = Nullch; + } + } + else { + I32 i = PL_regeol - startpos + (stringarg - strbeg); + s = savepvn(strbeg, i); + Safefree(prog->subbase); + prog->subbase = s; + prog->subbeg = prog->subbase; + prog->subend = prog->subbase + i; + s = prog->subbase + (stringarg - strbeg); + for (i = 0; i <= prog->nparens; i++) { + if (prog->endp[i]) { + prog->startp[i] = s + (prog->startp[i] - startpos); + prog->endp[i] = s + (prog->endp[i] - startpos); + } + } + } + } + /* Preserve the current value of $^R */ + if (oreplsv != GvSV(PL_replgv)) { + sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is + restored, the value remains + the same. */ + } + return 1; + +phooey: + return 0; +} + +/* + - regtry - try match at specific point + */ +STATIC I32 /* 0 failure, 1 success */ +regtry(regexp *prog, char *startpos) +{ + dTHR; + register I32 i; + register char **sp; + register char **ep; + CHECKPOINT lastcp; + + if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) { + PL_reg_eval_set = RS_init; + DEBUG_r(DEBUG_s( + PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n", + PL_stack_sp - PL_stack_base); + )); + SAVEINT(cxstack[cxstack_ix].blk_oldsp); + cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base; + /* Otherwise OP_NEXTSTATE will free whatever on stack now. */ + SAVETMPS; + /* Apparently this is not needed, judging by wantarray. */ + /* SAVEINT(cxstack[cxstack_ix].blk_gimme); + cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ + } + PL_reginput = startpos; + PL_regstartp = prog->startp; + PL_regendp = prog->endp; + PL_reglastparen = &prog->lastparen; + prog->lastparen = 0; + PL_regsize = 0; + if (PL_reg_start_tmpl <= prog->nparens) { + PL_reg_start_tmpl = prog->nparens*3/2 + 3; + if(PL_reg_start_tmp) + Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*); + else + New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*); + } + + sp = prog->startp; + ep = prog->endp; + PL_regdata = prog->data; + if (prog->nparens) { + for (i = prog->nparens; i >= 0; i--) { + *sp++ = NULL; + *ep++ = NULL; + } + } + REGCP_SET; + if (regmatch(prog->program + 1)) { + prog->startp[0] = startpos; + prog->endp[0] = PL_reginput; + return 1; + } + REGCP_UNWIND; + return 0; +} + +/* + - regmatch - main matching routine + * + * Conceptually the strategy is simple: check to see whether the current + * node matches, call self recursively to see whether the rest matches, + * and then act accordingly. In practice we make some effort to avoid + * recursion, in particular by going through "ordinary" nodes (that don't + * need to know whether the rest of the match failed) by a loop instead of + * by recursion. + */ +/* [lwall] I've hoisted the register declarations to the outer block in order to + * maybe save a little bit of pushing and popping on the stack. It also takes + * advantage of machines that use a register save mask on subroutine entry. + */ +STATIC I32 /* 0 failure, 1 success */ +regmatch(regnode *prog) +{ + dTHR; + register regnode *scan; /* Current node. */ + regnode *next; /* Next node. */ + regnode *inner; /* Next node in internal branch. */ + register I32 nextchr; /* renamed nextchr - nextchar colides with + function of same name */ + register I32 n; /* no or next */ + register I32 ln; /* len or last */ + register char *s; /* operand or save */ + register char *locinput = PL_reginput; + register I32 c1, c2, paren; /* case fold search, parenth */ + int minmod = 0, sw = 0, logical = 0; +#ifdef DEBUGGING + PL_regindent++; +#endif + + nextchr = UCHARAT(locinput); + scan = prog; + while (scan != NULL) { +#define sayNO_L (logical ? (logical = 0, sw = 0, goto cont) : sayNO) +#ifdef DEBUGGING +# define sayYES goto yes +# define sayNO goto no +# define saySAME(x) if (x) goto yes; else goto no +# define REPORT_CODE_OFF 24 +#else +# define sayYES return 1 +# define sayNO return 0 +# define saySAME(x) return x +#endif + DEBUG_r( { + SV *prop = sv_newmortal(); + int docolor = *PL_colors[0]; + int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */ + int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput); + int pref_len = (locinput - PL_bostr > (5 + taill) - l + ? (5 + taill) - l : locinput - PL_bostr); + + if (l + pref_len < (5 + taill) && l < PL_regeol - locinput) + l = ( PL_regeol - locinput > (5 + taill) - pref_len + ? (5 + taill) - pref_len : PL_regeol - locinput); + regprop(prop, scan); + PerlIO_printf(Perl_debug_log, + "%4i <%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", + locinput - PL_bostr, + PL_colors[2], pref_len, locinput - pref_len, PL_colors[3], + (docolor ? "" : "> <"), + PL_colors[0], l, locinput, PL_colors[1], + 15 - l - pref_len + 1, + "", + scan - PL_regprogram, PL_regindent*2, "", + SvPVX(prop)); + } ); + + next = scan + NEXT_OFF(scan); + if (next == scan) + next = NULL; + + switch (OP(scan)) { + case BOL: + if (locinput == PL_bostr + ? PL_regprev == '\n' + : (PL_multiline && + (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + { + /* PL_regtill = PL_regbol; */ + break; + } + sayNO; + case MBOL: + if (locinput == PL_bostr + ? PL_regprev == '\n' + : ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n') ) + { + break; + } + sayNO; + case SBOL: + if (locinput == PL_regbol && PL_regprev == '\n') + break; + sayNO; + case GPOS: + if (locinput == PL_regbol) + break; + sayNO; + case EOL: + if (PL_multiline) + goto meol; + else + goto seol; + case MEOL: + meol: + if ((nextchr || locinput < PL_regeol) && nextchr != '\n') + sayNO; + break; + case SEOL: + seol: + if ((nextchr || locinput < PL_regeol) && nextchr != '\n') + sayNO; + if (PL_regeol - locinput > 1) + sayNO; + break; + case EOS: + if (PL_regeol != locinput) + sayNO; + break; + case SANY: + if (!nextchr && locinput >= PL_regeol) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case ANY: + if (!nextchr && locinput >= PL_regeol || nextchr == '\n') + sayNO; + nextchr = UCHARAT(++locinput); + break; + case EXACT: + s = (char *) OPERAND(scan); + ln = UCHARAT(s++); + /* Inline the first character, for speed. */ + if (UCHARAT(s) != nextchr) + sayNO; + if (PL_regeol - locinput < ln) + sayNO; + if (ln > 1 && memNE(s, locinput, ln)) + sayNO; + locinput += ln; + nextchr = UCHARAT(locinput); + break; + case EXACTFL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case EXACTF: + s = (char *) OPERAND(scan); + ln = UCHARAT(s++); + /* Inline the first character, for speed. */ + if (UCHARAT(s) != nextchr && + UCHARAT(s) != ((OP(scan) == EXACTF) + ? fold : fold_locale)[nextchr]) + sayNO; + if (PL_regeol - locinput < ln) + sayNO; + if (ln > 1 && (OP(scan) == EXACTF + ? ibcmp(s, locinput, ln) + : ibcmp_locale(s, locinput, ln))) + sayNO; + locinput += ln; + nextchr = UCHARAT(locinput); + break; + case ANYOF: + s = (char *) OPERAND(scan); + if (nextchr < 0) + nextchr = UCHARAT(locinput); + if (!REGINCLASS(s, nextchr)) + sayNO; + if (!nextchr && locinput >= PL_regeol) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case ALNUML: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case ALNUM: + if (!nextchr) + sayNO; + if (!(OP(scan) == ALNUM + ? isALNUM(nextchr) : isALNUM_LC(nextchr))) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case NALNUML: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case NALNUM: + if (!nextchr && locinput >= PL_regeol) + sayNO; + if (OP(scan) == NALNUM + ? isALNUM(nextchr) : isALNUM_LC(nextchr)) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case BOUNDL: + case NBOUNDL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case BOUND: + case NBOUND: + /* was last char in word? */ + ln = (locinput != PL_regbol) ? UCHARAT(locinput - 1) : PL_regprev; + if (OP(scan) == BOUND || OP(scan) == NBOUND) { + ln = isALNUM(ln); + n = isALNUM(nextchr); + } + else { + ln = isALNUM_LC(ln); + n = isALNUM_LC(nextchr); + } + if (((!ln) == (!n)) == (OP(scan) == BOUND || OP(scan) == BOUNDL)) + sayNO; + break; + case SPACEL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case SPACE: + if (!nextchr && locinput >= PL_regeol) + sayNO; + if (!(OP(scan) == SPACE + ? isSPACE(nextchr) : isSPACE_LC(nextchr))) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case NSPACEL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case NSPACE: + if (!nextchr) + sayNO; + if (OP(scan) == SPACE + ? isSPACE(nextchr) : isSPACE_LC(nextchr)) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case DIGIT: + if (!isDIGIT(nextchr)) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case NDIGIT: + if (!nextchr && locinput >= PL_regeol) + sayNO; + if (isDIGIT(nextchr)) + sayNO; + nextchr = UCHARAT(++locinput); + break; + case REFFL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case REF: + case REFF: + n = ARG(scan); /* which paren pair */ + s = PL_regstartp[n]; + if (*PL_reglastparen < n || !s) + sayNO; /* Do not match unless seen CLOSEn. */ + if (s == PL_regendp[n]) + break; + /* Inline the first character, for speed. */ + if (UCHARAT(s) != nextchr && + (OP(scan) == REF || + (UCHARAT(s) != ((OP(scan) == REFF + ? fold : fold_locale)[nextchr])))) + sayNO; + ln = PL_regendp[n] - s; + if (locinput + ln > PL_regeol) + sayNO; + if (ln > 1 && (OP(scan) == REF + ? memNE(s, locinput, ln) + : (OP(scan) == REFF + ? ibcmp(s, locinput, ln) + : ibcmp_locale(s, locinput, ln)))) + sayNO; + locinput += ln; + nextchr = UCHARAT(locinput); + break; + + case NOTHING: + case TAIL: + break; + case BACK: + break; + case EVAL: + { + dSP; + OP_4tree *oop = PL_op; + COP *ocurcop = PL_curcop; + SV **ocurpad = PL_curpad; + SV *ret; + + n = ARG(scan); + PL_op = (OP_4tree*)PL_regdata->data[n]; + DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) ); + PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]); + + CALLRUNOPS(); /* Scalar context. */ + SPAGAIN; + ret = POPs; + PUTBACK; + + if (logical) { + logical = 0; + sw = SvTRUE(ret); + } else + sv_setsv(save_scalar(PL_replgv), ret); + PL_op = oop; + PL_curpad = ocurpad; + PL_curcop = ocurcop; + break; + } + case OPEN: + n = ARG(scan); /* which paren pair */ + PL_reg_start_tmp[n] = locinput; + if (n > PL_regsize) + PL_regsize = n; + break; + case CLOSE: + n = ARG(scan); /* which paren pair */ + PL_regstartp[n] = PL_reg_start_tmp[n]; + PL_regendp[n] = locinput; + if (n > *PL_reglastparen) + *PL_reglastparen = n; + break; + case GROUPP: + n = ARG(scan); /* which paren pair */ + sw = (*PL_reglastparen >= n && PL_regendp[n] != NULL); + break; + case IFTHEN: + if (sw) + next = NEXTOPER(NEXTOPER(scan)); + else { + next = scan + ARG(scan); + if (OP(next) == IFTHEN) /* Fake one. */ + next = NEXTOPER(NEXTOPER(next)); + } + break; + case LOGICAL: + logical = 1; + break; + case CURLYX: { + CURCUR cc; + CHECKPOINT cp = PL_savestack_ix; + + if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */ + next += ARG(next); + cc.oldcc = PL_regcc; + PL_regcc = &cc; + cc.parenfloor = *PL_reglastparen; + cc.cur = -1; + cc.min = ARG1(scan); + cc.max = ARG2(scan); + cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; + cc.next = next; + cc.minmod = minmod; + cc.lastloc = 0; + PL_reginput = locinput; + n = regmatch(PREVOPER(next)); /* start on the WHILEM */ + regcpblow(cp); + PL_regcc = cc.oldcc; + saySAME(n); + } + /* NOT REACHED */ + case WHILEM: { + /* + * This is really hard to understand, because after we match + * what we're trying to match, we must make sure the rest of + * the RE is going to match for sure, and to do that we have + * to go back UP the parse tree by recursing ever deeper. And + * if it fails, we have to reset our parent's current state + * that we can try again after backing off. + */ + + CHECKPOINT cp, lastcp; + CURCUR* cc = PL_regcc; + char *lastloc = cc->lastloc; /* Detection of 0-len. */ + + n = cc->cur + 1; /* how many we know we matched */ + PL_reginput = locinput; + + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s %ld out of %ld..%ld cc=%lx\n", + REPORT_CODE_OFF+PL_regindent*2, "", + (long)n, (long)cc->min, + (long)cc->max, (long)cc) + ); + + /* If degenerate scan matches "", assume scan done. */ + + if (locinput == cc->lastloc && n >= cc->min) { + PL_regcc = cc->oldcc; + ln = PL_regcc->cur; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s empty match detected, try continuation...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + if (regmatch(cc->next)) + sayYES; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s failed...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + PL_regcc->cur = ln; + PL_regcc = cc; + sayNO; + } + + /* First just match a string of min scans. */ + + if (n < cc->min) { + cc->cur = n; + cc->lastloc = locinput; + if (regmatch(cc->scan)) + sayYES; + cc->cur = n - 1; + cc->lastloc = lastloc; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s failed...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + sayNO; + } + + /* Prefer next over scan for minimal matching. */ + + if (cc->minmod) { + PL_regcc = cc->oldcc; + ln = PL_regcc->cur; + cp = regcppush(cc->parenfloor); + REGCP_SET; + if (regmatch(cc->next)) { + regcpblow(cp); + sayYES; /* All done. */ + } + REGCP_UNWIND; + regcppop(); + PL_regcc->cur = ln; + PL_regcc = cc; + + if (n >= cc->max) { /* Maximum greed exceeded? */ + if (PL_dowarn && n >= REG_INFTY + && !(PL_reg_flags & RF_warned)) { + PL_reg_flags |= RF_warned; + warn("%s limit (%d) exceeded", + "Complex regular subexpression recursion", + REG_INFTY - 1); + } + sayNO; + } + + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s trying longer...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + /* Try scanning more and see if it helps. */ + PL_reginput = locinput; + cc->cur = n; + cc->lastloc = locinput; + cp = regcppush(cc->parenfloor); + REGCP_SET; + if (regmatch(cc->scan)) { + regcpblow(cp); + sayYES; + } + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s failed...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + REGCP_UNWIND; + regcppop(); + cc->cur = n - 1; + cc->lastloc = lastloc; + sayNO; + } + + /* Prefer scan over next for maximal matching. */ + + if (n < cc->max) { /* More greed allowed? */ + cp = regcppush(cc->parenfloor); + cc->cur = n; + cc->lastloc = locinput; + REGCP_SET; + if (regmatch(cc->scan)) { + regcpblow(cp); + sayYES; + } + REGCP_UNWIND; + regcppop(); /* Restore some previous $s? */ + PL_reginput = locinput; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s failed, try continuation...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + } + if (PL_dowarn && n >= REG_INFTY && !(PL_reg_flags & RF_warned)) { + PL_reg_flags |= RF_warned; + warn("%s limit (%d) exceeded", + "Complex regular subexpression recursion", + REG_INFTY - 1); + } + + /* Failed deeper matches of scan, so see if this one works. */ + PL_regcc = cc->oldcc; + ln = PL_regcc->cur; + if (regmatch(cc->next)) + sayYES; + DEBUG_r( + PerlIO_printf(Perl_debug_log, "%*s failed...\n", + REPORT_CODE_OFF+PL_regindent*2, "") + ); + PL_regcc->cur = ln; + PL_regcc = cc; + cc->cur = n - 1; + cc->lastloc = lastloc; + sayNO; + } + /* NOT REACHED */ + case BRANCHJ: + next = scan + ARG(scan); + if (next == scan) + next = NULL; + inner = NEXTOPER(NEXTOPER(scan)); + goto do_branch; + case BRANCH: + inner = NEXTOPER(scan); + do_branch: + { + CHECKPOINT lastcp; + c1 = OP(scan); + if (OP(next) != c1) /* No choice. */ + next = inner; /* Avoid recursion. */ + else { + int lastparen = *PL_reglastparen; + + REGCP_SET; + do { + PL_reginput = locinput; + if (regmatch(inner)) + sayYES; + REGCP_UNWIND; + for (n = *PL_reglastparen; n > lastparen; n--) + PL_regendp[n] = 0; + *PL_reglastparen = n; + scan = next; + /*SUPPRESS 560*/ + if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next))) + next += n; + else + next = NULL; + inner = NEXTOPER(scan); + if (c1 == BRANCHJ) { + inner = NEXTOPER(inner); + } + } while (scan != NULL && OP(scan) == c1); + sayNO; + /* NOTREACHED */ + } + } + break; + case MINMOD: + minmod = 1; + break; + case CURLYM: + { + I32 l = 0; + CHECKPOINT lastcp; + + /* We suppose that the next guy does not need + backtracking: in particular, it is of constant length, + and has no parenths to influence future backrefs. */ + ln = ARG1(scan); /* min to match */ + n = ARG2(scan); /* max to match */ + paren = scan->flags; + if (paren) { + if (paren > PL_regsize) + PL_regsize = paren; + if (paren > *PL_reglastparen) + *PL_reglastparen = paren; + } + scan = NEXTOPER(scan) + NODE_STEP_REGNODE; + if (paren) + scan += NEXT_OFF(scan); /* Skip former OPEN. */ + PL_reginput = locinput; + if (minmod) { + minmod = 0; + if (ln && regrepeat_hard(scan, ln, &l) < ln) + sayNO; + if (ln && l == 0 && n >= ln + /* In fact, this is tricky. If paren, then the + fact that we did/didnot match may influence + future execution. */ + && !(paren && ln == 0)) + ln = n; + locinput = PL_reginput; + if (regkind[(U8)OP(next)] == EXACT) { + c1 = UCHARAT(OPERAND(next) + 1); + if (OP(next) == EXACTF) + c2 = fold[c1]; + else if (OP(next) == EXACTFL) + c2 = fold_locale[c1]; + else + c2 = c1; + } else + c1 = c2 = -1000; + REGCP_SET; + /* This may be improved if l == 0. */ + while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */ + /* If it could work, try it. */ + if (c1 == -1000 || + UCHARAT(PL_reginput) == c1 || + UCHARAT(PL_reginput) == c2) + { + if (paren) { + if (n) { + PL_regstartp[paren] = PL_reginput - l; + PL_regendp[paren] = PL_reginput; + } else + PL_regendp[paren] = NULL; + } + if (regmatch(next)) + sayYES; + REGCP_UNWIND; + } + /* Couldn't or didn't -- move forward. */ + PL_reginput = locinput; + if (regrepeat_hard(scan, 1, &l)) { + ln++; + locinput = PL_reginput; + } + else + sayNO; + } + } else { + n = regrepeat_hard(scan, n, &l); + if (n != 0 && l == 0 + /* In fact, this is tricky. If paren, then the + fact that we did/didnot match may influence + future execution. */ + && !(paren && ln == 0)) + ln = n; + locinput = PL_reginput; + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s matched %ld times, len=%ld...\n", + REPORT_CODE_OFF+PL_regindent*2, "", n, l) + ); + if (n >= ln) { + if (regkind[(U8)OP(next)] == EXACT) { + c1 = UCHARAT(OPERAND(next) + 1); + if (OP(next) == EXACTF) + c2 = fold[c1]; + else if (OP(next) == EXACTFL) + c2 = fold_locale[c1]; + else + c2 = c1; + } else + c1 = c2 = -1000; + } + REGCP_SET; + while (n >= ln) { + /* If it could work, try it. */ + if (c1 == -1000 || + UCHARAT(PL_reginput) == c1 || + UCHARAT(PL_reginput) == c2) + { + DEBUG_r( + PerlIO_printf(Perl_debug_log, + "%*s trying tail with n=%ld...\n", + REPORT_CODE_OFF+PL_regindent*2, "", n) + ); + if (paren) { + if (n) { + PL_regstartp[paren] = PL_reginput - l; + PL_regendp[paren] = PL_reginput; + } else + PL_regendp[paren] = NULL; + } + if (regmatch(next)) + sayYES; + REGCP_UNWIND; + } + /* Couldn't or didn't -- back up. */ + n--; + locinput -= l; + PL_reginput = locinput; + } + } + sayNO; + break; + } + case CURLYN: + paren = scan->flags; /* Which paren to set */ + if (paren > PL_regsize) + PL_regsize = paren; + if (paren > *PL_reglastparen) + *PL_reglastparen = paren; + ln = ARG1(scan); /* min to match */ + n = ARG2(scan); /* max to match */ + scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE); + goto repeat; + case CURLY: + paren = 0; + ln = ARG1(scan); /* min to match */ + n = ARG2(scan); /* max to match */ + scan = NEXTOPER(scan) + NODE_STEP_REGNODE; + goto repeat; + case STAR: + ln = 0; + n = REG_INFTY; + scan = NEXTOPER(scan); + paren = 0; + goto repeat; + case PLUS: + ln = 1; + n = REG_INFTY; + scan = NEXTOPER(scan); + paren = 0; + repeat: + /* + * Lookahead to avoid useless match attempts + * when we know what character comes next. + */ + if (regkind[(U8)OP(next)] == EXACT) { + c1 = UCHARAT(OPERAND(next) + 1); + if (OP(next) == EXACTF) + c2 = fold[c1]; + else if (OP(next) == EXACTFL) + c2 = fold_locale[c1]; + else + c2 = c1; + } + else + c1 = c2 = -1000; + PL_reginput = locinput; + if (minmod) { + CHECKPOINT lastcp; + minmod = 0; + if (ln && regrepeat(scan, ln) < ln) + sayNO; + REGCP_SET; + while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */ + /* If it could work, try it. */ + if (c1 == -1000 || + UCHARAT(PL_reginput) == c1 || + UCHARAT(PL_reginput) == c2) + { + if (paren) { + if (n) { + PL_regstartp[paren] = PL_reginput - 1; + PL_regendp[paren] = PL_reginput; + } else + PL_regendp[paren] = NULL; + } + if (regmatch(next)) + sayYES; + REGCP_UNWIND; + } + /* Couldn't or didn't -- move forward. */ + PL_reginput = locinput + ln; + if (regrepeat(scan, 1)) { + ln++; + PL_reginput = locinput + ln; + } else + sayNO; + } + } + else { + CHECKPOINT lastcp; + n = regrepeat(scan, n); + if (ln < n && regkind[(U8)OP(next)] == EOL && + (!PL_multiline || OP(next) == SEOL)) + ln = n; /* why back off? */ + REGCP_SET; + if (paren) { + while (n >= ln) { + /* If it could work, try it. */ + if (c1 == -1000 || + UCHARAT(PL_reginput) == c1 || + UCHARAT(PL_reginput) == c2) + { + if (paren && n) { + if (n) { + PL_regstartp[paren] = PL_reginput - 1; + PL_regendp[paren] = PL_reginput; + } else + PL_regendp[paren] = NULL; + } + if (regmatch(next)) + sayYES; + REGCP_UNWIND; + } + /* Couldn't or didn't -- back up. */ + n--; + PL_reginput = locinput + n; + } + } else { + while (n >= ln) { + /* If it could work, try it. */ + if (c1 == -1000 || + UCHARAT(PL_reginput) == c1 || + UCHARAT(PL_reginput) == c2) + { + if (regmatch(next)) + sayYES; + REGCP_UNWIND; + } + /* Couldn't or didn't -- back up. */ + n--; + PL_reginput = locinput + n; + } + } + } + sayNO; + break; + case END: + if (locinput < PL_regtill) + sayNO; /* Cannot match: too short. */ + /* Fall through */ + case SUCCEED: + PL_reginput = locinput; /* put where regtry can find it */ + sayYES; /* Success! */ + case SUSPEND: + n = 1; + goto do_ifmatch; + case UNLESSM: + n = 0; + if (locinput < PL_bostr + scan->flags) + goto say_yes; + goto do_ifmatch; + case IFMATCH: + n = 1; + if (locinput < PL_bostr + scan->flags) + goto say_no; + do_ifmatch: + PL_reginput = locinput - scan->flags; + inner = NEXTOPER(NEXTOPER(scan)); + if (regmatch(inner) != n) { + say_no: + if (logical) { + logical = 0; + sw = 0; + goto do_longjump; + } else + sayNO; + } + say_yes: + if (logical) { + logical = 0; + sw = 1; + } + if (OP(scan) == SUSPEND) { + locinput = PL_reginput; + nextchr = UCHARAT(locinput); + } + /* FALL THROUGH. */ + case LONGJMP: + do_longjump: + next = scan + ARG(scan); + if (next == scan) + next = NULL; + break; + default: + PerlIO_printf(PerlIO_stderr(), "%lx %d\n", + (unsigned long)scan, OP(scan)); + FAIL("regexp memory corruption"); + } + scan = next; + } + + /* + * We get here only if there's trouble -- normally "case END" is + * the terminating point. + */ + FAIL("corrupted regexp pointers"); + /*NOTREACHED*/ + sayNO; + +yes: +#ifdef DEBUGGING + PL_regindent--; +#endif + return 1; + +no: +#ifdef DEBUGGING + PL_regindent--; +#endif + return 0; +} + +/* + - regrepeat - repeatedly match something simple, report how many + */ +/* + * [This routine now assumes that it will only match on things of length 1. + * That was true before, but now we assume scan - reginput is the count, + * rather than incrementing count on every character.] + */ +STATIC I32 +regrepeat(regnode *p, I32 max) +{ + dTHR; + register char *scan; + register char *opnd; + register I32 c; + register char *loceol = PL_regeol; + + scan = PL_reginput; + if (max != REG_INFTY && max < loceol - scan) + loceol = scan + max; + opnd = (char *) OPERAND(p); + switch (OP(p)) { + case ANY: + while (scan < loceol && *scan != '\n') + scan++; + break; + case SANY: + scan = loceol; + break; + case EXACT: /* length of string is 1 */ + c = UCHARAT(++opnd); + while (scan < loceol && UCHARAT(scan) == c) + scan++; + break; + case EXACTF: /* length of string is 1 */ + c = UCHARAT(++opnd); + while (scan < loceol && + (UCHARAT(scan) == c || UCHARAT(scan) == fold[c])) + scan++; + break; + case EXACTFL: /* length of string is 1 */ + PL_reg_flags |= RF_tainted; + c = UCHARAT(++opnd); + while (scan < loceol && + (UCHARAT(scan) == c || UCHARAT(scan) == fold_locale[c])) + scan++; + break; + case ANYOF: + while (scan < loceol && REGINCLASS(opnd, *scan)) + scan++; + break; + case ALNUM: + while (scan < loceol && isALNUM(*scan)) + scan++; + break; + case ALNUML: + PL_reg_flags |= RF_tainted; + while (scan < loceol && isALNUM_LC(*scan)) + scan++; + break; + case NALNUM: + while (scan < loceol && !isALNUM(*scan)) + scan++; + break; + case NALNUML: + PL_reg_flags |= RF_tainted; + while (scan < loceol && !isALNUM_LC(*scan)) + scan++; + break; + case SPACE: + while (scan < loceol && isSPACE(*scan)) + scan++; + break; + case SPACEL: + PL_reg_flags |= RF_tainted; + while (scan < loceol && isSPACE_LC(*scan)) + scan++; + break; + case NSPACE: + while (scan < loceol && !isSPACE(*scan)) + scan++; + break; + case NSPACEL: + PL_reg_flags |= RF_tainted; + while (scan < loceol && !isSPACE_LC(*scan)) + scan++; + break; + case DIGIT: + while (scan < loceol && isDIGIT(*scan)) + scan++; + break; + case NDIGIT: + while (scan < loceol && !isDIGIT(*scan)) + scan++; + break; + default: /* Called on something of 0 width. */ + break; /* So match right here or not at all. */ + } + + c = scan - PL_reginput; + PL_reginput = scan; + + DEBUG_r( + { + SV *prop = sv_newmortal(); + + regprop(prop, p); + PerlIO_printf(Perl_debug_log, + "%*s %s can match %ld times out of %ld...\n", + REPORT_CODE_OFF+1, "", SvPVX(prop),c,max); + }); + + return(c); +} + +/* + - regrepeat_hard - repeatedly match something, report total lenth and length + * + * The repeater is supposed to have constant length. + */ + +STATIC I32 +regrepeat_hard(regnode *p, I32 max, I32 *lp) +{ + dTHR; + register char *scan; + register char *start; + register char *loceol = PL_regeol; + I32 l = -1; + + start = PL_reginput; + while (PL_reginput < loceol && (scan = PL_reginput, regmatch(p))) { + if (l == -1) { + *lp = l = PL_reginput - start; + if (max != REG_INFTY && l*max < loceol - scan) + loceol = scan + l*max; + if (l == 0) { + return max; + } + } + } + if (PL_reginput < loceol) + PL_reginput = scan; + else + scan = PL_reginput; + + return (scan - start)/l; +} + +/* + - regclass - determine if a character falls into a character class + */ + +STATIC bool +reginclass(register char *p, register I32 c) +{ + dTHR; + char flags = *p; + bool match = FALSE; + + c &= 0xFF; + if (ANYOF_TEST(p, c)) + match = TRUE; + else if (flags & ANYOF_FOLD) { + I32 cf; + if (flags & ANYOF_LOCALE) { + PL_reg_flags |= RF_tainted; + cf = fold_locale[c]; + } + else + cf = fold[c]; + if (ANYOF_TEST(p, cf)) + match = TRUE; + } + + if (!match && (flags & ANYOF_ISA)) { + PL_reg_flags |= RF_tainted; + + if (((flags & ANYOF_ALNUML) && isALNUM_LC(c)) || + ((flags & ANYOF_NALNUML) && !isALNUM_LC(c)) || + ((flags & ANYOF_SPACEL) && isSPACE_LC(c)) || + ((flags & ANYOF_NSPACEL) && !isSPACE_LC(c))) + { + match = TRUE; + } + } + + return (flags & ANYOF_INVERT) ? !match : match; +} + + + diff --git a/contrib/perl5/regexp.h b/contrib/perl5/regexp.h new file mode 100644 index 00000000000..fbc92370b84 --- /dev/null +++ b/contrib/perl5/regexp.h @@ -0,0 +1,103 @@ +/* regexp.h + */ + +/* + * Definitions etc. for regexp(3) routines. + * + * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof], + * not the System V one. + */ + + +struct regnode { + U8 flags; + U8 type; + U16 next_off; +}; + +typedef struct regnode regnode; + +struct reg_data { + U32 count; + U8 *what; + void* data[1]; +}; + +struct reg_substr_datum { + I32 min_offset; + I32 max_offset; + SV *substr; +}; + +struct reg_substr_data { + struct reg_substr_datum data[3]; /* Actual array */ +}; + +typedef struct regexp { + I32 refcnt; + char **startp; + char **endp; + regnode *regstclass; + I32 minlen; /* mininum possible length of $& */ + I32 prelen; /* length of precomp */ + U32 nparens; /* number of parentheses */ + U32 lastparen; /* last paren matched */ + char *precomp; /* pre-compilation regular expression */ + char *subbase; /* saved string so \digit works forever */ + char *subbeg; /* same, but not responsible for allocation */ + char *subend; /* end of subbase */ + U16 naughty; /* how exponential is this pattern? */ + U16 reganch; /* Internal use only + + Tainted information used by regexec? */ +#if 0 + SV *anchored_substr; /* Substring at fixed position wrt start. */ + I32 anchored_offset; /* Position of it. */ + SV *float_substr; /* Substring at variable position wrt start. */ + I32 float_min_offset; /* Minimal position of it. */ + I32 float_max_offset; /* Maximal position of it. */ + SV *check_substr; /* Substring to check before matching. */ + I32 check_offset_min; /* Offset of the above. */ + I32 check_offset_max; /* Offset of the above. */ +#else + struct reg_substr_data *substrs; +#endif + struct reg_data *data; /* Additional data. */ + regnode program[1]; /* Unwarranted chumminess with compiler. */ +} regexp; + +#define anchored_substr substrs->data[0].substr +#define anchored_offset substrs->data[0].min_offset +#define float_substr substrs->data[1].substr +#define float_min_offset substrs->data[1].min_offset +#define float_max_offset substrs->data[1].max_offset +#define check_substr substrs->data[2].substr +#define check_offset_min substrs->data[2].min_offset +#define check_offset_max substrs->data[2].max_offset + +#define ROPT_ANCH (ROPT_ANCH_BOL|ROPT_ANCH_MBOL|ROPT_ANCH_GPOS) +#define ROPT_ANCH_SINGLE (ROPT_ANCH_BOL|ROPT_ANCH_GPOS) +#define ROPT_ANCH_BOL 1 +#define ROPT_ANCH_MBOL 2 +#define ROPT_ANCH_GPOS 4 +#define ROPT_SKIP 8 +#define ROPT_IMPLICIT 0x10 /* Converted .* to ^.* */ +#define ROPT_NOSCAN 0x20 /* Check-string always at start. */ +#define ROPT_GPOS_SEEN 0x40 +#define ROPT_CHECK_ALL 0x80 +#define ROPT_LOOKBEHIND_SEEN 0x100 +#define ROPT_EVAL_SEEN 0x200 +#define ROPT_TAINTED_SEEN 0x400 +/* 0xf800 of reganch is used by PMf_COMPILETIME */ + +#define RX_MATCH_TAINTED(prog) ((prog)->reganch & ROPT_TAINTED_SEEN) +#define RX_MATCH_TAINTED_on(prog) ((prog)->reganch |= ROPT_TAINTED_SEEN) +#define RX_MATCH_TAINTED_off(prog) ((prog)->reganch &= ~ROPT_TAINTED_SEEN) +#define RX_MATCH_TAINTED_set(prog, t) ((t) \ + ? RX_MATCH_TAINTED_on(prog) \ + : RX_MATCH_TAINTED_off(prog)) + +#define REXEC_COPY_STR 1 /* Need to copy the string. */ +#define REXEC_CHECKED 2 /* check_substr already checked. */ + +#define ReREFCNT_inc(re) ((re && re->refcnt++), re) +#define ReREFCNT_dec(re) pregfree(re) diff --git a/contrib/perl5/regnodes.h b/contrib/perl5/regnodes.h new file mode 100644 index 00000000000..c494daed12b --- /dev/null +++ b/contrib/perl5/regnodes.h @@ -0,0 +1,254 @@ +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + This file is built by regcomp.pl from regcomp.sym. + Any changes made here will be lost! +*/ + +#define END 0 /* 0 End of program. */ +#define SUCCEED 1 /* 0x1 Return from a subroutine, basically. */ +#define BOL 2 /* 0x2 Match "" at beginning of line. */ +#define MBOL 3 /* 0x3 Same, assuming multiline. */ +#define SBOL 4 /* 0x4 Same, assuming singleline. */ +#define EOS 5 /* 0x5 Match "" at end of string. */ +#define EOL 6 /* 0x6 Match "" at end of line. */ +#define MEOL 7 /* 0x7 Same, assuming multiline. */ +#define SEOL 8 /* 0x8 Same, assuming singleline. */ +#define BOUND 9 /* 0x9 Match "" at any word boundary */ +#define BOUNDL 10 /* 0xa Match "" at any word boundary */ +#define NBOUND 11 /* 0xb Match "" at any word non-boundary */ +#define NBOUNDL 12 /* 0xc Match "" at any word non-boundary */ +#define GPOS 13 /* 0xd Matches where last m//g left off. */ +#define ANY 14 /* 0xe Match any one character (except newline). */ +#define SANY 15 /* 0xf Match any one character. */ +#define ANYOF 16 /* 0x10 Match character in (or not in) this class. */ +#define ALNUM 17 /* 0x11 Match any alphanumeric character */ +#define ALNUML 18 /* 0x12 Match any alphanumeric char in locale */ +#define NALNUM 19 /* 0x13 Match any non-alphanumeric character */ +#define NALNUML 20 /* 0x14 Match any non-alphanumeric char in locale */ +#define SPACE 21 /* 0x15 Match any whitespace character */ +#define SPACEL 22 /* 0x16 Match any whitespace char in locale */ +#define NSPACE 23 /* 0x17 Match any non-whitespace character */ +#define NSPACEL 24 /* 0x18 Match any non-whitespace char in locale */ +#define DIGIT 25 /* 0x19 Match any numeric character */ +#define NDIGIT 26 /* 0x1a Match any non-numeric character */ +#define BRANCH 27 /* 0x1b Match this alternative, or the next... */ +#define BACK 28 /* 0x1c Match "", "next" ptr points backward. */ +#define EXACT 29 /* 0x1d Match this string (preceded by length). */ +#define EXACTF 30 /* 0x1e Match this string, folded (prec. by length). */ +#define EXACTFL 31 /* 0x1f Match this string, folded in locale (w/len). */ +#define NOTHING 32 /* 0x20 Match empty string. */ +#define TAIL 33 /* 0x21 Match empty string. Can jump here from outside. */ +#define STAR 34 /* 0x22 Match this (simple) thing 0 or more times. */ +#define PLUS 35 /* 0x23 Match this (simple) thing 1 or more times. */ +#define CURLY 36 /* 0x24 Match this simple thing {n,m} times. */ +#define CURLYN 37 /* 0x25 Match next-after-this simple thing */ +#define CURLYM 38 /* 0x26 Match this medium-complex thing {n,m} times. */ +#define CURLYX 39 /* 0x27 Match this complex thing {n,m} times. */ +#define WHILEM 40 /* 0x28 Do curly processing and see if rest matches. */ +#define OPEN 41 /* 0x29 Mark this point in input as start of #n. */ +#define CLOSE 42 /* 0x2a Analogous to OPEN. */ +#define REF 43 /* 0x2b Match some already matched string */ +#define REFF 44 /* 0x2c Match already matched string, folded */ +#define REFFL 45 /* 0x2d Match already matched string, folded in loc. */ +#define IFMATCH 46 /* 0x2e Succeeds if the following matches. */ +#define UNLESSM 47 /* 0x2f Fails if the following matches. */ +#define SUSPEND 48 /* 0x30 "Independent" sub-RE. */ +#define IFTHEN 49 /* 0x31 Switch, should be preceeded by switcher . */ +#define GROUPP 50 /* 0x32 Whether the group matched. */ +#define LONGJMP 51 /* 0x33 Jump far away. */ +#define BRANCHJ 52 /* 0x34 BRANCH with long offset. */ +#define EVAL 53 /* 0x35 Execute some Perl code. */ +#define MINMOD 54 /* 0x36 Next operator is not greedy. */ +#define LOGICAL 55 /* 0x37 Next opcode should set the flag only. */ +#define RENUM 56 /* 0x38 Group with independently numbered parens. */ +#define OPTIMIZED 57 /* 0x39 Placeholder for dump. */ + +#ifndef DOINIT +EXTCONST U8 regkind[]; +#else +EXTCONST U8 regkind[] = { + END, /* END */ + END, /* SUCCEED */ + BOL, /* BOL */ + BOL, /* MBOL */ + BOL, /* SBOL */ + EOL, /* EOS */ + EOL, /* EOL */ + EOL, /* MEOL */ + EOL, /* SEOL */ + BOUND, /* BOUND */ + BOUND, /* BOUNDL */ + NBOUND, /* NBOUND */ + NBOUND, /* NBOUNDL */ + GPOS, /* GPOS */ + ANY, /* ANY */ + ANY, /* SANY */ + ANYOF, /* ANYOF */ + ALNUM, /* ALNUM */ + ALNUM, /* ALNUML */ + NALNUM, /* NALNUM */ + NALNUM, /* NALNUML */ + SPACE, /* SPACE */ + SPACE, /* SPACEL */ + NSPACE, /* NSPACE */ + NSPACE, /* NSPACEL */ + DIGIT, /* DIGIT */ + NDIGIT, /* NDIGIT */ + BRANCH, /* BRANCH */ + BACK, /* BACK */ + EXACT, /* EXACT */ + EXACT, /* EXACTF */ + EXACT, /* EXACTFL */ + NOTHING, /* NOTHING */ + NOTHING, /* TAIL */ + STAR, /* STAR */ + PLUS, /* PLUS */ + CURLY, /* CURLY */ + CURLY, /* CURLYN */ + CURLY, /* CURLYM */ + CURLY, /* CURLYX */ + WHILEM, /* WHILEM */ + OPEN, /* OPEN */ + CLOSE, /* CLOSE */ + REF, /* REF */ + REF, /* REFF */ + REF, /* REFFL */ + BRANCHJ, /* IFMATCH */ + BRANCHJ, /* UNLESSM */ + BRANCHJ, /* SUSPEND */ + BRANCHJ, /* IFTHEN */ + GROUPP, /* GROUPP */ + LONGJMP, /* LONGJMP */ + BRANCHJ, /* BRANCHJ */ + EVAL, /* EVAL */ + MINMOD, /* MINMOD */ + LOGICAL, /* LOGICAL */ + BRANCHJ, /* RENUM */ + NOTHING, /* OPTIMIZED */ +}; +#endif + + +#ifdef REG_COMP_C +const static U8 regarglen[] = { + 0, /* END */ + 0, /* SUCCEED */ + 0, /* BOL */ + 0, /* MBOL */ + 0, /* SBOL */ + 0, /* EOS */ + 0, /* EOL */ + 0, /* MEOL */ + 0, /* SEOL */ + 0, /* BOUND */ + 0, /* BOUNDL */ + 0, /* NBOUND */ + 0, /* NBOUNDL */ + 0, /* GPOS */ + 0, /* ANY */ + 0, /* SANY */ + 0, /* ANYOF */ + 0, /* ALNUM */ + 0, /* ALNUML */ + 0, /* NALNUM */ + 0, /* NALNUML */ + 0, /* SPACE */ + 0, /* SPACEL */ + 0, /* NSPACE */ + 0, /* NSPACEL */ + 0, /* DIGIT */ + 0, /* NDIGIT */ + 0, /* BRANCH */ + 0, /* BACK */ + 0, /* EXACT */ + 0, /* EXACTF */ + 0, /* EXACTFL */ + 0, /* NOTHING */ + 0, /* TAIL */ + 0, /* STAR */ + 0, /* PLUS */ + EXTRA_SIZE(struct regnode_2), /* CURLY */ + EXTRA_SIZE(struct regnode_2), /* CURLYN */ + EXTRA_SIZE(struct regnode_2), /* CURLYM */ + EXTRA_SIZE(struct regnode_2), /* CURLYX */ + 0, /* WHILEM */ + EXTRA_SIZE(struct regnode_1), /* OPEN */ + EXTRA_SIZE(struct regnode_1), /* CLOSE */ + EXTRA_SIZE(struct regnode_1), /* REF */ + EXTRA_SIZE(struct regnode_1), /* REFF */ + EXTRA_SIZE(struct regnode_1), /* REFFL */ + EXTRA_SIZE(struct regnode_1), /* IFMATCH */ + EXTRA_SIZE(struct regnode_1), /* UNLESSM */ + EXTRA_SIZE(struct regnode_1), /* SUSPEND */ + EXTRA_SIZE(struct regnode_1), /* IFTHEN */ + EXTRA_SIZE(struct regnode_1), /* GROUPP */ + EXTRA_SIZE(struct regnode_1), /* LONGJMP */ + EXTRA_SIZE(struct regnode_1), /* BRANCHJ */ + EXTRA_SIZE(struct regnode_1), /* EVAL */ + 0, /* MINMOD */ + 0, /* LOGICAL */ + EXTRA_SIZE(struct regnode_1), /* RENUM */ + 0, /* OPTIMIZED */ +}; + +const static char reg_off_by_arg[] = { + 0, /* END */ + 0, /* SUCCEED */ + 0, /* BOL */ + 0, /* MBOL */ + 0, /* SBOL */ + 0, /* EOS */ + 0, /* EOL */ + 0, /* MEOL */ + 0, /* SEOL */ + 0, /* BOUND */ + 0, /* BOUNDL */ + 0, /* NBOUND */ + 0, /* NBOUNDL */ + 0, /* GPOS */ + 0, /* ANY */ + 0, /* SANY */ + 0, /* ANYOF */ + 0, /* ALNUM */ + 0, /* ALNUML */ + 0, /* NALNUM */ + 0, /* NALNUML */ + 0, /* SPACE */ + 0, /* SPACEL */ + 0, /* NSPACE */ + 0, /* NSPACEL */ + 0, /* DIGIT */ + 0, /* NDIGIT */ + 0, /* BRANCH */ + 0, /* BACK */ + 0, /* EXACT */ + 0, /* EXACTF */ + 0, /* EXACTFL */ + 0, /* NOTHING */ + 0, /* TAIL */ + 0, /* STAR */ + 0, /* PLUS */ + 0, /* CURLY */ + 0, /* CURLYN */ + 0, /* CURLYM */ + 0, /* CURLYX */ + 0, /* WHILEM */ + 0, /* OPEN */ + 0, /* CLOSE */ + 0, /* REF */ + 0, /* REFF */ + 0, /* REFFL */ + 2, /* IFMATCH */ + 2, /* UNLESSM */ + 1, /* SUSPEND */ + 1, /* IFTHEN */ + 0, /* GROUPP */ + 1, /* LONGJMP */ + 1, /* BRANCHJ */ + 0, /* EVAL */ + 0, /* MINMOD */ + 0, /* LOGICAL */ + 1, /* RENUM */ + 0, /* OPTIMIZED */ +}; +#endif /* REG_COMP_C */ + diff --git a/contrib/perl5/run.c b/contrib/perl5/run.c new file mode 100644 index 00000000000..97444ec58e8 --- /dev/null +++ b/contrib/perl5/run.c @@ -0,0 +1,139 @@ +/* run.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +#include "EXTERN.h" +#include "perl.h" + +/* + * "Away now, Shadowfax! Run, greatheart, run as you have never run before! + * Now we are come to the lands where you were foaled, and every stone you + * know. Run now! Hope is in speed!" --Gandalf + */ + +#ifdef PERL_OBJECT +#define CALLOP this->*PL_op +#else +#define CALLOP *PL_op +#endif + +int +runops_standard(void) +{ + dTHR; + + while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ) ; + + TAINT_NOT; + return 0; +} + +#ifdef DEBUGGING + +dEXT char **watchaddr = 0; +dEXT char *watchok; + +#ifndef PERL_OBJECT +static void debprof _((OP*o)); +#endif + +#endif /* DEBUGGING */ + +int +runops_debug(void) +{ +#ifdef DEBUGGING + dTHR; + if (!PL_op) { + warn("NULL OP IN RUN"); + return 0; + } + + do { + if (PL_debug) { + if (watchaddr != 0 && *watchaddr != watchok) + PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", + (long)watchaddr, (long)watchok, (long)*watchaddr); + DEBUG_s(debstack()); + DEBUG_t(debop(PL_op)); + DEBUG_P(debprof(PL_op)); + } + } while ( PL_op = (CALLOP->op_ppaddr)(ARGS) ); + + TAINT_NOT; + return 0; +#else + return runops_standard(); +#endif /* DEBUGGING */ +} + +I32 +debop(OP *o) +{ +#ifdef DEBUGGING + SV *sv; + deb("%s", op_name[o->op_type]); + switch (o->op_type) { + case OP_CONST: + PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv)); + break; + case OP_GVSV: + case OP_GV: + if (cGVOPo->op_gv) { + sv = NEWSV(0,0); + gv_fullname3(sv, cGVOPo->op_gv, Nullch); + PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na)); + SvREFCNT_dec(sv); + } + else + PerlIO_printf(Perl_debug_log, "(NULL)"); + break; + default: + break; + } + PerlIO_printf(Perl_debug_log, "\n"); +#endif /* DEBUGGING */ + return 0; +} + +void +watch(char **addr) +{ +#ifdef DEBUGGING + watchaddr = addr; + watchok = *addr; + PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", + (long)watchaddr, (long)watchok); +#endif /* DEBUGGING */ +} + +STATIC void +debprof(OP *o) +{ +#ifdef DEBUGGING + if (!PL_profiledata) + Newz(000, PL_profiledata, MAXO, U32); + ++PL_profiledata[o->op_type]; +#endif /* DEBUGGING */ +} + +void +debprofdump(void) +{ +#ifdef DEBUGGING + unsigned i; + if (!PL_profiledata) + return; + for (i = 0; i < MAXO; i++) { + if (PL_profiledata[i]) + PerlIO_printf(Perl_debug_log, + "%5lu %s\n", (unsigned long)PL_profiledata[i], + op_name[i]); + } +#endif /* DEBUGGING */ +} diff --git a/contrib/perl5/scope.c b/contrib/perl5/scope.c new file mode 100644 index 00000000000..067e29edaae --- /dev/null +++ b/contrib/perl5/scope.c @@ -0,0 +1,915 @@ +/* scope.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * "For the fashion of Minas Tirith was such that it was built on seven + * levels..." + */ + +#include "EXTERN.h" +#include "perl.h" + +SV** +stack_grow(SV **sp, SV **p, int n) +{ + dTHR; +#if defined(DEBUGGING) && !defined(USE_THREADS) + static int growing = 0; + if (growing++) + abort(); +#endif + PL_stack_sp = sp; +#ifndef STRESS_REALLOC + av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128); +#else + av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1); +#endif +#if defined(DEBUGGING) && !defined(USE_THREADS) + growing--; +#endif + return PL_stack_sp; +} + +#ifndef STRESS_REALLOC +#define GROW(old) ((old) * 3 / 2) +#else +#define GROW(old) ((old) + 1) +#endif + +PERL_SI * +new_stackinfo(I32 stitems, I32 cxitems) +{ + PERL_SI *si; + PERL_CONTEXT *cxt; + New(56, si, 1, PERL_SI); + si->si_stack = newAV(); + AvREAL_off(si->si_stack); + av_extend(si->si_stack, stitems > 0 ? stitems-1 : 0); + AvALLOC(si->si_stack)[0] = &PL_sv_undef; + AvFILLp(si->si_stack) = 0; + si->si_prev = 0; + si->si_next = 0; + si->si_cxmax = cxitems - 1; + si->si_cxix = -1; + si->si_type = PERLSI_UNDEF; + New(56, si->si_cxstack, cxitems, PERL_CONTEXT); + return si; +} + +I32 +cxinc(void) +{ + dTHR; + cxstack_max = GROW(cxstack_max); + Renew(cxstack, cxstack_max + 1, PERL_CONTEXT); /* XXX should fix CXINC macro */ + return cxstack_ix + 1; +} + +void +push_return(OP *retop) +{ + dTHR; + if (PL_retstack_ix == PL_retstack_max) { + PL_retstack_max = GROW(PL_retstack_max); + Renew(PL_retstack, PL_retstack_max, OP*); + } + PL_retstack[PL_retstack_ix++] = retop; +} + +OP * +pop_return(void) +{ + dTHR; + if (PL_retstack_ix > 0) + return PL_retstack[--PL_retstack_ix]; + else + return Nullop; +} + +void +push_scope(void) +{ + dTHR; + if (PL_scopestack_ix == PL_scopestack_max) { + PL_scopestack_max = GROW(PL_scopestack_max); + Renew(PL_scopestack, PL_scopestack_max, I32); + } + PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix; + +} + +void +pop_scope(void) +{ + dTHR; + I32 oldsave = PL_scopestack[--PL_scopestack_ix]; + LEAVE_SCOPE(oldsave); +} + +void +markstack_grow(void) +{ + dTHR; + I32 oldmax = PL_markstack_max - PL_markstack; + I32 newmax = GROW(oldmax); + + Renew(PL_markstack, newmax, I32); + PL_markstack_ptr = PL_markstack + oldmax; + PL_markstack_max = PL_markstack + newmax; +} + +void +savestack_grow(void) +{ + dTHR; + PL_savestack_max = GROW(PL_savestack_max) + 4; + Renew(PL_savestack, PL_savestack_max, ANY); +} + +#undef GROW + +void +free_tmps(void) +{ + dTHR; + /* XXX should tmps_floor live in cxstack? */ + I32 myfloor = PL_tmps_floor; + while (PL_tmps_ix > myfloor) { /* clean up after last statement */ + SV* sv = PL_tmps_stack[PL_tmps_ix]; + PL_tmps_stack[PL_tmps_ix--] = Nullsv; + if (sv) { +#ifdef DEBUGGING + SvTEMP_off(sv); +#endif + SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */ + } + } +} + +STATIC SV * +save_scalar_at(SV **sptr) +{ + dTHR; + register SV *sv; + SV *osv = *sptr; + + sv = *sptr = NEWSV(0,0); + if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { + sv_upgrade(sv, SvTYPE(osv)); + if (SvGMAGICAL(osv)) { + MAGIC* mg; + bool oldtainted = PL_tainted; + mg_get(osv); + if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) { + SAVESPTR(mg->mg_obj); + mg->mg_obj = osv; + } + SvFLAGS(osv) |= (SvFLAGS(osv) & + (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + PL_tainted = oldtainted; + } + SvMAGIC(sv) = SvMAGIC(osv); + SvFLAGS(sv) |= SvMAGICAL(osv); + PL_localizing = 1; + SvSETMAGIC(sv); + PL_localizing = 0; + } + return sv; +} + +SV * +save_scalar(GV *gv) +{ + dTHR; + SV **sptr = &GvSV(gv); + SSCHECK(3); + SSPUSHPTR(SvREFCNT_inc(gv)); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_SV); + return save_scalar_at(sptr); +} + +SV* +save_svref(SV **sptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(sptr); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_SVREF); + return save_scalar_at(sptr); +} + +void +save_gp(GV *gv, I32 empty) +{ + dTHR; + SSCHECK(6); + SSPUSHIV((IV)SvLEN(gv)); + SvLEN(gv) = 0; /* forget that anything was allocated here */ + SSPUSHIV((IV)SvCUR(gv)); + SSPUSHPTR(SvPVX(gv)); + SvPOK_off(gv); + SSPUSHPTR(SvREFCNT_inc(gv)); + SSPUSHPTR(GvGP(gv)); + SSPUSHINT(SAVEt_GP); + + if (empty) { + register GP *gp; + + if (GvCVu(gv)) + PL_sub_generation++; /* taking a method out of circulation */ + Newz(602, gp, 1, GP); + GvGP(gv) = gp_ref(gp); + GvSV(gv) = NEWSV(72,0); + GvLINE(gv) = PL_curcop->cop_line; + GvEGV(gv) = gv; + } + else { + gp_ref(GvGP(gv)); + GvINTRO_on(gv); + } +} + +AV * +save_ary(GV *gv) +{ + dTHR; + AV *oav = GvAVn(gv); + AV *av; + + if (!AvREAL(oav) && AvREIFY(oav)) + av_reify(oav); + SSCHECK(3); + SSPUSHPTR(gv); + SSPUSHPTR(oav); + SSPUSHINT(SAVEt_AV); + + GvAV(gv) = Null(AV*); + av = GvAVn(gv); + if (SvMAGIC(oav)) { + SvMAGIC(av) = SvMAGIC(oav); + SvFLAGS(av) |= SvMAGICAL(oav); + SvMAGICAL_off(oav); + SvMAGIC(oav) = 0; + PL_localizing = 1; + SvSETMAGIC((SV*)av); + PL_localizing = 0; + } + return av; +} + +HV * +save_hash(GV *gv) +{ + dTHR; + HV *ohv, *hv; + + SSCHECK(3); + SSPUSHPTR(gv); + SSPUSHPTR(ohv = GvHVn(gv)); + SSPUSHINT(SAVEt_HV); + + GvHV(gv) = Null(HV*); + hv = GvHVn(gv); + if (SvMAGIC(ohv)) { + SvMAGIC(hv) = SvMAGIC(ohv); + SvFLAGS(hv) |= SvMAGICAL(ohv); + SvMAGICAL_off(ohv); + SvMAGIC(ohv) = 0; + PL_localizing = 1; + SvSETMAGIC((SV*)hv); + PL_localizing = 0; + } + return hv; +} + +void +save_item(register SV *item) +{ + dTHR; + register SV *sv = NEWSV(0,0); + + sv_setsv(sv,item); + SSCHECK(3); + SSPUSHPTR(item); /* remember the pointer */ + SSPUSHPTR(sv); /* remember the value */ + SSPUSHINT(SAVEt_ITEM); +} + +void +save_int(int *intp) +{ + dTHR; + SSCHECK(3); + SSPUSHINT(*intp); + SSPUSHPTR(intp); + SSPUSHINT(SAVEt_INT); +} + +void +save_long(long int *longp) +{ + dTHR; + SSCHECK(3); + SSPUSHLONG(*longp); + SSPUSHPTR(longp); + SSPUSHINT(SAVEt_LONG); +} + +void +save_I32(I32 *intp) +{ + dTHR; + SSCHECK(3); + SSPUSHINT(*intp); + SSPUSHPTR(intp); + SSPUSHINT(SAVEt_I32); +} + +void +save_I16(I16 *intp) +{ + dTHR; + SSCHECK(3); + SSPUSHINT(*intp); + SSPUSHPTR(intp); + SSPUSHINT(SAVEt_I16); +} + +void +save_iv(IV *ivp) +{ + dTHR; + SSCHECK(3); + SSPUSHIV(*ivp); + SSPUSHPTR(ivp); + SSPUSHINT(SAVEt_IV); +} + +/* Cannot use save_sptr() to store a char* since the SV** cast will + * force word-alignment and we'll miss the pointer. + */ +void +save_pptr(char **pptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(*pptr); + SSPUSHPTR(pptr); + SSPUSHINT(SAVEt_PPTR); +} + +void +save_sptr(SV **sptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(*sptr); + SSPUSHPTR(sptr); + SSPUSHINT(SAVEt_SPTR); +} + +SV ** +save_threadsv(PADOFFSET i) +{ +#ifdef USE_THREADS + dTHR; + SV **svp = &THREADSV(i); /* XXX Change to save by offset */ + DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", + i, svp, *svp, SvPEEK(*svp))); + save_svref(svp); + return svp; +#else + croak("panic: save_threadsv called in non-threaded perl"); + return 0; +#endif /* USE_THREADS */ +} + +void +save_nogv(GV *gv) +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(gv); + SSPUSHINT(SAVEt_NSTAB); +} + +void +save_hptr(HV **hptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(*hptr); + SSPUSHPTR(hptr); + SSPUSHINT(SAVEt_HPTR); +} + +void +save_aptr(AV **aptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(*aptr); + SSPUSHPTR(aptr); + SSPUSHINT(SAVEt_APTR); +} + +void +save_freesv(SV *sv) +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(sv); + SSPUSHINT(SAVEt_FREESV); +} + +void +save_freeop(OP *o) +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(o); + SSPUSHINT(SAVEt_FREEOP); +} + +void +save_freepv(char *pv) +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(pv); + SSPUSHINT(SAVEt_FREEPV); +} + +void +save_clearsv(SV **svp) +{ + dTHR; + SSCHECK(2); + SSPUSHLONG((long)(svp-PL_curpad)); + SSPUSHINT(SAVEt_CLEARSV); +} + +void +save_delete(HV *hv, char *key, I32 klen) +{ + dTHR; + SSCHECK(4); + SSPUSHINT(klen); + SSPUSHPTR(key); + SSPUSHPTR(SvREFCNT_inc(hv)); + SSPUSHINT(SAVEt_DELETE); +} + +void +save_list(register SV **sarg, I32 maxsarg) +{ + dTHR; + register SV *sv; + register I32 i; + + for (i = 1; i <= maxsarg; i++) { + sv = NEWSV(0,0); + sv_setsv(sv,sarg[i]); + SSCHECK(3); + SSPUSHPTR(sarg[i]); /* remember the pointer */ + SSPUSHPTR(sv); /* remember the value */ + SSPUSHINT(SAVEt_ITEM); + } +} + +void +#ifdef PERL_OBJECT +save_destructor(DESTRUCTORFUNC f, void* p) +#else +save_destructor(void (*f) (void *), void *p) +#endif +{ + dTHR; + SSCHECK(3); + SSPUSHDPTR(f); + SSPUSHPTR(p); + SSPUSHINT(SAVEt_DESTRUCTOR); +} + +void +save_aelem(AV *av, I32 idx, SV **sptr) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(SvREFCNT_inc(av)); + SSPUSHINT(idx); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_AELEM); + save_scalar_at(sptr); +} + +void +save_helem(HV *hv, SV *key, SV **sptr) +{ + dTHR; + SSCHECK(4); + SSPUSHPTR(SvREFCNT_inc(hv)); + SSPUSHPTR(SvREFCNT_inc(key)); + SSPUSHPTR(SvREFCNT_inc(*sptr)); + SSPUSHINT(SAVEt_HELEM); + save_scalar_at(sptr); +} + +void +save_op(void) +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(PL_op); + SSPUSHINT(SAVEt_OP); +} + +void +leave_scope(I32 base) +{ + dTHR; + register SV *sv; + register SV *value; + register GV *gv; + register AV *av; + register HV *hv; + register void* ptr; + I32 i; + + if (base < -1) + croak("panic: corrupt saved stack index"); + while (PL_savestack_ix > base) { + switch (SSPOPINT) { + case SAVEt_ITEM: /* normal string */ + value = (SV*)SSPOPPTR; + sv = (SV*)SSPOPPTR; + sv_replace(sv,value); + PL_localizing = 2; + SvSETMAGIC(sv); + PL_localizing = 0; + break; + case SAVEt_SV: /* scalar reference */ + value = (SV*)SSPOPPTR; + gv = (GV*)SSPOPPTR; + ptr = &GvSV(gv); + SvREFCNT_dec(gv); + goto restore_sv; + case SAVEt_SVREF: /* scalar reference */ + value = (SV*)SSPOPPTR; + ptr = SSPOPPTR; + restore_sv: + sv = *(SV**)ptr; + DEBUG_S(PerlIO_printf(PerlIO_stderr(), + "restore svref: %p %p:%s -> %p:%s\n", + ptr, sv, SvPEEK(sv), value, SvPEEK(value))); + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && + SvTYPE(sv) != SVt_PVGV) + { + (void)SvUPGRADE(value, SvTYPE(sv)); + SvMAGIC(value) = SvMAGIC(sv); + SvFLAGS(value) |= SvMAGICAL(sv); + SvMAGICAL_off(sv); + SvMAGIC(sv) = 0; + } + else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) && + SvTYPE(value) != SVt_PVGV) + { + SvFLAGS(value) |= (SvFLAGS(value) & + (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + SvMAGICAL_off(value); + SvMAGIC(value) = 0; + } + SvREFCNT_dec(sv); + *(SV**)ptr = value; + PL_localizing = 2; + SvSETMAGIC(value); + PL_localizing = 0; + SvREFCNT_dec(value); + break; + case SAVEt_AV: /* array reference */ + av = (AV*)SSPOPPTR; + gv = (GV*)SSPOPPTR; + if (GvAV(gv)) { + AV *goner = GvAV(gv); + SvMAGIC(av) = SvMAGIC(goner); + SvFLAGS(av) |= SvMAGICAL(goner); + SvMAGICAL_off(goner); + SvMAGIC(goner) = 0; + SvREFCNT_dec(goner); + } + GvAV(gv) = av; + if (SvMAGICAL(av)) { + PL_localizing = 2; + SvSETMAGIC((SV*)av); + PL_localizing = 0; + } + break; + case SAVEt_HV: /* hash reference */ + hv = (HV*)SSPOPPTR; + gv = (GV*)SSPOPPTR; + if (GvHV(gv)) { + HV *goner = GvHV(gv); + SvMAGIC(hv) = SvMAGIC(goner); + SvFLAGS(hv) |= SvMAGICAL(goner); + SvMAGICAL_off(goner); + SvMAGIC(goner) = 0; + SvREFCNT_dec(goner); + } + GvHV(gv) = hv; + if (SvMAGICAL(hv)) { + PL_localizing = 2; + SvSETMAGIC((SV*)hv); + PL_localizing = 0; + } + break; + case SAVEt_INT: /* int reference */ + ptr = SSPOPPTR; + *(int*)ptr = (int)SSPOPINT; + break; + case SAVEt_LONG: /* long reference */ + ptr = SSPOPPTR; + *(long*)ptr = (long)SSPOPLONG; + break; + case SAVEt_I32: /* I32 reference */ + ptr = SSPOPPTR; + *(I32*)ptr = (I32)SSPOPINT; + break; + case SAVEt_I16: /* I16 reference */ + ptr = SSPOPPTR; + *(I16*)ptr = (I16)SSPOPINT; + break; + case SAVEt_IV: /* IV reference */ + ptr = SSPOPPTR; + *(IV*)ptr = (IV)SSPOPIV; + break; + case SAVEt_SPTR: /* SV* reference */ + ptr = SSPOPPTR; + *(SV**)ptr = (SV*)SSPOPPTR; + break; + case SAVEt_PPTR: /* char* reference */ + ptr = SSPOPPTR; + *(char**)ptr = (char*)SSPOPPTR; + break; + case SAVEt_HPTR: /* HV* reference */ + ptr = SSPOPPTR; + *(HV**)ptr = (HV*)SSPOPPTR; + break; + case SAVEt_APTR: /* AV* reference */ + ptr = SSPOPPTR; + *(AV**)ptr = (AV*)SSPOPPTR; + break; + case SAVEt_NSTAB: + gv = (GV*)SSPOPPTR; + (void)sv_clear((SV*)gv); + break; + case SAVEt_GP: /* scalar reference */ + ptr = SSPOPPTR; + gv = (GV*)SSPOPPTR; + if (SvPVX(gv) && SvLEN(gv) > 0) { + Safefree(SvPVX(gv)); + } + SvPVX(gv) = (char *)SSPOPPTR; + SvCUR(gv) = (STRLEN)SSPOPIV; + SvLEN(gv) = (STRLEN)SSPOPIV; + gp_free(gv); + GvGP(gv) = (GP*)ptr; + if (GvCVu(gv)) + PL_sub_generation++; /* putting a method back into circulation */ + SvREFCNT_dec(gv); + break; + case SAVEt_FREESV: + ptr = SSPOPPTR; + SvREFCNT_dec((SV*)ptr); + break; + case SAVEt_FREEOP: + ptr = SSPOPPTR; + if (PL_comppad) + PL_curpad = AvARRAY(PL_comppad); + op_free((OP*)ptr); + break; + case SAVEt_FREEPV: + ptr = SSPOPPTR; + Safefree((char*)ptr); + break; + case SAVEt_CLEARSV: + ptr = (void*)&PL_curpad[SSPOPLONG]; + sv = *(SV**)ptr; + /* Can clear pad variable in place? */ + if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) { + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) + croak("panic: leave_scope clearsv"); + if (SvROK(sv)) + sv_unref(sv); + } + if (SvMAGICAL(sv)) + mg_free(sv); + + switch (SvTYPE(sv)) { + case SVt_NULL: + break; + case SVt_PVAV: + av_clear((AV*)sv); + break; + case SVt_PVHV: + hv_clear((HV*)sv); + break; + case SVt_PVCV: + croak("panic: leave_scope pad code"); + case SVt_RV: + case SVt_IV: + case SVt_NV: + (void)SvOK_off(sv); + break; + default: + (void)SvOK_off(sv); + (void)SvOOK_off(sv); + break; + } + } + else { /* Someone has a claim on this, so abandon it. */ + U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP); + switch (SvTYPE(sv)) { /* Console ourselves with a new value */ + case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break; + case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break; + default: *(SV**)ptr = NEWSV(0,0); break; + } + SvREFCNT_dec(sv); /* Cast current value to the winds. */ + SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */ + } + break; + case SAVEt_DELETE: + ptr = SSPOPPTR; + hv = (HV*)ptr; + ptr = SSPOPPTR; + (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD); + SvREFCNT_dec(hv); + Safefree(ptr); + break; + case SAVEt_DESTRUCTOR: + ptr = SSPOPPTR; + (CALLDESTRUCTOR)(ptr); + break; + case SAVEt_REGCONTEXT: + i = SSPOPINT; + PL_savestack_ix -= i; /* regexp must have croaked */ + break; + case SAVEt_STACK_POS: /* Position on Perl stack */ + i = SSPOPINT; + PL_stack_sp = PL_stack_base + i; + break; + case SAVEt_AELEM: /* array element */ + value = (SV*)SSPOPPTR; + i = SSPOPINT; + av = (AV*)SSPOPPTR; + ptr = av_fetch(av,i,1); + if (ptr) { + sv = *(SV**)ptr; + if (sv && sv != &PL_sv_undef) { + if (SvRMAGICAL(av) && mg_find((SV*)av, 'P')) + (void)SvREFCNT_inc(sv); + SvREFCNT_dec(av); + goto restore_sv; + } + } + SvREFCNT_dec(av); + SvREFCNT_dec(value); + break; + case SAVEt_HELEM: /* hash element */ + value = (SV*)SSPOPPTR; + sv = (SV*)SSPOPPTR; + hv = (HV*)SSPOPPTR; + ptr = hv_fetch_ent(hv, sv, 1, 0); + if (ptr) { + SV *oval = HeVAL((HE*)ptr); + if (oval && oval != &PL_sv_undef) { + ptr = &HeVAL((HE*)ptr); + if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P')) + (void)SvREFCNT_inc(*(SV**)ptr); + SvREFCNT_dec(hv); + SvREFCNT_dec(sv); + goto restore_sv; + } + } + SvREFCNT_dec(hv); + SvREFCNT_dec(sv); + SvREFCNT_dec(value); + break; + case SAVEt_OP: + PL_op = (OP*)SSPOPPTR; + break; + case SAVEt_HINTS: + if (GvHV(PL_hintgv)) { + SvREFCNT_dec((SV*)GvHV(PL_hintgv)); + GvHV(PL_hintgv) = NULL; + } + *(I32*)&PL_hints = (I32)SSPOPINT; + break; + default: + croak("panic: leave_scope inconsistency"); + } + } +} + +void +cx_dump(PERL_CONTEXT *cx) +{ +#ifdef DEBUGGING + dTHR; + PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]); + if (cx->cx_type != CXt_SUBST) { + PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); + PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop); + PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); + PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); + PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); + PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm); + PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); + } + switch (cx->cx_type) { + case CXt_NULL: + case CXt_BLOCK: + break; + case CXt_SUB: + PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n", + (long)cx->blk_sub.cv); + PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n", + (long)cx->blk_sub.gv); + PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n", + (long)cx->blk_sub.dfoutgv); + PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", + (long)cx->blk_sub.olddepth); + PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", + (int)cx->blk_sub.hasargs); + break; + case CXt_EVAL: + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", + (long)cx->blk_eval.old_in_eval); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", + op_name[cx->blk_eval.old_op_type], + op_desc[cx->blk_eval.old_op_type]); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", + cx->blk_eval.old_name); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", + (long)cx->blk_eval.old_eval_root); + break; + + case CXt_LOOP: + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", + cx->blk_loop.label); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n", + (long)cx->blk_loop.resetsp); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n", + (long)cx->blk_loop.redo_op); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n", + (long)cx->blk_loop.next_op); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n", + (long)cx->blk_loop.last_op); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", + (long)cx->blk_loop.iterix); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n", + (long)cx->blk_loop.iterary); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n", + (long)cx->blk_loop.itervar); + if (cx->blk_loop.itervar) + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n", + (long)cx->blk_loop.itersave); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n", + (long)cx->blk_loop.iterlval); + break; + + case CXt_SUBST: + PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n", + (long)cx->sb_iters); + PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n", + (long)cx->sb_maxiters); + PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n", + (long)cx->sb_safebase); + PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n", + (long)cx->sb_once); + PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", + cx->sb_orig); + PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n", + (long)cx->sb_dstr); + PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n", + (long)cx->sb_targ); + PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n", + (long)cx->sb_s); + PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n", + (long)cx->sb_m); + PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n", + (long)cx->sb_strend); + PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n", + (long)cx->sb_rxres); + break; + } +#endif /* DEBUGGING */ +} diff --git a/contrib/perl5/scope.h b/contrib/perl5/scope.h new file mode 100644 index 00000000000..0dde4e12a06 --- /dev/null +++ b/contrib/perl5/scope.h @@ -0,0 +1,171 @@ +#define SAVEt_ITEM 0 +#define SAVEt_SV 1 +#define SAVEt_AV 2 +#define SAVEt_HV 3 +#define SAVEt_INT 4 +#define SAVEt_LONG 5 +#define SAVEt_I32 6 +#define SAVEt_IV 7 +#define SAVEt_SPTR 8 +#define SAVEt_APTR 9 +#define SAVEt_HPTR 10 +#define SAVEt_PPTR 11 +#define SAVEt_NSTAB 12 +#define SAVEt_SVREF 13 +#define SAVEt_GP 14 +#define SAVEt_FREESV 15 +#define SAVEt_FREEOP 16 +#define SAVEt_FREEPV 17 +#define SAVEt_CLEARSV 18 +#define SAVEt_DELETE 19 +#define SAVEt_DESTRUCTOR 20 +#define SAVEt_REGCONTEXT 21 +#define SAVEt_STACK_POS 22 +#define SAVEt_I16 23 +#define SAVEt_AELEM 24 +#define SAVEt_HELEM 25 +#define SAVEt_OP 26 +#define SAVEt_HINTS 27 + +#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() +#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) +#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i)) +#define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) +#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) +#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) +#define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) +#define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) +#define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) +#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) +#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) + +#define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix +#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() + +#ifdef DEBUGGING +#define ENTER \ + STMT_START { \ + push_scope(); \ + DEBUG_l(WITH_THR(deb("ENTER scope %ld at %s:%d\n", \ + PL_scopestack_ix, __FILE__, __LINE__))); \ + } STMT_END +#define LEAVE \ + STMT_START { \ + DEBUG_l(WITH_THR(deb("LEAVE scope %ld at %s:%d\n", \ + PL_scopestack_ix, __FILE__, __LINE__))); \ + pop_scope(); \ + } STMT_END +#else +#define ENTER push_scope() +#define LEAVE pop_scope() +#endif +#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old) + +/* + * Not using SOFT_CAST on SAVEFREESV and SAVEFREESV + * because these are used for several kinds of pointer values + */ +#define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i)) +#define SAVEI32(i) save_I32(SOFT_CAST(I32*)&(i)) +#define SAVEINT(i) save_int(SOFT_CAST(int*)&(i)) +#define SAVEIV(i) save_iv(SOFT_CAST(IV*)&(i)) +#define SAVELONG(l) save_long(SOFT_CAST(long*)&(l)) +#define SAVESPTR(s) save_sptr((SV**)&(s)) +#define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s)) +#define SAVEFREESV(s) save_freesv((SV*)(s)) +#define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o)) +#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) +#define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv)) +#define SAVEDELETE(h,k,l) \ + save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) +#ifdef PERL_OBJECT +#define CALLDESTRUCTOR this->*SSPOPDPTR +#define SAVEDESTRUCTOR(f,p) \ + save_destructor((DESTRUCTORFUNC)(FUNC_NAME_TO_PTR(f)), \ + SOFT_CAST(void*)(p)) +#else +#define CALLDESTRUCTOR *SSPOPDPTR +#define SAVEDESTRUCTOR(f,p) \ + save_destructor(SOFT_CAST(void(*)_((void*)))(FUNC_NAME_TO_PTR(f)), \ + SOFT_CAST(void*)(p)) +#endif + +#define SAVESTACK_POS() \ + STMT_START { \ + SSCHECK(2); \ + SSPUSHINT(PL_stack_sp - PL_stack_base); \ + SSPUSHINT(SAVEt_STACK_POS); \ + } STMT_END + +#define SAVEOP() save_op() + +#define SAVEHINTS() \ + STMT_START { \ + if (PL_hints & HINT_LOCALIZE_HH) \ + save_hints(); \ + else { \ + SSCHECK(2); \ + SSPUSHINT(PL_hints); \ + SSPUSHINT(SAVEt_HINTS); \ + } \ + } STMT_END + +/* A jmpenv packages the state required to perform a proper non-local jump. + * Note that there is a start_env initialized when perl starts, and top_env + * points to this initially, so top_env should always be non-null. + * + * Existence of a non-null top_env->je_prev implies it is valid to call + * longjmp() at that runlevel (we make sure start_env.je_prev is always + * null to ensure this). + * + * je_mustcatch, when set at any runlevel to TRUE, means eval ops must + * establish a local jmpenv to handle exception traps. Care must be taken + * to restore the previous value of je_mustcatch before exiting the + * stack frame iff JMPENV_PUSH was not called in that stack frame. + * GSAR 97-03-27 + */ + +struct jmpenv { + struct jmpenv * je_prev; + Sigjmp_buf je_buf; + int je_ret; /* return value of last setjmp() */ + bool je_mustcatch; /* longjmp()s must be caught locally */ +}; + +typedef struct jmpenv JMPENV; + +#ifdef OP_IN_REGISTER +#define OP_REG_TO_MEM PL_opsave = op +#define OP_MEM_TO_REG op = PL_opsave +#else +#define OP_REG_TO_MEM NOOP +#define OP_MEM_TO_REG NOOP +#endif + +#define dJMPENV JMPENV cur_env +#define JMPENV_PUSH(v) \ + STMT_START { \ + cur_env.je_prev = PL_top_env; \ + OP_REG_TO_MEM; \ + cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1); \ + OP_MEM_TO_REG; \ + PL_top_env = &cur_env; \ + cur_env.je_mustcatch = FALSE; \ + (v) = cur_env.je_ret; \ + } STMT_END +#define JMPENV_POP \ + STMT_START { PL_top_env = cur_env.je_prev; } STMT_END +#define JMPENV_JUMP(v) \ + STMT_START { \ + OP_REG_TO_MEM; \ + if (PL_top_env->je_prev) \ + PerlProc_longjmp(PL_top_env->je_buf, (v)); \ + if ((v) == 2) \ + PerlProc_exit(STATUS_NATIVE_EXPORT); \ + PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ + PerlProc_exit(1); \ + } STMT_END + +#define CATCH_GET (PL_top_env->je_mustcatch) +#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) + diff --git a/contrib/perl5/sv.c b/contrib/perl5/sv.c new file mode 100644 index 00000000000..a53e76979eb --- /dev/null +++ b/contrib/perl5/sv.c @@ -0,0 +1,5148 @@ +/* sv.c + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* + * "I wonder what the Entish is for 'yes' and 'no'," he thought. + */ + +#include "EXTERN.h" +#include "perl.h" + +#ifdef OVR_DBL_DIG +/* Use an overridden DBL_DIG */ +# ifdef DBL_DIG +# undef DBL_DIG +# endif +# define DBL_DIG OVR_DBL_DIG +#else +/* The following is all to get DBL_DIG, in order to pick a nice + default value for printing floating point numbers in Gconvert. + (see config.h) +*/ +#ifdef I_LIMITS +#include +#endif +#ifdef I_FLOAT +#include +#endif +#ifndef HAS_DBL_DIG +#define DBL_DIG 15 /* A guess that works lots of places */ +#endif +#endif + +#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE) && !defined(__QNX__) +# define FAST_SV_GETS +#endif + +#ifdef PERL_OBJECT +#define FCALL this->*f +#define VTBL this->*vtbl + +#else /* !PERL_OBJECT */ + +static IV asIV _((SV* sv)); +static UV asUV _((SV* sv)); +static SV *more_sv _((void)); +static XPVIV *more_xiv _((void)); +static XPVNV *more_xnv _((void)); +static XPV *more_xpv _((void)); +static XRV *more_xrv _((void)); +static XPVIV *new_xiv _((void)); +static XPVNV *new_xnv _((void)); +static XPV *new_xpv _((void)); +static XRV *new_xrv _((void)); +static void del_xiv _((XPVIV* p)); +static void del_xnv _((XPVNV* p)); +static void del_xpv _((XPV* p)); +static void del_xrv _((XRV* p)); +static void sv_mortalgrow _((void)); +static void sv_unglob _((SV* sv)); +static void sv_check_thinkfirst _((SV *sv)); + +#ifndef PURIFY +static void *my_safemalloc(MEM_SIZE size); +#endif + +typedef void (*SVFUNC) _((SV*)); +#define VTBL *vtbl +#define FCALL *f + +#endif /* PERL_OBJECT */ + +#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) + +#ifdef PURIFY + +#define new_SV(p) \ + do { \ + LOCK_SV_MUTEX; \ + (p) = (SV*)safemalloc(sizeof(SV)); \ + reg_add(p); \ + UNLOCK_SV_MUTEX; \ + } while (0) + +#define del_SV(p) \ + do { \ + LOCK_SV_MUTEX; \ + reg_remove(p); \ + Safefree((char*)(p)); \ + UNLOCK_SV_MUTEX; \ + } while (0) + +static SV **registry; +static I32 registry_size; + +#define REGHASH(sv,size) ((((U32)(sv)) >> 2) % (size)) + +#define REG_REPLACE(sv,a,b) \ + do { \ + void* p = sv->sv_any; \ + I32 h = REGHASH(sv, registry_size); \ + I32 i = h; \ + while (registry[i] != (a)) { \ + if (++i >= registry_size) \ + i = 0; \ + if (i == h) \ + die("SV registry bug"); \ + } \ + registry[i] = (b); \ + } while (0) + +#define REG_ADD(sv) REG_REPLACE(sv,Nullsv,sv) +#define REG_REMOVE(sv) REG_REPLACE(sv,sv,Nullsv) + +static void +reg_add(sv) +SV* sv; +{ + if (PL_sv_count >= (registry_size >> 1)) + { + SV **oldreg = registry; + I32 oldsize = registry_size; + + registry_size = registry_size ? ((registry_size << 2) + 1) : 2037; + Newz(707, registry, registry_size, SV*); + + if (oldreg) { + I32 i; + + for (i = 0; i < oldsize; ++i) { + SV* oldsv = oldreg[i]; + if (oldsv) + REG_ADD(oldsv); + } + Safefree(oldreg); + } + } + + REG_ADD(sv); + ++PL_sv_count; +} + +static void +reg_remove(sv) +SV* sv; +{ + REG_REMOVE(sv); + --PL_sv_count; +} + +static void +visit(f) +SVFUNC f; +{ + I32 i; + + for (i = 0; i < registry_size; ++i) { + SV* sv = registry[i]; + if (sv && SvTYPE(sv) != SVTYPEMASK) + (*f)(sv); + } +} + +void +sv_add_arena(ptr, size, flags) +char* ptr; +U32 size; +U32 flags; +{ + if (!(flags & SVf_FAKE)) + Safefree(ptr); +} + +#else /* ! PURIFY */ + +/* + * "A time to plant, and a time to uproot what was planted..." + */ + +#define plant_SV(p) \ + do { \ + SvANY(p) = (void *)PL_sv_root; \ + SvFLAGS(p) = SVTYPEMASK; \ + PL_sv_root = (p); \ + --PL_sv_count; \ + } while (0) + +/* sv_mutex must be held while calling uproot_SV() */ +#define uproot_SV(p) \ + do { \ + (p) = PL_sv_root; \ + PL_sv_root = (SV*)SvANY(p); \ + ++PL_sv_count; \ + } while (0) + +#define new_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (PL_sv_root) \ + uproot_SV(p); \ + else \ + (p) = more_sv(); \ + UNLOCK_SV_MUTEX; \ + } while (0) + +#ifdef DEBUGGING + +#define del_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (PL_debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + UNLOCK_SV_MUTEX; \ + } while (0) + +STATIC void +del_sv(SV *p) +{ + if (PL_debug & 32768) { + SV* sva; + SV* sv; + SV* svend; + int ok = 0; + for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) { + sv = sva + 1; + svend = &sva[SvREFCNT(sva)]; + if (p >= sv && p < svend) + ok = 1; + } + if (!ok) { + warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p); + return; + } + } + plant_SV(p); +} + +#else /* ! DEBUGGING */ + +#define del_SV(p) plant_SV(p) + +#endif /* DEBUGGING */ + +void +sv_add_arena(char *ptr, U32 size, U32 flags) +{ + SV* sva = (SV*)ptr; + register SV* sv; + register SV* svend; + Zero(sva, size, char); + + /* The first SV in an arena isn't an SV. */ + SvANY(sva) = (void *) PL_sv_arenaroot; /* ptr to next arena */ + SvREFCNT(sva) = size / sizeof(SV); /* number of SV slots */ + SvFLAGS(sva) = flags; /* FAKE if not to be freed */ + + PL_sv_arenaroot = sva; + PL_sv_root = sva + 1; + + svend = &sva[SvREFCNT(sva) - 1]; + sv = sva + 1; + while (sv < svend) { + SvANY(sv) = (void *)(SV*)(sv + 1); + SvFLAGS(sv) = SVTYPEMASK; + sv++; + } + SvANY(sv) = 0; + SvFLAGS(sv) = SVTYPEMASK; +} + +/* sv_mutex must be held while calling more_sv() */ +STATIC SV* +more_sv(void) +{ + register SV* sv; + + if (PL_nice_chunk) { + sv_add_arena(PL_nice_chunk, PL_nice_chunk_size, 0); + PL_nice_chunk = Nullch; + } + else { + char *chunk; /* must use New here to match call to */ + New(704,chunk,1008,char); /* Safefree() in sv_free_arenas() */ + sv_add_arena(chunk, 1008, 0); + } + uproot_SV(sv); + return sv; +} + +STATIC void +visit(SVFUNC f) +{ + SV* sva; + SV* sv; + register SV* svend; + + for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) { + svend = &sva[SvREFCNT(sva)]; + for (sv = sva + 1; sv < svend; ++sv) { + if (SvTYPE(sv) != SVTYPEMASK) + (FCALL)(sv); + } + } +} + +#endif /* PURIFY */ + +STATIC void +do_report_used(SV *sv) +{ + if (SvTYPE(sv) != SVTYPEMASK) { + /* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */ + PerlIO_printf(PerlIO_stderr(), "****\n"); + sv_dump(sv); + } +} + +void +sv_report_used(void) +{ + visit(FUNC_NAME_TO_PTR(do_report_used)); +} + +STATIC void +do_clean_objs(SV *sv) +{ + SV* rv; + + if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) { + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(sv));) + SvROK_off(sv); + SvRV(sv) = 0; + SvREFCNT_dec(rv); + } + + /* XXX Might want to check arrays, etc. */ +} + +#ifndef DISABLE_DESTRUCTOR_KLUDGE +STATIC void +do_clean_named_objs(SV *sv) +{ + if (SvTYPE(sv) == SVt_PVGV) { + if ( SvOBJECT(GvSV(sv)) || + GvAV(sv) && SvOBJECT(GvAV(sv)) || + GvHV(sv) && SvOBJECT(GvHV(sv)) || + GvIO(sv) && SvOBJECT(GvIO(sv)) || + GvCV(sv) && SvOBJECT(GvCV(sv)) ) + { + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));) + SvREFCNT_dec(sv); + } + } +} +#endif + +void +sv_clean_objs(void) +{ + PL_in_clean_objs = TRUE; + visit(FUNC_NAME_TO_PTR(do_clean_objs)); +#ifndef DISABLE_DESTRUCTOR_KLUDGE + /* some barnacles may yet remain, clinging to typeglobs */ + visit(FUNC_NAME_TO_PTR(do_clean_named_objs)); +#endif + PL_in_clean_objs = FALSE; +} + +STATIC void +do_clean_all(SV *sv) +{ + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );) + SvFLAGS(sv) |= SVf_BREAK; + SvREFCNT_dec(sv); +} + +void +sv_clean_all(void) +{ + PL_in_clean_all = TRUE; + visit(FUNC_NAME_TO_PTR(do_clean_all)); + PL_in_clean_all = FALSE; +} + +void +sv_free_arenas(void) +{ + SV* sva; + SV* svanext; + + /* Free arenas here, but be careful about fake ones. (We assume + contiguity of the fake ones with the corresponding real ones.) */ + + for (sva = PL_sv_arenaroot; sva; sva = svanext) { + svanext = (SV*) SvANY(sva); + while (svanext && SvFAKE(svanext)) + svanext = (SV*) SvANY(svanext); + + if (!SvFAKE(sva)) + Safefree((void *)sva); + } + + if (PL_nice_chunk) + Safefree(PL_nice_chunk); + PL_nice_chunk = Nullch; + PL_nice_chunk_size = 0; + PL_sv_arenaroot = 0; + PL_sv_root = 0; +} + +STATIC XPVIV* +new_xiv(void) +{ + IV* xiv; + if (PL_xiv_root) { + xiv = PL_xiv_root; + /* + * See comment in more_xiv() -- RAM. + */ + PL_xiv_root = *(IV**)xiv; + return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv)); + } + return more_xiv(); +} + +STATIC void +del_xiv(XPVIV *p) +{ + IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv)); + *(IV**)xiv = PL_xiv_root; + PL_xiv_root = xiv; +} + +STATIC XPVIV* +more_xiv(void) +{ + register IV* xiv; + register IV* xivend; + XPV* ptr; + New(705, ptr, 1008/sizeof(XPV), XPV); + ptr->xpv_pv = (char*)PL_xiv_arenaroot; /* linked list of xiv arenas */ + PL_xiv_arenaroot = ptr; /* to keep Purify happy */ + + xiv = (IV*) ptr; + xivend = &xiv[1008 / sizeof(IV) - 1]; + xiv += (sizeof(XPV) - 1) / sizeof(IV) + 1; /* fudge by size of XPV */ + PL_xiv_root = xiv; + while (xiv < xivend) { + *(IV**)xiv = (IV *)(xiv + 1); + xiv++; + } + *(IV**)xiv = 0; + return new_xiv(); +} + +STATIC XPVNV* +new_xnv(void) +{ + double* xnv; + if (PL_xnv_root) { + xnv = PL_xnv_root; + PL_xnv_root = *(double**)xnv; + return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv)); + } + return more_xnv(); +} + +STATIC void +del_xnv(XPVNV *p) +{ + double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv)); + *(double**)xnv = PL_xnv_root; + PL_xnv_root = xnv; +} + +STATIC XPVNV* +more_xnv(void) +{ + register double* xnv; + register double* xnvend; + New(711, xnv, 1008/sizeof(double), double); + xnvend = &xnv[1008 / sizeof(double) - 1]; + xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */ + PL_xnv_root = xnv; + while (xnv < xnvend) { + *(double**)xnv = (double*)(xnv + 1); + xnv++; + } + *(double**)xnv = 0; + return new_xnv(); +} + +STATIC XRV* +new_xrv(void) +{ + XRV* xrv; + if (PL_xrv_root) { + xrv = PL_xrv_root; + PL_xrv_root = (XRV*)xrv->xrv_rv; + return xrv; + } + return more_xrv(); +} + +STATIC void +del_xrv(XRV *p) +{ + p->xrv_rv = (SV*)PL_xrv_root; + PL_xrv_root = p; +} + +STATIC XRV* +more_xrv(void) +{ + register XRV* xrv; + register XRV* xrvend; + New(712, PL_xrv_root, 1008/sizeof(XRV), XRV); + xrv = PL_xrv_root; + xrvend = &xrv[1008 / sizeof(XRV) - 1]; + while (xrv < xrvend) { + xrv->xrv_rv = (SV*)(xrv + 1); + xrv++; + } + xrv->xrv_rv = 0; + return new_xrv(); +} + +STATIC XPV* +new_xpv(void) +{ + XPV* xpv; + if (PL_xpv_root) { + xpv = PL_xpv_root; + PL_xpv_root = (XPV*)xpv->xpv_pv; + return xpv; + } + return more_xpv(); +} + +STATIC void +del_xpv(XPV *p) +{ + p->xpv_pv = (char*)PL_xpv_root; + PL_xpv_root = p; +} + +STATIC XPV* +more_xpv(void) +{ + register XPV* xpv; + register XPV* xpvend; + New(713, PL_xpv_root, 1008/sizeof(XPV), XPV); + xpv = PL_xpv_root; + xpvend = &xpv[1008 / sizeof(XPV) - 1]; + while (xpv < xpvend) { + xpv->xpv_pv = (char*)(xpv + 1); + xpv++; + } + xpv->xpv_pv = 0; + return new_xpv(); +} + +#ifdef PURIFY +#define new_XIV() (void*)safemalloc(sizeof(XPVIV)) +#define del_XIV(p) Safefree((char*)p) +#else +#define new_XIV() (void*)new_xiv() +#define del_XIV(p) del_xiv((XPVIV*) p) +#endif + +#ifdef PURIFY +#define new_XNV() (void*)safemalloc(sizeof(XPVNV)) +#define del_XNV(p) Safefree((char*)p) +#else +#define new_XNV() (void*)new_xnv() +#define del_XNV(p) del_xnv((XPVNV*) p) +#endif + +#ifdef PURIFY +#define new_XRV() (void*)safemalloc(sizeof(XRV)) +#define del_XRV(p) Safefree((char*)p) +#else +#define new_XRV() (void*)new_xrv() +#define del_XRV(p) del_xrv((XRV*) p) +#endif + +#ifdef PURIFY +#define new_XPV() (void*)safemalloc(sizeof(XPV)) +#define del_XPV(p) Safefree((char*)p) +#else +#define new_XPV() (void*)new_xpv() +#define del_XPV(p) del_xpv((XPV *)p) +#endif + +#ifdef PURIFY +# define my_safemalloc(s) safemalloc(s) +# define my_safefree(s) free(s) +#else +STATIC void* +my_safemalloc(MEM_SIZE size) +{ + char *p; + New(717, p, size, char); + return (void*)p; +} +# define my_safefree(s) Safefree(s) +#endif + +#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV)) +#define del_XPVIV(p) my_safefree((char*)p) + +#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV)) +#define del_XPVNV(p) my_safefree((char*)p) + +#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG)) +#define del_XPVMG(p) my_safefree((char*)p) + +#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV)) +#define del_XPVLV(p) my_safefree((char*)p) + +#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV)) +#define del_XPVAV(p) my_safefree((char*)p) + +#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV)) +#define del_XPVHV(p) my_safefree((char*)p) + +#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV)) +#define del_XPVCV(p) my_safefree((char*)p) + +#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV)) +#define del_XPVGV(p) my_safefree((char*)p) + +#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM)) +#define del_XPVBM(p) my_safefree((char*)p) + +#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM)) +#define del_XPVFM(p) my_safefree((char*)p) + +#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO)) +#define del_XPVIO(p) my_safefree((char*)p) + +bool +sv_upgrade(register SV *sv, U32 mt) +{ + char* pv; + U32 cur; + U32 len; + IV iv; + double nv; + MAGIC* magic; + HV* stash; + + if (SvTYPE(sv) == mt) + return TRUE; + + if (mt < SVt_PVIV) + (void)SvOOK_off(sv); + + switch (SvTYPE(sv)) { + case SVt_NULL: + pv = 0; + cur = 0; + len = 0; + iv = 0; + nv = 0.0; + magic = 0; + stash = 0; + break; + case SVt_IV: + pv = 0; + cur = 0; + len = 0; + iv = SvIVX(sv); + nv = (double)SvIVX(sv); + del_XIV(SvANY(sv)); + magic = 0; + stash = 0; + if (mt == SVt_NV) + mt = SVt_PVNV; + else if (mt < SVt_PVIV) + mt = SVt_PVIV; + break; + case SVt_NV: + pv = 0; + cur = 0; + len = 0; + nv = SvNVX(sv); + iv = I_32(nv); + magic = 0; + stash = 0; + del_XNV(SvANY(sv)); + SvANY(sv) = 0; + if (mt < SVt_PVNV) + mt = SVt_PVNV; + break; + case SVt_RV: + pv = (char*)SvRV(sv); + cur = 0; + len = 0; + iv = (IV)pv; + nv = (double)(unsigned long)pv; + del_XRV(SvANY(sv)); + magic = 0; + stash = 0; + break; + case SVt_PV: + pv = SvPVX(sv); + cur = SvCUR(sv); + len = SvLEN(sv); + iv = 0; + nv = 0.0; + magic = 0; + stash = 0; + del_XPV(SvANY(sv)); + if (mt <= SVt_IV) + mt = SVt_PVIV; + else if (mt == SVt_NV) + mt = SVt_PVNV; + break; + case SVt_PVIV: + pv = SvPVX(sv); + cur = SvCUR(sv); + len = SvLEN(sv); + iv = SvIVX(sv); + nv = 0.0; + magic = 0; + stash = 0; + del_XPVIV(SvANY(sv)); + break; + case SVt_PVNV: + pv = SvPVX(sv); + cur = SvCUR(sv); + len = SvLEN(sv); + iv = SvIVX(sv); + nv = SvNVX(sv); + magic = 0; + stash = 0; + del_XPVNV(SvANY(sv)); + break; + case SVt_PVMG: + pv = SvPVX(sv); + cur = SvCUR(sv); + len = SvLEN(sv); + iv = SvIVX(sv); + nv = SvNVX(sv); + magic = SvMAGIC(sv); + stash = SvSTASH(sv); + del_XPVMG(SvANY(sv)); + break; + default: + croak("Can't upgrade that kind of scalar"); + } + + switch (mt) { + case SVt_NULL: + croak("Can't upgrade to undef"); + case SVt_IV: + SvANY(sv) = new_XIV(); + SvIVX(sv) = iv; + break; + case SVt_NV: + SvANY(sv) = new_XNV(); + SvNVX(sv) = nv; + break; + case SVt_RV: + SvANY(sv) = new_XRV(); + SvRV(sv) = (SV*)pv; + break; + case SVt_PV: + SvANY(sv) = new_XPV(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + break; + case SVt_PVIV: + SvANY(sv) = new_XPVIV(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + if (SvNIOK(sv)) + (void)SvIOK_on(sv); + SvNOK_off(sv); + break; + case SVt_PVNV: + SvANY(sv) = new_XPVNV(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + break; + case SVt_PVMG: + SvANY(sv) = new_XPVMG(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + break; + case SVt_PVLV: + SvANY(sv) = new_XPVLV(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + LvTARGOFF(sv) = 0; + LvTARGLEN(sv) = 0; + LvTARG(sv) = 0; + LvTYPE(sv) = 0; + break; + case SVt_PVAV: + SvANY(sv) = new_XPVAV(); + if (pv) + Safefree(pv); + SvPVX(sv) = 0; + AvMAX(sv) = -1; + AvFILLp(sv) = -1; + SvIVX(sv) = 0; + SvNVX(sv) = 0.0; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + AvALLOC(sv) = 0; + AvARYLEN(sv) = 0; + AvFLAGS(sv) = 0; + break; + case SVt_PVHV: + SvANY(sv) = new_XPVHV(); + if (pv) + Safefree(pv); + SvPVX(sv) = 0; + HvFILL(sv) = 0; + HvMAX(sv) = 0; + HvKEYS(sv) = 0; + SvNVX(sv) = 0.0; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + HvRITER(sv) = 0; + HvEITER(sv) = 0; + HvPMROOT(sv) = 0; + HvNAME(sv) = 0; + break; + case SVt_PVCV: + SvANY(sv) = new_XPVCV(); + Zero(SvANY(sv), 1, XPVCV); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + break; + case SVt_PVGV: + SvANY(sv) = new_XPVGV(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + GvGP(sv) = 0; + GvNAME(sv) = 0; + GvNAMELEN(sv) = 0; + GvSTASH(sv) = 0; + GvFLAGS(sv) = 0; + break; + case SVt_PVBM: + SvANY(sv) = new_XPVBM(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + BmRARE(sv) = 0; + BmUSEFUL(sv) = 0; + BmPREVIOUS(sv) = 0; + break; + case SVt_PVFM: + SvANY(sv) = new_XPVFM(); + Zero(SvANY(sv), 1, XPVFM); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + break; + case SVt_PVIO: + SvANY(sv) = new_XPVIO(); + Zero(SvANY(sv), 1, XPVIO); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + IoPAGE_LEN(sv) = 60; + break; + } + SvFLAGS(sv) &= ~SVTYPEMASK; + SvFLAGS(sv) |= mt; + return TRUE; +} + +char * +sv_peek(SV *sv) +{ +#ifdef DEBUGGING + SV *t = sv_newmortal(); + STRLEN prevlen; + int unref = 0; + + sv_setpvn(t, "", 0); + retry: + if (!sv) { + sv_catpv(t, "VOID"); + goto finish; + } + else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') { + sv_catpv(t, "WILD"); + goto finish; + } + else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) { + if (sv == &PL_sv_undef) { + sv_catpv(t, "SV_UNDEF"); + if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + SvREADONLY(sv)) + goto finish; + } + else if (sv == &PL_sv_no) { + sv_catpv(t, "SV_NO"); + if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| + SVp_POK|SVp_NOK)) && + SvCUR(sv) == 0 && + SvNVX(sv) == 0.0) + goto finish; + } + else { + sv_catpv(t, "SV_YES"); + if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| + SVp_POK|SVp_NOK)) && + SvCUR(sv) == 1 && + SvPVX(sv) && *SvPVX(sv) == '1' && + SvNVX(sv) == 1.0) + goto finish; + } + sv_catpv(t, ":"); + } + else if (SvREFCNT(sv) == 0) { + sv_catpv(t, "("); + unref++; + } + if (SvROK(sv)) { + sv_catpv(t, "\\"); + if (SvCUR(t) + unref > 10) { + SvCUR(t) = unref + 3; + *SvEND(t) = '\0'; + sv_catpv(t, "..."); + goto finish; + } + sv = (SV*)SvRV(sv); + goto retry; + } + switch (SvTYPE(sv)) { + default: + sv_catpv(t, "FREED"); + goto finish; + + case SVt_NULL: + sv_catpv(t, "UNDEF"); + goto finish; + case SVt_IV: + sv_catpv(t, "IV"); + break; + case SVt_NV: + sv_catpv(t, "NV"); + break; + case SVt_RV: + sv_catpv(t, "RV"); + break; + case SVt_PV: + sv_catpv(t, "PV"); + break; + case SVt_PVIV: + sv_catpv(t, "PVIV"); + break; + case SVt_PVNV: + sv_catpv(t, "PVNV"); + break; + case SVt_PVMG: + sv_catpv(t, "PVMG"); + break; + case SVt_PVLV: + sv_catpv(t, "PVLV"); + break; + case SVt_PVAV: + sv_catpv(t, "AV"); + break; + case SVt_PVHV: + sv_catpv(t, "HV"); + break; + case SVt_PVCV: + if (CvGV(sv)) + sv_catpvf(t, "CV(%s)", GvNAME(CvGV(sv))); + else + sv_catpv(t, "CV()"); + goto finish; + case SVt_PVGV: + sv_catpv(t, "GV"); + break; + case SVt_PVBM: + sv_catpv(t, "BM"); + break; + case SVt_PVFM: + sv_catpv(t, "FM"); + break; + case SVt_PVIO: + sv_catpv(t, "IO"); + break; + } + + if (SvPOKp(sv)) { + if (!SvPVX(sv)) + sv_catpv(t, "(null)"); + if (SvOOK(sv)) + sv_catpvf(t, "(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv)); + else + sv_catpvf(t, "(\"%.127s\")",SvPVX(sv)); + } + else if (SvNOKp(sv)) { + SET_NUMERIC_STANDARD(); + sv_catpvf(t, "(%g)",SvNVX(sv)); + } + else if (SvIOKp(sv)) + sv_catpvf(t, "(%ld)",(long)SvIVX(sv)); + else + sv_catpv(t, "()"); + + finish: + if (unref) { + while (unref--) + sv_catpv(t, ")"); + } + return SvPV(t, PL_na); +#else /* DEBUGGING */ + return ""; +#endif /* DEBUGGING */ +} + +int +sv_backoff(register SV *sv) +{ + assert(SvOOK(sv)); + if (SvIVX(sv)) { + char *s = SvPVX(sv); + SvLEN(sv) += SvIVX(sv); + SvPVX(sv) -= SvIVX(sv); + SvIV_set(sv, 0); + Move(s, SvPVX(sv), SvCUR(sv)+1, char); + } + SvFLAGS(sv) &= ~SVf_OOK; + return 0; +} + +char * +#ifndef DOSISH +sv_grow(register SV *sv, register I32 newlen) +#else +sv_grow(SV* sv, unsigned long newlen) +#endif +{ + register char *s; + +#ifdef HAS_64K_LIMIT + if (newlen >= 0x10000) { + PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen); + my_exit(1); + } +#endif /* HAS_64K_LIMIT */ + if (SvROK(sv)) + sv_unref(sv); + if (SvTYPE(sv) < SVt_PV) { + sv_upgrade(sv, SVt_PV); + s = SvPVX(sv); + } + else if (SvOOK(sv)) { /* pv is offset? */ + sv_backoff(sv); + s = SvPVX(sv); + if (newlen > SvLEN(sv)) + newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */ +#ifdef HAS_64K_LIMIT + if (newlen >= 0x10000) + newlen = 0xFFFF; +#endif + } + else + s = SvPVX(sv); + if (newlen > SvLEN(sv)) { /* need more room? */ + if (SvLEN(sv) && s) { +#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) + STRLEN l = malloced_size((void*)SvPVX(sv)); + if (newlen <= l) { + SvLEN_set(sv, l); + return s; + } else +#endif + Renew(s,newlen,char); + } + else + New(703,s,newlen,char); + SvPV_set(sv, s); + SvLEN_set(sv, newlen); + } + return s; +} + +void +sv_setiv(register SV *sv, IV i) +{ + SV_CHECK_THINKFIRST(sv); + switch (SvTYPE(sv)) { + case SVt_NULL: + sv_upgrade(sv, SVt_IV); + break; + case SVt_NV: + sv_upgrade(sv, SVt_PVNV); + break; + case SVt_RV: + case SVt_PV: + sv_upgrade(sv, SVt_PVIV); + break; + + case SVt_PVGV: + if (SvFAKE(sv)) { + sv_unglob(sv); + break; + } + /* FALL THROUGH */ + case SVt_PVAV: + case SVt_PVHV: + case SVt_PVCV: + case SVt_PVFM: + case SVt_PVIO: + { + dTHR; + croak("Can't coerce %s to integer in %s", sv_reftype(sv,0), + op_desc[PL_op->op_type]); + } + } + (void)SvIOK_only(sv); /* validate number */ + SvIVX(sv) = i; + SvTAINT(sv); +} + +void +sv_setiv_mg(register SV *sv, IV i) +{ + sv_setiv(sv,i); + SvSETMAGIC(sv); +} + +void +sv_setuv(register SV *sv, UV u) +{ + if (u <= IV_MAX) + sv_setiv(sv, u); + else + sv_setnv(sv, (double)u); +} + +void +sv_setuv_mg(register SV *sv, UV u) +{ + sv_setuv(sv,u); + SvSETMAGIC(sv); +} + +void +sv_setnv(register SV *sv, double num) +{ + SV_CHECK_THINKFIRST(sv); + switch (SvTYPE(sv)) { + case SVt_NULL: + case SVt_IV: + sv_upgrade(sv, SVt_NV); + break; + case SVt_RV: + case SVt_PV: + case SVt_PVIV: + sv_upgrade(sv, SVt_PVNV); + break; + + case SVt_PVGV: + if (SvFAKE(sv)) { + sv_unglob(sv); + break; + } + /* FALL THROUGH */ + case SVt_PVAV: + case SVt_PVHV: + case SVt_PVCV: + case SVt_PVFM: + case SVt_PVIO: + { + dTHR; + croak("Can't coerce %s to number in %s", sv_reftype(sv,0), + op_name[PL_op->op_type]); + } + } + SvNVX(sv) = num; + (void)SvNOK_only(sv); /* validate number */ + SvTAINT(sv); +} + +void +sv_setnv_mg(register SV *sv, double num) +{ + sv_setnv(sv,num); + SvSETMAGIC(sv); +} + +STATIC void +not_a_number(SV *sv) +{ + dTHR; + char tmpbuf[64]; + char *d = tmpbuf; + char *s; + char *limit = tmpbuf + sizeof(tmpbuf) - 8; + /* each *s can expand to 4 chars + "...\0", + i.e. need room for 8 chars */ + + for (s = SvPVX(sv); *s && d < limit; s++) { + int ch = *s & 0xFF; + if (ch & 128 && !isPRINT_LC(ch)) { + *d++ = 'M'; + *d++ = '-'; + ch &= 127; + } + if (ch == '\n') { + *d++ = '\\'; + *d++ = 'n'; + } + else if (ch == '\r') { + *d++ = '\\'; + *d++ = 'r'; + } + else if (ch == '\f') { + *d++ = '\\'; + *d++ = 'f'; + } + else if (ch == '\\') { + *d++ = '\\'; + *d++ = '\\'; + } + else if (isPRINT_LC(ch)) + *d++ = ch; + else { + *d++ = '^'; + *d++ = toCTRL(ch); + } + } + if (*s) { + *d++ = '.'; + *d++ = '.'; + *d++ = '.'; + } + *d = '\0'; + + if (PL_op) + warn("Argument \"%s\" isn't numeric in %s", tmpbuf, + op_name[PL_op->op_type]); + else + warn("Argument \"%s\" isn't numeric", tmpbuf); +} + +IV +sv_2iv(register SV *sv) +{ + if (!sv) + return 0; + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvIOKp(sv)) + return SvIVX(sv); + if (SvNOKp(sv)) { + if (SvNVX(sv) < 0.0) + return I_V(SvNVX(sv)); + else + return (IV) U_V(SvNVX(sv)); + } + if (SvPOKp(sv) && SvLEN(sv)) + return asIV(sv); + if (!SvROK(sv)) { + if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!PL_localizing) + warn(warn_uninit); + } + return 0; + } + } + if (SvTHINKFIRST(sv)) { + if (SvROK(sv)) { +#ifdef OVERLOAD + SV* tmpstr; + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer))) + return SvIV(tmpstr); +#endif /* OVERLOAD */ + return (IV)SvRV(sv); + } + if (SvREADONLY(sv)) { + if (SvNOKp(sv)) { + if (SvNVX(sv) < 0.0) + return I_V(SvNVX(sv)); + else + return (IV) U_V(SvNVX(sv)); + } + if (SvPOKp(sv) && SvLEN(sv)) + return asIV(sv); + if (PL_dowarn) + warn(warn_uninit); + return 0; + } + } + switch (SvTYPE(sv)) { + case SVt_NULL: + sv_upgrade(sv, SVt_IV); + break; + case SVt_PV: + sv_upgrade(sv, SVt_PVIV); + break; + case SVt_NV: + sv_upgrade(sv, SVt_PVNV); + break; + } + if (SvNOKp(sv)) { + (void)SvIOK_on(sv); + if (SvNVX(sv) < 0.0) + SvIVX(sv) = I_V(SvNVX(sv)); + else + SvUVX(sv) = U_V(SvNVX(sv)); + } + else if (SvPOKp(sv) && SvLEN(sv)) { + (void)SvIOK_on(sv); + SvIVX(sv) = asIV(sv); + } + else { + dTHR; + if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); + return 0; + } + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n", + (unsigned long)sv,(long)SvIVX(sv))); + return SvIVX(sv); +} + +UV +sv_2uv(register SV *sv) +{ + if (!sv) + return 0; + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvIOKp(sv)) + return SvUVX(sv); + if (SvNOKp(sv)) + return U_V(SvNVX(sv)); + if (SvPOKp(sv) && SvLEN(sv)) + return asUV(sv); + if (!SvROK(sv)) { + if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!PL_localizing) + warn(warn_uninit); + } + return 0; + } + } + if (SvTHINKFIRST(sv)) { + if (SvROK(sv)) { +#ifdef OVERLOAD + SV* tmpstr; + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer))) + return SvUV(tmpstr); +#endif /* OVERLOAD */ + return (UV)SvRV(sv); + } + if (SvREADONLY(sv)) { + if (SvNOKp(sv)) { + return U_V(SvNVX(sv)); + } + if (SvPOKp(sv) && SvLEN(sv)) + return asUV(sv); + if (PL_dowarn) + warn(warn_uninit); + return 0; + } + } + switch (SvTYPE(sv)) { + case SVt_NULL: + sv_upgrade(sv, SVt_IV); + break; + case SVt_PV: + sv_upgrade(sv, SVt_PVIV); + break; + case SVt_NV: + sv_upgrade(sv, SVt_PVNV); + break; + } + if (SvNOKp(sv)) { + (void)SvIOK_on(sv); + SvUVX(sv) = U_V(SvNVX(sv)); + } + else if (SvPOKp(sv) && SvLEN(sv)) { + (void)SvIOK_on(sv); + SvUVX(sv) = asUV(sv); + } + else { + if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!PL_localizing) + warn(warn_uninit); + } + return 0; + } + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n", + (unsigned long)sv,SvUVX(sv))); + return SvUVX(sv); +} + +double +sv_2nv(register SV *sv) +{ + if (!sv) + return 0.0; + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvNOKp(sv)) + return SvNVX(sv); + if (SvPOKp(sv) && SvLEN(sv)) { + if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv)) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + return atof(SvPVX(sv)); + } + if (SvIOKp(sv)) + return (double)SvIVX(sv); + if (!SvROK(sv)) { + if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!PL_localizing) + warn(warn_uninit); + } + return 0; + } + } + if (SvTHINKFIRST(sv)) { + if (SvROK(sv)) { +#ifdef OVERLOAD + SV* tmpstr; + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer))) + return SvNV(tmpstr); +#endif /* OVERLOAD */ + return (double)(unsigned long)SvRV(sv); + } + if (SvREADONLY(sv)) { + if (SvPOKp(sv) && SvLEN(sv)) { + if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv)) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + return atof(SvPVX(sv)); + } + if (SvIOKp(sv)) + return (double)SvIVX(sv); + if (PL_dowarn) + warn(warn_uninit); + return 0.0; + } + } + if (SvTYPE(sv) < SVt_NV) { + if (SvTYPE(sv) == SVt_IV) + sv_upgrade(sv, SVt_PVNV); + else + sv_upgrade(sv, SVt_NV); + DEBUG_c(SET_NUMERIC_STANDARD()); + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv))); + } + else if (SvTYPE(sv) < SVt_PVNV) + sv_upgrade(sv, SVt_PVNV); + if (SvIOKp(sv) && + (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv))) + { + SvNVX(sv) = (double)SvIVX(sv); + } + else if (SvPOKp(sv) && SvLEN(sv)) { + if (PL_dowarn && !SvIOKp(sv) && !looks_like_number(sv)) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + SvNVX(sv) = atof(SvPVX(sv)); + } + else { + dTHR; + if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); + return 0.0; + } + SvNOK_on(sv); + DEBUG_c(SET_NUMERIC_STANDARD()); + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv))); + return SvNVX(sv); +} + +STATIC IV +asIV(SV *sv) +{ + I32 numtype = looks_like_number(sv); + double d; + + if (numtype == 1) + return atol(SvPVX(sv)); + if (!numtype && PL_dowarn) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + d = atof(SvPVX(sv)); + if (d < 0.0) + return I_V(d); + else + return (IV) U_V(d); +} + +STATIC UV +asUV(SV *sv) +{ + I32 numtype = looks_like_number(sv); + +#ifdef HAS_STRTOUL + if (numtype == 1) + return strtoul(SvPVX(sv), Null(char**), 10); +#endif + if (!numtype && PL_dowarn) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + return U_V(atof(SvPVX(sv))); +} + +I32 +looks_like_number(SV *sv) +{ + register char *s; + register char *send; + register char *sbegin; + I32 numtype; + STRLEN len; + + if (SvPOK(sv)) { + sbegin = SvPVX(sv); + len = SvCUR(sv); + } + else if (SvPOKp(sv)) + sbegin = SvPV(sv, len); + else + return 1; + send = sbegin + len; + + s = sbegin; + while (isSPACE(*s)) + s++; + if (*s == '+' || *s == '-') + s++; + + /* next must be digit or '.' */ + if (isDIGIT(*s)) { + do { + s++; + } while (isDIGIT(*s)); + if (*s == '.') { + s++; + while (isDIGIT(*s)) /* optional digits after "." */ + s++; + } + } + else if (*s == '.') { + s++; + /* no digits before '.' means we need digits after it */ + if (isDIGIT(*s)) { + do { + s++; + } while (isDIGIT(*s)); + } + else + return 0; + } + else + return 0; + + /* + * we return 1 if the number can be converted to _integer_ with atol() + * and 2 if you need (int)atof(). + */ + numtype = 1; + + /* we can have an optional exponent part */ + if (*s == 'e' || *s == 'E') { + numtype = 2; + s++; + if (*s == '+' || *s == '-') + s++; + if (isDIGIT(*s)) { + do { + s++; + } while (isDIGIT(*s)); + } + else + return 0; + } + while (isSPACE(*s)) + s++; + if (s >= send) + return numtype; + if (len == 10 && memEQ(sbegin, "0 but true", 10)) + return 1; + return 0; +} + +char * +sv_2pv(register SV *sv, STRLEN *lp) +{ + register char *s; + int olderrno; + SV *tsv; + char tmpbuf[64]; /* Must fit sprintf/Gconvert of longest IV/NV */ + + if (!sv) { + *lp = 0; + return ""; + } + if (SvGMAGICAL(sv)) { + mg_get(sv); + if (SvPOKp(sv)) { + *lp = SvCUR(sv); + return SvPVX(sv); + } + if (SvIOKp(sv)) { + (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); + tsv = Nullsv; + goto tokensave; + } + if (SvNOKp(sv)) { + SET_NUMERIC_STANDARD(); + Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf); + tsv = Nullsv; + goto tokensave; + } + if (!SvROK(sv)) { + if (PL_dowarn && !(SvFLAGS(sv) & SVs_PADTMP)) { + dTHR; + if (!PL_localizing) + warn(warn_uninit); + } + *lp = 0; + return ""; + } + } + if (SvTHINKFIRST(sv)) { + if (SvROK(sv)) { +#ifdef OVERLOAD + SV* tmpstr; + if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string))) + return SvPV(tmpstr,*lp); +#endif /* OVERLOAD */ + sv = (SV*)SvRV(sv); + if (!sv) + s = "NULLREF"; + else { + MAGIC *mg; + + switch (SvTYPE(sv)) { + case SVt_PVMG: + if ( ((SvFLAGS(sv) & + (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG)) + == (SVs_OBJECT|SVs_RMG)) + && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp") + && (mg = mg_find(sv, 'r'))) { + dTHR; + regexp *re = (regexp *)mg->mg_obj; + + if (!mg->mg_ptr) { + char *fptr = "msix"; + char reflags[6]; + char ch; + int left = 0; + int right = 4; + U16 reganch = (re->reganch & PMf_COMPILETIME) >> 12; + + while(ch = *fptr++) { + if(reganch & 1) { + reflags[left++] = ch; + } + else { + reflags[right--] = ch; + } + reganch >>= 1; + } + if(left != 4) { + reflags[left] = '-'; + left = 5; + } + + mg->mg_len = re->prelen + 4 + left; + New(616, mg->mg_ptr, mg->mg_len + 1 + left, char); + Copy("(?", mg->mg_ptr, 2, char); + Copy(reflags, mg->mg_ptr+2, left, char); + Copy(":", mg->mg_ptr+left+2, 1, char); + Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char); + mg->mg_ptr[mg->mg_len - 1] = ')'; + mg->mg_ptr[mg->mg_len] = 0; + } + PL_reginterp_cnt += re->program[0].next_off; + *lp = mg->mg_len; + return mg->mg_ptr; + } + /* Fall through */ + case SVt_NULL: + case SVt_IV: + case SVt_NV: + case SVt_RV: + case SVt_PV: + case SVt_PVIV: + case SVt_PVNV: + case SVt_PVBM: s = "SCALAR"; break; + case SVt_PVLV: s = "LVALUE"; break; + case SVt_PVAV: s = "ARRAY"; break; + case SVt_PVHV: s = "HASH"; break; + case SVt_PVCV: s = "CODE"; break; + case SVt_PVGV: s = "GLOB"; break; + case SVt_PVFM: s = "FORMAT"; break; + case SVt_PVIO: s = "IO"; break; + default: s = "UNKNOWN"; break; + } + tsv = NEWSV(0,0); + if (SvOBJECT(sv)) + sv_setpvf(tsv, "%s=%s", HvNAME(SvSTASH(sv)), s); + else + sv_setpv(tsv, s); + sv_catpvf(tsv, "(0x%lx)", (unsigned long)sv); + goto tokensaveref; + } + *lp = strlen(s); + return s; + } + if (SvREADONLY(sv)) { + if (SvNOKp(sv)) { + SET_NUMERIC_STANDARD(); + Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf); + tsv = Nullsv; + goto tokensave; + } + if (SvIOKp(sv)) { + (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); + tsv = Nullsv; + goto tokensave; + } + if (PL_dowarn) + warn(warn_uninit); + *lp = 0; + return ""; + } + } + (void)SvUPGRADE(sv, SVt_PV); + if (SvNOKp(sv)) { + if (SvTYPE(sv) < SVt_PVNV) + sv_upgrade(sv, SVt_PVNV); + SvGROW(sv, 28); + s = SvPVX(sv); + olderrno = errno; /* some Xenix systems wipe out errno here */ +#ifdef apollo + if (SvNVX(sv) == 0.0) + (void)strcpy(s,"0"); + else +#endif /*apollo*/ + { + SET_NUMERIC_STANDARD(); + Gconvert(SvNVX(sv), DBL_DIG, 0, s); + } + errno = olderrno; +#ifdef FIXNEGATIVEZERO + if (*s == '-' && s[1] == '0' && !s[2]) + strcpy(s,"0"); +#endif + while (*s) s++; +#ifdef hcx + if (s[-1] == '.') + *--s = '\0'; +#endif + } + else if (SvIOKp(sv)) { + U32 oldIOK = SvIOK(sv); + if (SvTYPE(sv) < SVt_PVIV) + sv_upgrade(sv, SVt_PVIV); + olderrno = errno; /* some Xenix systems wipe out errno here */ + sv_setpviv(sv, SvIVX(sv)); + errno = olderrno; + s = SvEND(sv); + if (oldIOK) + SvIOK_on(sv); + else + SvIOKp_on(sv); + } + else { + dTHR; + if (PL_dowarn && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) + warn(warn_uninit); + *lp = 0; + return ""; + } + *lp = s - SvPVX(sv); + SvCUR_set(sv, *lp); + SvPOK_on(sv); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv))); + return SvPVX(sv); + + tokensave: + if (SvROK(sv)) { /* XXX Skip this when sv_pvn_force calls */ + /* Sneaky stuff here */ + + tokensaveref: + if (!tsv) + tsv = newSVpv(tmpbuf, 0); + sv_2mortal(tsv); + *lp = SvCUR(tsv); + return SvPVX(tsv); + } + else { + STRLEN len; + char *t; + + if (tsv) { + sv_2mortal(tsv); + t = SvPVX(tsv); + len = SvCUR(tsv); + } + else { + t = tmpbuf; + len = strlen(tmpbuf); + } +#ifdef FIXNEGATIVEZERO + if (len == 2 && t[0] == '-' && t[1] == '0') { + t = "0"; + len = 1; + } +#endif + (void)SvUPGRADE(sv, SVt_PV); + *lp = len; + s = SvGROW(sv, len + 1); + SvCUR_set(sv, len); + (void)strcpy(s, t); + SvPOKp_on(sv); + return s; + } +} + +/* This function is only called on magical items */ +bool +sv_2bool(register SV *sv) +{ + if (SvGMAGICAL(sv)) + mg_get(sv); + + if (!SvOK(sv)) + return 0; + if (SvROK(sv)) { +#ifdef OVERLOAD + { + dTHR; + SV* tmpsv; + if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_))) + return SvTRUE(tmpsv); + } +#endif /* OVERLOAD */ + return SvRV(sv) != 0; + } + if (SvPOKp(sv)) { + register XPV* Xpvtmp; + if ((Xpvtmp = (XPV*)SvANY(sv)) && + (*Xpvtmp->xpv_pv > '0' || + Xpvtmp->xpv_cur > 1 || + (Xpvtmp->xpv_cur && *Xpvtmp->xpv_pv != '0'))) + return 1; + else + return 0; + } + else { + if (SvIOKp(sv)) + return SvIVX(sv) != 0; + else { + if (SvNOKp(sv)) + return SvNVX(sv) != 0.0; + else + return FALSE; + } + } +} + +/* Note: sv_setsv() should not be called with a source string that needs + * to be reused, since it may destroy the source string if it is marked + * as temporary. + */ + +void +sv_setsv(SV *dstr, register SV *sstr) +{ + dTHR; + register U32 sflags; + register int dtype; + register int stype; + + if (sstr == dstr) + return; + SV_CHECK_THINKFIRST(dstr); + if (!sstr) + sstr = &PL_sv_undef; + stype = SvTYPE(sstr); + dtype = SvTYPE(dstr); + + if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) { + sv_unglob(dstr); /* so fake GLOB won't perpetuate */ + sv_setpvn(dstr, "", 0); + (void)SvPOK_only(dstr); + dtype = SvTYPE(dstr); + } + +#ifdef OVERLOAD + SvAMAGIC_off(dstr); +#endif /* OVERLOAD */ + /* There's a lot of redundancy below but we're going for speed here */ + + switch (stype) { + case SVt_NULL: + undef_sstr: + if (dtype != SVt_PVGV) { + (void)SvOK_off(dstr); + return; + } + break; + case SVt_IV: + if (SvIOK(sstr)) { + switch (dtype) { + case SVt_NULL: + sv_upgrade(dstr, SVt_IV); + break; + case SVt_NV: + sv_upgrade(dstr, SVt_PVNV); + break; + case SVt_RV: + case SVt_PV: + sv_upgrade(dstr, SVt_PVIV); + break; + } + (void)SvIOK_only(dstr); + SvIVX(dstr) = SvIVX(sstr); + SvTAINT(dstr); + return; + } + goto undef_sstr; + + case SVt_NV: + if (SvNOK(sstr)) { + switch (dtype) { + case SVt_NULL: + case SVt_IV: + sv_upgrade(dstr, SVt_NV); + break; + case SVt_RV: + case SVt_PV: + case SVt_PVIV: + sv_upgrade(dstr, SVt_PVNV); + break; + } + SvNVX(dstr) = SvNVX(sstr); + (void)SvNOK_only(dstr); + SvTAINT(dstr); + return; + } + goto undef_sstr; + + case SVt_RV: + if (dtype < SVt_RV) + sv_upgrade(dstr, SVt_RV); + else if (dtype == SVt_PVGV && + SvTYPE(SvRV(sstr)) == SVt_PVGV) { + sstr = SvRV(sstr); + if (sstr == dstr) { + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_on(dstr); + GvMULTI_on(dstr); + return; + } + goto glob_assign; + } + break; + case SVt_PV: + case SVt_PVFM: + if (dtype < SVt_PV) + sv_upgrade(dstr, SVt_PV); + break; + case SVt_PVIV: + if (dtype < SVt_PVIV) + sv_upgrade(dstr, SVt_PVIV); + break; + case SVt_PVNV: + if (dtype < SVt_PVNV) + sv_upgrade(dstr, SVt_PVNV); + break; + case SVt_PVAV: + case SVt_PVHV: + case SVt_PVCV: + case SVt_PVIO: + if (PL_op) + croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0), + op_name[PL_op->op_type]); + else + croak("Bizarre copy of %s", sv_reftype(sstr, 0)); + break; + + case SVt_PVGV: + if (dtype <= SVt_PVGV) { + glob_assign: + if (dtype != SVt_PVGV) { + char *name = GvNAME(sstr); + STRLEN len = GvNAMELEN(sstr); + sv_upgrade(dstr, SVt_PVGV); + sv_magic(dstr, dstr, '*', name, len); + GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); + GvNAME(dstr) = savepvn(name, len); + GvNAMELEN(dstr) = len; + SvFAKE_on(dstr); /* can coerce to non-glob */ + } + /* ahem, death to those who redefine active sort subs */ + else if (PL_curstackinfo->si_type == PERLSI_SORT + && GvCV(dstr) && PL_sortcop == CvSTART(GvCV(dstr))) + croak("Can't redefine active sort subroutine %s", + GvNAME(dstr)); + (void)SvOK_off(dstr); + GvINTRO_off(dstr); /* one-shot flag */ + gp_free((GV*)dstr); + GvGP(dstr) = gp_ref(GvGP(sstr)); + SvTAINT(dstr); + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_on(dstr); + GvMULTI_on(dstr); + return; + } + /* FALL THROUGH */ + + default: + if (SvGMAGICAL(sstr)) { + mg_get(sstr); + if (SvTYPE(sstr) != stype) { + stype = SvTYPE(sstr); + if (stype == SVt_PVGV && dtype <= SVt_PVGV) + goto glob_assign; + } + } + if (stype == SVt_PVLV) + SvUPGRADE(dstr, SVt_PVNV); + else + SvUPGRADE(dstr, stype); + } + + sflags = SvFLAGS(sstr); + + if (sflags & SVf_ROK) { + if (dtype >= SVt_PV) { + if (dtype == SVt_PVGV) { + SV *sref = SvREFCNT_inc(SvRV(sstr)); + SV *dref = 0; + int intro = GvINTRO(dstr); + + if (intro) { + GP *gp; + GvGP(dstr)->gp_refcnt--; + GvINTRO_off(dstr); /* one-shot flag */ + Newz(602,gp, 1, GP); + GvGP(dstr) = gp_ref(gp); + GvSV(dstr) = NEWSV(72,0); + GvLINE(dstr) = PL_curcop->cop_line; + GvEGV(dstr) = (GV*)dstr; + } + GvMULTI_on(dstr); + switch (SvTYPE(sref)) { + case SVt_PVAV: + if (intro) + SAVESPTR(GvAV(dstr)); + else + dref = (SV*)GvAV(dstr); + GvAV(dstr) = (AV*)sref; + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_AV_on(dstr); + break; + case SVt_PVHV: + if (intro) + SAVESPTR(GvHV(dstr)); + else + dref = (SV*)GvHV(dstr); + GvHV(dstr) = (HV*)sref; + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_HV_on(dstr); + break; + case SVt_PVCV: + if (intro) { + if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) { + SvREFCNT_dec(GvCV(dstr)); + GvCV(dstr) = Nullcv; + GvCVGEN(dstr) = 0; /* Switch off cacheness. */ + PL_sub_generation++; + } + SAVESPTR(GvCV(dstr)); + } + else + dref = (SV*)GvCV(dstr); + if (GvCV(dstr) != (CV*)sref) { + CV* cv = GvCV(dstr); + if (cv) { + if (!GvCVGEN((GV*)dstr) && + (CvROOT(cv) || CvXSUB(cv))) + { + SV *const_sv = cv_const_sv(cv); + bool const_changed = TRUE; + if(const_sv) + const_changed = sv_cmp(const_sv, + op_const_sv(CvSTART((CV*)sref), + Nullcv)); + /* ahem, death to those who redefine + * active sort subs */ + if (PL_curstackinfo->si_type == PERLSI_SORT && + PL_sortcop == CvSTART(cv)) + croak( + "Can't redefine active sort subroutine %s", + GvENAME((GV*)dstr)); + if (PL_dowarn || (const_changed && const_sv)) { + if (!(CvGV(cv) && GvSTASH(CvGV(cv)) + && HvNAME(GvSTASH(CvGV(cv))) + && strEQ(HvNAME(GvSTASH(CvGV(cv))), + "autouse"))) + warn(const_sv ? + "Constant subroutine %s redefined" + : "Subroutine %s redefined", + GvENAME((GV*)dstr)); + } + } + cv_ckproto(cv, (GV*)dstr, + SvPOK(sref) ? SvPVX(sref) : Nullch); + } + GvCV(dstr) = (CV*)sref; + GvCVGEN(dstr) = 0; /* Switch off cacheness. */ + GvASSUMECV_on(dstr); + PL_sub_generation++; + } + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_CV_on(dstr); + break; + case SVt_PVIO: + if (intro) + SAVESPTR(GvIOp(dstr)); + else + dref = (SV*)GvIOp(dstr); + GvIOp(dstr) = (IO*)sref; + break; + default: + if (intro) + SAVESPTR(GvSV(dstr)); + else + dref = (SV*)GvSV(dstr); + GvSV(dstr) = sref; + if (PL_curcop->cop_stash != GvSTASH(dstr)) + GvIMPORTED_SV_on(dstr); + break; + } + if (dref) + SvREFCNT_dec(dref); + if (intro) + SAVEFREESV(sref); + SvTAINT(dstr); + return; + } + if (SvPVX(dstr)) { + (void)SvOOK_off(dstr); /* backoff */ + Safefree(SvPVX(dstr)); + SvLEN(dstr)=SvCUR(dstr)=0; + } + } + (void)SvOK_off(dstr); + SvRV(dstr) = SvREFCNT_inc(SvRV(sstr)); + SvROK_on(dstr); + if (sflags & SVp_NOK) { + SvNOK_on(dstr); + SvNVX(dstr) = SvNVX(sstr); + } + if (sflags & SVp_IOK) { + (void)SvIOK_on(dstr); + SvIVX(dstr) = SvIVX(sstr); + } +#ifdef OVERLOAD + if (SvAMAGIC(sstr)) { + SvAMAGIC_on(dstr); + } +#endif /* OVERLOAD */ + } + else if (sflags & SVp_POK) { + + /* + * Check to see if we can just swipe the string. If so, it's a + * possible small lose on short strings, but a big win on long ones. + * It might even be a win on short strings if SvPVX(dstr) + * has to be allocated and SvPVX(sstr) has to be freed. + */ + + if (SvTEMP(sstr) && /* slated for free anyway? */ + SvREFCNT(sstr) == 1 && /* and no other references to it? */ + !(sflags & SVf_OOK)) /* and not involved in OOK hack? */ + { + if (SvPVX(dstr)) { /* we know that dtype >= SVt_PV */ + if (SvOOK(dstr)) { + SvFLAGS(dstr) &= ~SVf_OOK; + Safefree(SvPVX(dstr) - SvIVX(dstr)); + } + else + Safefree(SvPVX(dstr)); + } + (void)SvPOK_only(dstr); + SvPV_set(dstr, SvPVX(sstr)); + SvLEN_set(dstr, SvLEN(sstr)); + SvCUR_set(dstr, SvCUR(sstr)); + SvTEMP_off(dstr); + (void)SvOK_off(sstr); + SvPV_set(sstr, Nullch); + SvLEN_set(sstr, 0); + SvCUR_set(sstr, 0); + SvTEMP_off(sstr); + } + else { /* have to copy actual string */ + STRLEN len = SvCUR(sstr); + + SvGROW(dstr, len + 1); /* inlined from sv_setpvn */ + Move(SvPVX(sstr),SvPVX(dstr),len,char); + SvCUR_set(dstr, len); + *SvEND(dstr) = '\0'; + (void)SvPOK_only(dstr); + } + /*SUPPRESS 560*/ + if (sflags & SVp_NOK) { + SvNOK_on(dstr); + SvNVX(dstr) = SvNVX(sstr); + } + if (sflags & SVp_IOK) { + (void)SvIOK_on(dstr); + SvIVX(dstr) = SvIVX(sstr); + } + } + else if (sflags & SVp_NOK) { + SvNVX(dstr) = SvNVX(sstr); + (void)SvNOK_only(dstr); + if (SvIOK(sstr)) { + (void)SvIOK_on(dstr); + SvIVX(dstr) = SvIVX(sstr); + } + } + else if (sflags & SVp_IOK) { + (void)SvIOK_only(dstr); + SvIVX(dstr) = SvIVX(sstr); + } + else { + if (dtype == SVt_PVGV) { + if (PL_dowarn) + warn("Undefined value assigned to typeglob"); + } + else + (void)SvOK_off(dstr); + } + SvTAINT(dstr); +} + +void +sv_setsv_mg(SV *dstr, register SV *sstr) +{ + sv_setsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +void +sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len) +{ + register char *dptr; + assert(len >= 0); /* STRLEN is probably unsigned, so this may + elicit a warning, but it won't hurt. */ + SV_CHECK_THINKFIRST(sv); + if (!ptr) { + (void)SvOK_off(sv); + return; + } + if (SvTYPE(sv) >= SVt_PV) { + if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) + sv_unglob(sv); + } + else + sv_upgrade(sv, SVt_PV); + + SvGROW(sv, len + 1); + dptr = SvPVX(sv); + Move(ptr,dptr,len,char); + dptr[len] = '\0'; + SvCUR_set(sv, len); + (void)SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); +} + +void +sv_setpvn_mg(register SV *sv, register const char *ptr, register STRLEN len) +{ + sv_setpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void +sv_setpv(register SV *sv, register const char *ptr) +{ + register STRLEN len; + + SV_CHECK_THINKFIRST(sv); + if (!ptr) { + (void)SvOK_off(sv); + return; + } + len = strlen(ptr); + if (SvTYPE(sv) >= SVt_PV) { + if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) + sv_unglob(sv); + } + else + sv_upgrade(sv, SVt_PV); + + SvGROW(sv, len + 1); + Move(ptr,SvPVX(sv),len+1,char); + SvCUR_set(sv, len); + (void)SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); +} + +void +sv_setpv_mg(register SV *sv, register const char *ptr) +{ + sv_setpv(sv,ptr); + SvSETMAGIC(sv); +} + +void +sv_usepvn(register SV *sv, register char *ptr, register STRLEN len) +{ + SV_CHECK_THINKFIRST(sv); + (void)SvUPGRADE(sv, SVt_PV); + if (!ptr) { + (void)SvOK_off(sv); + return; + } + if (SvPVX(sv)) + Safefree(SvPVX(sv)); + Renew(ptr, len+1, char); + SvPVX(sv) = ptr; + SvCUR_set(sv, len); + SvLEN_set(sv, len+1); + *SvEND(sv) = '\0'; + (void)SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); +} + +void +sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len) +{ + sv_usepvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +STATIC void +sv_check_thinkfirst(register SV *sv) +{ + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling) + croak(no_modify); + } + if (SvROK(sv)) + sv_unref(sv); +} + +void +sv_chop(register SV *sv, register char *ptr) /* like set but assuming ptr is in sv */ + + +{ + register STRLEN delta; + + if (!ptr || !SvPOKp(sv)) + return; + SV_CHECK_THINKFIRST(sv); + if (SvTYPE(sv) < SVt_PVIV) + sv_upgrade(sv,SVt_PVIV); + + if (!SvOOK(sv)) { + SvIVX(sv) = 0; + SvFLAGS(sv) |= SVf_OOK; + } + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK); + delta = ptr - SvPVX(sv); + SvLEN(sv) -= delta; + SvCUR(sv) -= delta; + SvPVX(sv) += delta; + SvIVX(sv) += delta; +} + +void +sv_catpvn(register SV *sv, register char *ptr, register STRLEN len) +{ + STRLEN tlen; + char *junk; + + junk = SvPV_force(sv, tlen); + SvGROW(sv, tlen + len + 1); + if (ptr == junk) + ptr = SvPVX(sv); + Move(ptr,SvPVX(sv)+tlen,len,char); + SvCUR(sv) += len; + *SvEND(sv) = '\0'; + (void)SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); +} + +void +sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len) +{ + sv_catpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void +sv_catsv(SV *dstr, register SV *sstr) +{ + char *s; + STRLEN len; + if (!sstr) + return; + if (s = SvPV(sstr, len)) + sv_catpvn(dstr,s,len); +} + +void +sv_catsv_mg(SV *dstr, register SV *sstr) +{ + sv_catsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +void +sv_catpv(register SV *sv, register char *ptr) +{ + register STRLEN len; + STRLEN tlen; + char *junk; + + if (!ptr) + return; + junk = SvPV_force(sv, tlen); + len = strlen(ptr); + SvGROW(sv, tlen + len + 1); + if (ptr == junk) + ptr = SvPVX(sv); + Move(ptr,SvPVX(sv)+tlen,len+1,char); + SvCUR(sv) += len; + (void)SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); +} + +void +sv_catpv_mg(register SV *sv, register char *ptr) +{ + sv_catpv(sv,ptr); + SvSETMAGIC(sv); +} + +SV * +newSV(STRLEN len) +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + if (len) { + sv_upgrade(sv, SVt_PV); + SvGROW(sv, len + 1); + } + return sv; +} + +/* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */ + +void +sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen) +{ + MAGIC* mg; + + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling && !strchr("gBf", how)) + croak(no_modify); + } + if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) { + if (SvMAGIC(sv) && (mg = mg_find(sv, how))) { + if (how == 't') + mg->mg_len |= 1; + return; + } + } + else { + (void)SvUPGRADE(sv, SVt_PVMG); + } + Newz(702,mg, 1, MAGIC); + mg->mg_moremagic = SvMAGIC(sv); + + SvMAGIC(sv) = mg; + if (!obj || obj == sv || how == '#' || how == 'r') + mg->mg_obj = obj; + else { + dTHR; + mg->mg_obj = SvREFCNT_inc(obj); + mg->mg_flags |= MGf_REFCOUNTED; + } + mg->mg_type = how; + mg->mg_len = namlen; + if (name) + if (namlen >= 0) + mg->mg_ptr = savepvn(name, namlen); + else if (namlen == HEf_SVKEY) + mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name); + + switch (how) { + case 0: + mg->mg_virtual = &vtbl_sv; + break; +#ifdef OVERLOAD + case 'A': + mg->mg_virtual = &vtbl_amagic; + break; + case 'a': + mg->mg_virtual = &vtbl_amagicelem; + break; + case 'c': + mg->mg_virtual = 0; + break; +#endif /* OVERLOAD */ + case 'B': + mg->mg_virtual = &vtbl_bm; + break; + case 'E': + mg->mg_virtual = &vtbl_env; + break; + case 'f': + mg->mg_virtual = &vtbl_fm; + break; + case 'e': + mg->mg_virtual = &vtbl_envelem; + break; + case 'g': + mg->mg_virtual = &vtbl_mglob; + break; + case 'I': + mg->mg_virtual = &vtbl_isa; + break; + case 'i': + mg->mg_virtual = &vtbl_isaelem; + break; + case 'k': + mg->mg_virtual = &vtbl_nkeys; + break; + case 'L': + SvRMAGICAL_on(sv); + mg->mg_virtual = 0; + break; + case 'l': + mg->mg_virtual = &vtbl_dbline; + break; +#ifdef USE_THREADS + case 'm': + mg->mg_virtual = &vtbl_mutex; + break; +#endif /* USE_THREADS */ +#ifdef USE_LOCALE_COLLATE + case 'o': + mg->mg_virtual = &vtbl_collxfrm; + break; +#endif /* USE_LOCALE_COLLATE */ + case 'P': + mg->mg_virtual = &vtbl_pack; + break; + case 'p': + case 'q': + mg->mg_virtual = &vtbl_packelem; + break; + case 'r': + mg->mg_virtual = &vtbl_regexp; + break; + case 'S': + mg->mg_virtual = &vtbl_sig; + break; + case 's': + mg->mg_virtual = &vtbl_sigelem; + break; + case 't': + mg->mg_virtual = &vtbl_taint; + mg->mg_len = 1; + break; + case 'U': + mg->mg_virtual = &vtbl_uvar; + break; + case 'v': + mg->mg_virtual = &vtbl_vec; + break; + case 'x': + mg->mg_virtual = &vtbl_substr; + break; + case 'y': + mg->mg_virtual = &vtbl_defelem; + break; + case '*': + mg->mg_virtual = &vtbl_glob; + break; + case '#': + mg->mg_virtual = &vtbl_arylen; + break; + case '.': + mg->mg_virtual = &vtbl_pos; + break; + case '~': /* Reserved for use by extensions not perl internals. */ + /* Useful for attaching extension internal data to perl vars. */ + /* Note that multiple extensions may clash if magical scalars */ + /* etc holding private data from one are passed to another. */ + SvRMAGICAL_on(sv); + break; + default: + croak("Don't know how to handle magic of type '%c'", how); + } + mg_magical(sv); + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); +} + +int +sv_unmagic(SV *sv, int type) +{ + MAGIC* mg; + MAGIC** mgp; + if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv)) + return 0; + mgp = &SvMAGIC(sv); + for (mg = *mgp; mg; mg = *mgp) { + if (mg->mg_type == type) { + MGVTBL* vtbl = mg->mg_virtual; + *mgp = mg->mg_moremagic; + if (vtbl && (vtbl->svt_free != NULL)) + (VTBL->svt_free)(sv, mg); + if (mg->mg_ptr && mg->mg_type != 'g') + if (mg->mg_len >= 0) + Safefree(mg->mg_ptr); + else if (mg->mg_len == HEf_SVKEY) + SvREFCNT_dec((SV*)mg->mg_ptr); + if (mg->mg_flags & MGf_REFCOUNTED) + SvREFCNT_dec(mg->mg_obj); + Safefree(mg); + } + else + mgp = &mg->mg_moremagic; + } + if (!SvMAGIC(sv)) { + SvMAGICAL_off(sv); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + } + + return 0; +} + +void +sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen) +{ + register char *big; + register char *mid; + register char *midend; + register char *bigend; + register I32 i; + STRLEN curlen; + + + if (!bigstr) + croak("Can't modify non-existent substring"); + SvPV_force(bigstr, curlen); + if (offset + len > curlen) { + SvGROW(bigstr, offset+len+1); + Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char); + SvCUR_set(bigstr, offset+len); + } + + i = littlelen - len; + if (i > 0) { /* string might grow */ + big = SvGROW(bigstr, SvCUR(bigstr) + i + 1); + mid = big + offset + len; + midend = bigend = big + SvCUR(bigstr); + bigend += i; + *bigend = '\0'; + while (midend > mid) /* shove everything down */ + *--bigend = *--midend; + Move(little,big+offset,littlelen,char); + SvCUR(bigstr) += i; + SvSETMAGIC(bigstr); + return; + } + else if (i == 0) { + Move(little,SvPVX(bigstr)+offset,len,char); + SvSETMAGIC(bigstr); + return; + } + + big = SvPVX(bigstr); + mid = big + offset; + midend = mid + len; + bigend = big + SvCUR(bigstr); + + if (midend > bigend) + croak("panic: sv_insert"); + + if (mid - big > bigend - midend) { /* faster to shorten from end */ + if (littlelen) { + Move(little, mid, littlelen,char); + mid += littlelen; + } + i = bigend - midend; + if (i > 0) { + Move(midend, mid, i,char); + mid += i; + } + *mid = '\0'; + SvCUR_set(bigstr, mid - big); + } + /*SUPPRESS 560*/ + else if (i = mid - big) { /* faster from front */ + midend -= littlelen; + mid = midend; + sv_chop(bigstr,midend-i); + big += i; + while (i--) + *--midend = *--big; + if (littlelen) + Move(little, mid, littlelen,char); + } + else if (littlelen) { + midend -= littlelen; + sv_chop(bigstr,midend); + Move(little,midend,littlelen,char); + } + else { + sv_chop(bigstr,midend); + } + SvSETMAGIC(bigstr); +} + +/* make sv point to what nstr did */ + +void +sv_replace(register SV *sv, register SV *nsv) +{ + U32 refcnt = SvREFCNT(sv); + SV_CHECK_THINKFIRST(sv); + if (SvREFCNT(nsv) != 1) + warn("Reference miscount in sv_replace()"); + if (SvMAGICAL(sv)) { + if (SvMAGICAL(nsv)) + mg_free(nsv); + else + sv_upgrade(nsv, SVt_PVMG); + SvMAGIC(nsv) = SvMAGIC(sv); + SvFLAGS(nsv) |= SvMAGICAL(sv); + SvMAGICAL_off(sv); + SvMAGIC(sv) = 0; + } + SvREFCNT(sv) = 0; + sv_clear(sv); + assert(!SvREFCNT(sv)); + StructCopy(nsv,sv,SV); + SvREFCNT(sv) = refcnt; + SvFLAGS(nsv) |= SVTYPEMASK; /* Mark as freed */ + del_SV(nsv); +} + +void +sv_clear(register SV *sv) +{ + HV* stash; + assert(sv); + assert(SvREFCNT(sv) == 0); + + if (SvOBJECT(sv)) { + dTHR; + if (PL_defstash) { /* Still have a symbol table? */ + djSP; + GV* destructor; + SV tmpref; + + Zero(&tmpref, 1, SV); + sv_upgrade(&tmpref, SVt_RV); + SvROK_on(&tmpref); + SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */ + SvREFCNT(&tmpref) = 1; + + do { + stash = SvSTASH(sv); + destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); + if (destructor) { + ENTER; + PUSHSTACKi(PERLSI_DESTROY); + SvRV(&tmpref) = SvREFCNT_inc(sv); + EXTEND(SP, 2); + PUSHMARK(SP); + PUSHs(&tmpref); + PUTBACK; + perl_call_sv((SV*)GvCV(destructor), + G_DISCARD|G_EVAL|G_KEEPERR); + SvREFCNT(sv)--; + POPSTACK; + LEAVE; + } + } while (SvOBJECT(sv) && SvSTASH(sv) != stash); + + del_XRV(SvANY(&tmpref)); + } + + if (SvOBJECT(sv)) { + SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ + SvOBJECT_off(sv); /* Curse the object. */ + if (SvTYPE(sv) != SVt_PVIO) + --PL_sv_objcount; /* XXX Might want something more general */ + } + if (SvREFCNT(sv)) { + if (PL_in_clean_objs) + croak("DESTROY created new reference to dead object"); + /* DESTROY gave object new lease on life */ + return; + } + } + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) + mg_free(sv); + stash = NULL; + switch (SvTYPE(sv)) { + case SVt_PVIO: + if (IoIFP(sv) && + IoIFP(sv) != PerlIO_stdin() && + IoIFP(sv) != PerlIO_stdout() && + IoIFP(sv) != PerlIO_stderr()) + io_close((IO*)sv); + Safefree(IoTOP_NAME(sv)); + Safefree(IoFMT_NAME(sv)); + Safefree(IoBOTTOM_NAME(sv)); + /* FALL THROUGH */ + case SVt_PVBM: + goto freescalar; + case SVt_PVCV: + case SVt_PVFM: + cv_undef((CV*)sv); + goto freescalar; + case SVt_PVHV: + hv_undef((HV*)sv); + break; + case SVt_PVAV: + av_undef((AV*)sv); + break; + case SVt_PVLV: + SvREFCNT_dec(LvTARG(sv)); + goto freescalar; + case SVt_PVGV: + gp_free((GV*)sv); + Safefree(GvNAME(sv)); + /* cannot decrease stash refcount yet, as we might recursively delete + ourselves when the refcnt drops to zero. Delay SvREFCNT_dec + of stash until current sv is completely gone. + -- JohnPC, 27 Mar 1998 */ + stash = GvSTASH(sv); + /* FALL THROUGH */ + case SVt_PVMG: + case SVt_PVNV: + case SVt_PVIV: + freescalar: + (void)SvOOK_off(sv); + /* FALL THROUGH */ + case SVt_PV: + case SVt_RV: + if (SvROK(sv)) + SvREFCNT_dec(SvRV(sv)); + else if (SvPVX(sv) && SvLEN(sv)) + Safefree(SvPVX(sv)); + break; +/* + case SVt_NV: + case SVt_IV: + case SVt_NULL: + break; +*/ + } + + switch (SvTYPE(sv)) { + case SVt_NULL: + break; + case SVt_IV: + del_XIV(SvANY(sv)); + break; + case SVt_NV: + del_XNV(SvANY(sv)); + break; + case SVt_RV: + del_XRV(SvANY(sv)); + break; + case SVt_PV: + del_XPV(SvANY(sv)); + break; + case SVt_PVIV: + del_XPVIV(SvANY(sv)); + break; + case SVt_PVNV: + del_XPVNV(SvANY(sv)); + break; + case SVt_PVMG: + del_XPVMG(SvANY(sv)); + break; + case SVt_PVLV: + del_XPVLV(SvANY(sv)); + break; + case SVt_PVAV: + del_XPVAV(SvANY(sv)); + break; + case SVt_PVHV: + del_XPVHV(SvANY(sv)); + break; + case SVt_PVCV: + del_XPVCV(SvANY(sv)); + break; + case SVt_PVGV: + del_XPVGV(SvANY(sv)); + /* code duplication for increased performance. */ + SvFLAGS(sv) &= SVf_BREAK; + SvFLAGS(sv) |= SVTYPEMASK; + /* decrease refcount of the stash that owns this GV, if any */ + if (stash) + SvREFCNT_dec(stash); + return; /* not break, SvFLAGS reset already happened */ + case SVt_PVBM: + del_XPVBM(SvANY(sv)); + break; + case SVt_PVFM: + del_XPVFM(SvANY(sv)); + break; + case SVt_PVIO: + del_XPVIO(SvANY(sv)); + break; + } + SvFLAGS(sv) &= SVf_BREAK; + SvFLAGS(sv) |= SVTYPEMASK; +} + +SV * +sv_newref(SV *sv) +{ + if (sv) + ATOMIC_INC(SvREFCNT(sv)); + return sv; +} + +void +sv_free(SV *sv) +{ + int refcount_is_zero; + + if (!sv) + return; + if (SvREFCNT(sv) == 0) { + if (SvFLAGS(sv) & SVf_BREAK) + return; + if (PL_in_clean_all) /* All is fair */ + return; + if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + /* make sure SvREFCNT(sv)==0 happens very seldom */ + SvREFCNT(sv) = (~(U32)0)/2; + return; + } + warn("Attempt to free unreferenced scalar"); + return; + } + ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv)); + if (!refcount_is_zero) + return; +#ifdef DEBUGGING + if (SvTEMP(sv)) { + warn("Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv); + return; + } +#endif + if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + /* make sure SvREFCNT(sv)==0 happens very seldom */ + SvREFCNT(sv) = (~(U32)0)/2; + return; + } + sv_clear(sv); + if (! SvREFCNT(sv)) + del_SV(sv); +} + +STRLEN +sv_len(register SV *sv) +{ + char *junk; + STRLEN len; + + if (!sv) + return 0; + + if (SvGMAGICAL(sv)) + len = mg_length(sv); + else + junk = SvPV(sv, len); + return len; +} + +I32 +sv_eq(register SV *str1, register SV *str2) +{ + char *pv1; + STRLEN cur1; + char *pv2; + STRLEN cur2; + + if (!str1) { + pv1 = ""; + cur1 = 0; + } + else + pv1 = SvPV(str1, cur1); + + if (!str2) + return !cur1; + else + pv2 = SvPV(str2, cur2); + + if (cur1 != cur2) + return 0; + + return memEQ(pv1, pv2, cur1); +} + +I32 +sv_cmp(register SV *str1, register SV *str2) +{ + STRLEN cur1 = 0; + char *pv1 = str1 ? SvPV(str1, cur1) : (char *) NULL; + STRLEN cur2 = 0; + char *pv2 = str2 ? SvPV(str2, cur2) : (char *) NULL; + I32 retval; + + if (!cur1) + return cur2 ? -1 : 0; + + if (!cur2) + return 1; + + retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2); + + if (retval) + return retval < 0 ? -1 : 1; + + if (cur1 == cur2) + return 0; + else + return cur1 < cur2 ? -1 : 1; +} + +I32 +sv_cmp_locale(register SV *sv1, register SV *sv2) +{ +#ifdef USE_LOCALE_COLLATE + + char *pv1, *pv2; + STRLEN len1, len2; + I32 retval; + + if (PL_collation_standard) + goto raw_compare; + + len1 = 0; + pv1 = sv1 ? sv_collxfrm(sv1, &len1) : (char *) NULL; + len2 = 0; + pv2 = sv2 ? sv_collxfrm(sv2, &len2) : (char *) NULL; + + if (!pv1 || !len1) { + if (pv2 && len2) + return -1; + else + goto raw_compare; + } + else { + if (!pv2 || !len2) + return 1; + } + + retval = memcmp((void*)pv1, (void*)pv2, len1 < len2 ? len1 : len2); + + if (retval) + return retval < 0 ? -1 : 1; + + /* + * When the result of collation is equality, that doesn't mean + * that there are no differences -- some locales exclude some + * characters from consideration. So to avoid false equalities, + * we use the raw string as a tiebreaker. + */ + + raw_compare: + /* FALL THROUGH */ + +#endif /* USE_LOCALE_COLLATE */ + + return sv_cmp(sv1, sv2); +} + +#ifdef USE_LOCALE_COLLATE +/* + * Any scalar variable may carry an 'o' magic that contains the + * scalar data of the variable transformed to such a format that + * a normal memory comparison can be used to compare the data + * according to the locale settings. + */ +char * +sv_collxfrm(SV *sv, STRLEN *nxp) +{ + MAGIC *mg; + + mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL; + if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) { + char *s, *xf; + STRLEN len, xlen; + + if (mg) + Safefree(mg->mg_ptr); + s = SvPV(sv, len); + if ((xf = mem_collxfrm(s, len, &xlen))) { + if (SvREADONLY(sv)) { + SAVEFREEPV(xf); + *nxp = xlen; + return xf + sizeof(PL_collation_ix); + } + if (! mg) { + sv_magic(sv, 0, 'o', 0, 0); + mg = mg_find(sv, 'o'); + assert(mg); + } + mg->mg_ptr = xf; + mg->mg_len = xlen; + } + else { + if (mg) { + mg->mg_ptr = NULL; + mg->mg_len = -1; + } + } + } + if (mg && mg->mg_ptr) { + *nxp = mg->mg_len; + return mg->mg_ptr + sizeof(PL_collation_ix); + } + else { + *nxp = 0; + return NULL; + } +} + +#endif /* USE_LOCALE_COLLATE */ + +char * +sv_gets(register SV *sv, register PerlIO *fp, I32 append) +{ + dTHR; + char *rsptr; + STRLEN rslen; + register STDCHAR rslast; + register STDCHAR *bp; + register I32 cnt; + I32 i; + + SV_CHECK_THINKFIRST(sv); + (void)SvUPGRADE(sv, SVt_PV); + SvSCREAM_off(sv); + + if (RsSNARF(PL_rs)) { + rsptr = NULL; + rslen = 0; + } + else if (RsRECORD(PL_rs)) { + I32 recsize, bytesread; + char *buffer; + + /* Grab the size of the record we're getting */ + recsize = SvIV(SvRV(PL_rs)); + (void)SvPOK_only(sv); /* Validate pointer */ + buffer = SvGROW(sv, recsize + 1); + /* Go yank in */ +#ifdef VMS + /* VMS wants read instead of fread, because fread doesn't respect */ + /* RMS record boundaries. This is not necessarily a good thing to be */ + /* doing, but we've got no other real choice */ + bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize); +#else + bytesread = PerlIO_read(fp, buffer, recsize); +#endif + SvCUR_set(sv, bytesread); + buffer[bytesread] = '\0'; + return(SvCUR(sv) ? SvPVX(sv) : Nullch); + } + else if (RsPARA(PL_rs)) { + rsptr = "\n\n"; + rslen = 2; + } + else + rsptr = SvPV(PL_rs, rslen); + rslast = rslen ? rsptr[rslen - 1] : '\0'; + + if (RsPARA(PL_rs)) { /* have to do this both before and after */ + do { /* to make sure file boundaries work right */ + if (PerlIO_eof(fp)) + return 0; + i = PerlIO_getc(fp); + if (i != '\n') { + if (i == -1) + return 0; + PerlIO_ungetc(fp,i); + break; + } + } while (i != EOF); + } + + /* See if we know enough about I/O mechanism to cheat it ! */ + + /* This used to be #ifdef test - it is made run-time test for ease + of abstracting out stdio interface. One call should be cheap + enough here - and may even be a macro allowing compile + time optimization. + */ + + if (PerlIO_fast_gets(fp)) { + + /* + * We're going to steal some values from the stdio struct + * and put EVERYTHING in the innermost loop into registers. + */ + register STDCHAR *ptr; + STRLEN bpx; + I32 shortbuffered; + +#if defined(VMS) && defined(PERLIO_IS_STDIO) + /* An ungetc()d char is handled separately from the regular + * buffer, so we getc() it back out and stuff it in the buffer. + */ + i = PerlIO_getc(fp); + if (i == EOF) return 0; + *(--((*fp)->_ptr)) = (unsigned char) i; + (*fp)->_cnt++; +#endif + + /* Here is some breathtakingly efficient cheating */ + + cnt = PerlIO_get_cnt(fp); /* get count into register */ + (void)SvPOK_only(sv); /* validate pointer */ + if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */ + if (cnt > 80 && SvLEN(sv) > append) { + shortbuffered = cnt - SvLEN(sv) + append + 1; + cnt -= shortbuffered; + } + else { + shortbuffered = 0; + /* remember that cnt can be negative */ + SvGROW(sv, append + (cnt <= 0 ? 2 : (cnt + 1))); + } + } + else + shortbuffered = 0; + bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */ + ptr = (STDCHAR*)PerlIO_get_ptr(fp); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0))); + for (;;) { + screamer: + if (cnt > 0) { + if (rslen) { + while (cnt > 0) { /* this | eat */ + cnt--; + if ((*bp++ = *ptr++) == rslast) /* really | dust */ + goto thats_all_folks; /* screams | sed :-) */ + } + } + else { + Copy(ptr, bp, cnt, char); /* this | eat */ + bp += cnt; /* screams | dust */ + ptr += cnt; /* louder | sed :-) */ + cnt = 0; + } + } + + if (shortbuffered) { /* oh well, must extend */ + cnt = shortbuffered; + shortbuffered = 0; + bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */ + SvCUR_set(sv, bpx); + SvGROW(sv, SvLEN(sv) + append + cnt + 2); + bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */ + continue; + } + + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + /* This used to call 'filbuf' in stdio form, but as that behaves like + getc when cnt <= 0 we use PerlIO_getc here to avoid introducing + another abstraction. */ + i = PerlIO_getc(fp); /* get more characters */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + cnt = PerlIO_get_cnt(fp); + ptr = (STDCHAR*)PerlIO_get_ptr(fp); /* reregisterize cnt and ptr */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + + if (i == EOF) /* all done for ever? */ + goto thats_really_all_folks; + + bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */ + SvCUR_set(sv, bpx); + SvGROW(sv, bpx + cnt + 2); + bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */ + + *bp++ = i; /* store character from PerlIO_getc */ + + if (rslen && (STDCHAR)i == rslast) /* all done for now? */ + goto thats_all_folks; + } + +thats_all_folks: + if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) || + memNE((char*)bp - rslen, rsptr, rslen)) + goto screamer; /* go back to the fray */ +thats_really_all_folks: + if (shortbuffered) + cnt += shortbuffered; + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + PerlIO_set_ptrcnt(fp, ptr, cnt); /* put these back or we're in trouble */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", + (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), + (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + *bp = '\0'; + SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "Screamer: done, len=%ld, string=|%.*s|\n", + (long)SvCUR(sv),(int)SvCUR(sv),SvPVX(sv))); + } + else + { + /*The big, slow, and stupid way */ + STDCHAR buf[8192]; + +screamer2: + if (rslen) { + register STDCHAR *bpe = buf + sizeof(buf); + bp = buf; + while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe) + ; /* keep reading */ + cnt = bp - buf; + } + else { + cnt = PerlIO_read(fp,(char*)buf, sizeof(buf)); + /* Accomodate broken VAXC compiler, which applies U8 cast to + * both args of ?: operator, causing EOF to change into 255 + */ + if (cnt) { i = (U8)buf[cnt - 1]; } else { i = EOF; } + } + + if (append) + sv_catpvn(sv, (char *) buf, cnt); + else + sv_setpvn(sv, (char *) buf, cnt); + + if (i != EOF && /* joy */ + (!rslen || + SvCUR(sv) < rslen || + memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen))) + { + append = -1; + /* + * If we're reading from a TTY and we get a short read, + * indicating that the user hit his EOF character, we need + * to notice it now, because if we try to read from the TTY + * again, the EOF condition will disappear. + * + * The comparison of cnt to sizeof(buf) is an optimization + * that prevents unnecessary calls to feof(). + * + * - jik 9/25/96 + */ + if (!(cnt < sizeof(buf) && PerlIO_eof(fp))) + goto screamer2; + } + } + + if (RsPARA(PL_rs)) { /* have to do this both before and after */ + while (i != EOF) { /* to make sure file boundaries work right */ + i = PerlIO_getc(fp); + if (i != '\n') { + PerlIO_ungetc(fp,i); + break; + } + } + } + +#ifdef WIN32 + win32_strip_return(sv); +#endif + + return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch; +} + + +void +sv_inc(register SV *sv) +{ + register char *d; + int flags; + + if (!sv) + return; + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling) + croak(no_modify); + } + if (SvROK(sv)) { + IV i; +#ifdef OVERLOAD + if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return; +#endif /* OVERLOAD */ + i = (IV)SvRV(sv); + sv_unref(sv); + sv_setiv(sv, i); + } + } + if (SvGMAGICAL(sv)) + mg_get(sv); + flags = SvFLAGS(sv); + if (flags & SVp_NOK) { + (void)SvNOK_only(sv); + SvNVX(sv) += 1.0; + return; + } + if (flags & SVp_IOK) { + if (SvIVX(sv) == IV_MAX) + sv_setnv(sv, (double)IV_MAX + 1.0); + else { + (void)SvIOK_only(sv); + ++SvIVX(sv); + } + return; + } + if (!(flags & SVp_POK) || !*SvPVX(sv)) { + if ((flags & SVTYPEMASK) < SVt_PVNV) + sv_upgrade(sv, SVt_NV); + SvNVX(sv) = 1.0; + (void)SvNOK_only(sv); + return; + } + d = SvPVX(sv); + while (isALPHA(*d)) d++; + while (isDIGIT(*d)) d++; + if (*d) { + SET_NUMERIC_STANDARD(); + sv_setnv(sv,atof(SvPVX(sv)) + 1.0); /* punt */ + return; + } + d--; + while (d >= SvPVX(sv)) { + if (isDIGIT(*d)) { + if (++*d <= '9') + return; + *(d--) = '0'; + } + else { +#ifdef EBCDIC + /* MKS: The original code here died if letters weren't consecutive. + * at least it didn't have to worry about non-C locales. The + * new code assumes that ('z'-'a')==('Z'-'A'), letters are + * arranged in order (although not consecutively) and that only + * [A-Za-z] are accepted by isALPHA in the C locale. + */ + if (*d != 'z' && *d != 'Z') { + do { ++*d; } while (!isALPHA(*d)); + return; + } + *(d--) -= 'z' - 'a'; +#else + ++*d; + if (isALPHA(*d)) + return; + *(d--) -= 'z' - 'a' + 1; +#endif + } + } + /* oh,oh, the number grew */ + SvGROW(sv, SvCUR(sv) + 2); + SvCUR(sv)++; + for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--) + *d = d[-1]; + if (isDIGIT(d[1])) + *d = '1'; + else + *d = d[1]; +} + +void +sv_dec(register SV *sv) +{ + int flags; + + if (!sv) + return; + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling) + croak(no_modify); + } + if (SvROK(sv)) { + IV i; +#ifdef OVERLOAD + if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return; +#endif /* OVERLOAD */ + i = (IV)SvRV(sv); + sv_unref(sv); + sv_setiv(sv, i); + } + } + if (SvGMAGICAL(sv)) + mg_get(sv); + flags = SvFLAGS(sv); + if (flags & SVp_NOK) { + SvNVX(sv) -= 1.0; + (void)SvNOK_only(sv); + return; + } + if (flags & SVp_IOK) { + if (SvIVX(sv) == IV_MIN) + sv_setnv(sv, (double)IV_MIN - 1.0); + else { + (void)SvIOK_only(sv); + --SvIVX(sv); + } + return; + } + if (!(flags & SVp_POK)) { + if ((flags & SVTYPEMASK) < SVt_PVNV) + sv_upgrade(sv, SVt_NV); + SvNVX(sv) = -1.0; + (void)SvNOK_only(sv); + return; + } + SET_NUMERIC_STANDARD(); + sv_setnv(sv,atof(SvPVX(sv)) - 1.0); /* punt */ +} + +/* Make a string that will exist for the duration of the expression + * evaluation. Actually, it may have to last longer than that, but + * hopefully we won't free it until it has been assigned to a + * permanent location. */ + +STATIC void +sv_mortalgrow(void) +{ + dTHR; + PL_tmps_max += (PL_tmps_max < 512) ? 128 : 512; + Renew(PL_tmps_stack, PL_tmps_max, SV*); +} + +SV * +sv_mortalcopy(SV *oldstr) +{ + dTHR; + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setsv(sv,oldstr); + if (++PL_tmps_ix >= PL_tmps_max) + sv_mortalgrow(); + PL_tmps_stack[PL_tmps_ix] = sv; + SvTEMP_on(sv); + return sv; +} + +SV * +sv_newmortal(void) +{ + dTHR; + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = SVs_TEMP; + if (++PL_tmps_ix >= PL_tmps_max) + sv_mortalgrow(); + PL_tmps_stack[PL_tmps_ix] = sv; + return sv; +} + +/* same thing without the copying */ + +SV * +sv_2mortal(register SV *sv) +{ + dTHR; + if (!sv) + return sv; + if (SvREADONLY(sv) && SvIMMORTAL(sv)) + return sv; + if (++PL_tmps_ix >= PL_tmps_max) + sv_mortalgrow(); + PL_tmps_stack[PL_tmps_ix] = sv; + SvTEMP_on(sv); + return sv; +} + +SV * +newSVpv(char *s, STRLEN len) +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + if (!len) + len = strlen(s); + sv_setpvn(sv,s,len); + return sv; +} + +SV * +newSVpvn(char *s, STRLEN len) +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setpvn(sv,s,len); + return sv; +} + +SV * +newSVpvf(const char* pat, ...) +{ + register SV *sv; + va_list args; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); + return sv; +} + + +SV * +newSVnv(double n) +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setnv(sv,n); + return sv; +} + +SV * +newSViv(IV i) +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setiv(sv,i); + return sv; +} + +SV * +newRV_noinc(SV *tmpRef) +{ + dTHR; + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_upgrade(sv, SVt_RV); + SvTEMP_off(tmpRef); + SvRV(sv) = tmpRef; + SvROK_on(sv); + return sv; +} + +SV * +newRV(SV *tmpRef) +{ + return newRV_noinc(SvREFCNT_inc(tmpRef)); +} + +/* make an exact duplicate of old */ + +SV * +newSVsv(register SV *old) +{ + register SV *sv; + + if (!old) + return Nullsv; + if (SvTYPE(old) == SVTYPEMASK) { + warn("semi-panic: attempt to dup freed string"); + return Nullsv; + } + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + if (SvTEMP(old)) { + SvTEMP_off(old); + sv_setsv(sv,old); + SvTEMP_on(old); + } + else + sv_setsv(sv,old); + return sv; +} + +void +sv_reset(register char *s, HV *stash) +{ + register HE *entry; + register GV *gv; + register SV *sv; + register I32 i; + register PMOP *pm; + register I32 max; + char todo[256]; + + if (!stash) + return; + + if (!*s) { /* reset ?? searches */ + for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) { + pm->op_pmdynflags &= ~PMdf_USED; + } + return; + } + + /* reset variables */ + + if (!HvARRAY(stash)) + return; + + Zero(todo, 256, char); + while (*s) { + i = *s; + if (s[1] == '-') { + s += 2; + } + max = *s++; + for ( ; i <= max; i++) { + todo[i] = 1; + } + for (i = 0; i <= (I32) HvMAX(stash); i++) { + for (entry = HvARRAY(stash)[i]; + entry; + entry = HeNEXT(entry)) { + if (!todo[(U8)*HeKEY(entry)]) + continue; + gv = (GV*)HeVAL(entry); + sv = GvSV(gv); + (void)SvOK_off(sv); + if (SvTYPE(sv) >= SVt_PV) { + SvCUR_set(sv, 0); + if (SvPVX(sv) != Nullch) + *SvPVX(sv) = '\0'; + SvTAINT(sv); + } + if (GvAV(gv)) { + av_clear(GvAV(gv)); + } + if (GvHV(gv) && !HvNAME(GvHV(gv))) { + hv_clear(GvHV(gv)); +#ifndef VMS /* VMS has no environ array */ + if (gv == PL_envgv) + environ[0] = Nullch; +#endif + } + } + } + } +} + +IO* +sv_2io(SV *sv) +{ + IO* io; + GV* gv; + + switch (SvTYPE(sv)) { + case SVt_PVIO: + io = (IO*)sv; + break; + case SVt_PVGV: + gv = (GV*)sv; + io = GvIO(gv); + if (!io) + croak("Bad filehandle: %s", GvNAME(gv)); + break; + default: + if (!SvOK(sv)) + croak(no_usym, "filehandle"); + if (SvROK(sv)) + return sv_2io(SvRV(sv)); + gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO); + if (gv) + io = GvIO(gv); + else + io = 0; + if (!io) + croak("Bad filehandle: %s", SvPV(sv,PL_na)); + break; + } + return io; +} + +CV * +sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref) +{ + GV *gv; + CV *cv; + + if (!sv) + return *gvp = Nullgv, Nullcv; + switch (SvTYPE(sv)) { + case SVt_PVCV: + *st = CvSTASH(sv); + *gvp = Nullgv; + return (CV*)sv; + case SVt_PVHV: + case SVt_PVAV: + *gvp = Nullgv; + return Nullcv; + case SVt_PVGV: + gv = (GV*)sv; + *gvp = gv; + *st = GvESTASH(gv); + goto fix_gv; + + default: + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvROK(sv)) { + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) != SVt_PVCV) + croak("Not a subroutine reference"); + *gvp = Nullgv; + *st = CvSTASH(cv); + return cv; + } + if (isGV(sv)) + gv = (GV*)sv; + else + gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV); + *gvp = gv; + if (!gv) + return Nullcv; + *st = GvESTASH(gv); + fix_gv: + if (lref && !GvCVu(gv)) { + SV *tmpsv; + ENTER; + tmpsv = NEWSV(704,0); + gv_efullname3(tmpsv, gv, Nullch); + newSUB(start_subparse(FALSE, 0), + newSVOP(OP_CONST, 0, tmpsv), + Nullop, + Nullop); + LEAVE; + if (!GvCVu(gv)) + croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na)); + } + return GvCVu(gv); + } +} + +I32 +sv_true(register SV *sv) +{ + dTHR; + if (!sv) + return 0; + if (SvPOK(sv)) { + register XPV* tXpv; + if ((tXpv = (XPV*)SvANY(sv)) && + (*tXpv->xpv_pv > '0' || + tXpv->xpv_cur > 1 || + (tXpv->xpv_cur && *tXpv->xpv_pv != '0'))) + return 1; + else + return 0; + } + else { + if (SvIOK(sv)) + return SvIVX(sv) != 0; + else { + if (SvNOK(sv)) + return SvNVX(sv) != 0.0; + else + return sv_2bool(sv); + } + } +} + +IV +sv_iv(register SV *sv) +{ + if (SvIOK(sv)) + return SvIVX(sv); + return sv_2iv(sv); +} + +UV +sv_uv(register SV *sv) +{ + if (SvIOK(sv)) + return SvUVX(sv); + return sv_2uv(sv); +} + +double +sv_nv(register SV *sv) +{ + if (SvNOK(sv)) + return SvNVX(sv); + return sv_2nv(sv); +} + +char * +sv_pvn(SV *sv, STRLEN *lp) +{ + if (SvPOK(sv)) { + *lp = SvCUR(sv); + return SvPVX(sv); + } + return sv_2pv(sv, lp); +} + +char * +sv_pvn_force(SV *sv, STRLEN *lp) +{ + char *s; + + if (SvREADONLY(sv)) { + dTHR; + if (PL_curcop != &PL_compiling) + croak(no_modify); + } + + if (SvPOK(sv)) { + *lp = SvCUR(sv); + } + else { + if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) { + if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) { + sv_unglob(sv); + s = SvPVX(sv); + *lp = SvCUR(sv); + } + else { + dTHR; + croak("Can't coerce %s to string in %s", sv_reftype(sv,0), + op_name[PL_op->op_type]); + } + } + else + s = sv_2pv(sv, lp); + if (s != SvPVX(sv)) { /* Almost, but not quite, sv_setpvn() */ + STRLEN len = *lp; + + if (SvROK(sv)) + sv_unref(sv); + (void)SvUPGRADE(sv, SVt_PV); /* Never FALSE */ + SvGROW(sv, len + 1); + Move(s,SvPVX(sv),len,char); + SvCUR_set(sv, len); + *SvEND(sv) = '\0'; + } + if (!SvPOK(sv)) { + SvPOK_on(sv); /* validate pointer */ + SvTAINT(sv); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n", + (unsigned long)sv,SvPVX(sv))); + } + } + return SvPVX(sv); +} + +char * +sv_reftype(SV *sv, int ob) +{ + if (ob && SvOBJECT(sv)) + return HvNAME(SvSTASH(sv)); + else { + switch (SvTYPE(sv)) { + case SVt_NULL: + case SVt_IV: + case SVt_NV: + case SVt_RV: + case SVt_PV: + case SVt_PVIV: + case SVt_PVNV: + case SVt_PVMG: + case SVt_PVBM: + if (SvROK(sv)) + return "REF"; + else + return "SCALAR"; + case SVt_PVLV: return "LVALUE"; + case SVt_PVAV: return "ARRAY"; + case SVt_PVHV: return "HASH"; + case SVt_PVCV: return "CODE"; + case SVt_PVGV: return "GLOB"; + case SVt_PVFM: return "FORMAT"; + default: return "UNKNOWN"; + } + } +} + +int +sv_isobject(SV *sv) +{ + if (!sv) + return 0; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvROK(sv)) + return 0; + sv = (SV*)SvRV(sv); + if (!SvOBJECT(sv)) + return 0; + return 1; +} + +int +sv_isa(SV *sv, char *name) +{ + if (!sv) + return 0; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (!SvROK(sv)) + return 0; + sv = (SV*)SvRV(sv); + if (!SvOBJECT(sv)) + return 0; + + return strEQ(HvNAME(SvSTASH(sv)), name); +} + +SV* +newSVrv(SV *rv, char *classname) +{ + dTHR; + SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 0; + SvFLAGS(sv) = 0; + + SV_CHECK_THINKFIRST(rv); +#ifdef OVERLOAD + SvAMAGIC_off(rv); +#endif /* OVERLOAD */ + + if (SvTYPE(rv) < SVt_RV) + sv_upgrade(rv, SVt_RV); + + (void)SvOK_off(rv); + SvRV(rv) = SvREFCNT_inc(sv); + SvROK_on(rv); + + if (classname) { + HV* stash = gv_stashpv(classname, TRUE); + (void)sv_bless(rv, stash); + } + return sv; +} + +SV* +sv_setref_pv(SV *rv, char *classname, void *pv) +{ + if (!pv) { + sv_setsv(rv, &PL_sv_undef); + SvSETMAGIC(rv); + } + else + sv_setiv(newSVrv(rv,classname), (IV)pv); + return rv; +} + +SV* +sv_setref_iv(SV *rv, char *classname, IV iv) +{ + sv_setiv(newSVrv(rv,classname), iv); + return rv; +} + +SV* +sv_setref_nv(SV *rv, char *classname, double nv) +{ + sv_setnv(newSVrv(rv,classname), nv); + return rv; +} + +SV* +sv_setref_pvn(SV *rv, char *classname, char *pv, I32 n) +{ + sv_setpvn(newSVrv(rv,classname), pv, n); + return rv; +} + +SV* +sv_bless(SV *sv, HV *stash) +{ + dTHR; + SV *tmpRef; + if (!SvROK(sv)) + croak("Can't bless non-reference value"); + tmpRef = SvRV(sv); + if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) { + if (SvREADONLY(tmpRef)) + croak(no_modify); + if (SvOBJECT(tmpRef)) { + if (SvTYPE(tmpRef) != SVt_PVIO) + --PL_sv_objcount; + SvREFCNT_dec(SvSTASH(tmpRef)); + } + } + SvOBJECT_on(tmpRef); + if (SvTYPE(tmpRef) != SVt_PVIO) + ++PL_sv_objcount; + (void)SvUPGRADE(tmpRef, SVt_PVMG); + SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash); + +#ifdef OVERLOAD + if (Gv_AMG(stash)) + SvAMAGIC_on(sv); + else + SvAMAGIC_off(sv); +#endif /* OVERLOAD */ + + return sv; +} + +STATIC void +sv_unglob(SV *sv) +{ + assert(SvTYPE(sv) == SVt_PVGV); + SvFAKE_off(sv); + if (GvGP(sv)) + gp_free((GV*)sv); + if (GvSTASH(sv)) { + SvREFCNT_dec(GvSTASH(sv)); + GvSTASH(sv) = Nullhv; + } + sv_unmagic(sv, '*'); + Safefree(GvNAME(sv)); + GvMULTI_off(sv); + SvFLAGS(sv) &= ~SVTYPEMASK; + SvFLAGS(sv) |= SVt_PVMG; +} + +void +sv_unref(SV *sv) +{ + SV* rv = SvRV(sv); + + SvRV(sv) = 0; + SvROK_off(sv); + if (SvREFCNT(rv) != 1 || SvREADONLY(rv)) + SvREFCNT_dec(rv); + else + sv_2mortal(rv); /* Schedule for freeing later */ +} + +void +sv_taint(SV *sv) +{ + sv_magic((sv), Nullsv, 't', Nullch, 0); +} + +void +sv_untaint(SV *sv) +{ + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { + MAGIC *mg = mg_find(sv, 't'); + if (mg) + mg->mg_len &= ~1; + } +} + +bool +sv_tainted(SV *sv) +{ + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { + MAGIC *mg = mg_find(sv, 't'); + if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv)) + return TRUE; + } + return FALSE; +} + +void +sv_setpviv(SV *sv, IV iv) +{ + STRLEN len; + char buf[TYPE_DIGITS(UV)]; + char *ptr = buf + sizeof(buf); + int sign; + UV uv; + char *p; + + sv_setpvn(sv, "", 0); + if (iv >= 0) { + uv = iv; + sign = 0; + } else { + uv = -iv; + sign = 1; + } + do { + *--ptr = '0' + (uv % 10); + } while (uv /= 10); + len = (buf + sizeof(buf)) - ptr; + /* taking advantage of SvCUR(sv) == 0 */ + SvGROW(sv, sign + len + 1); + p = SvPVX(sv); + if (sign) + *p++ = '-'; + memcpy(p, ptr, len); + p += len; + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); +} + + +void +sv_setpviv_mg(SV *sv, IV iv) +{ + sv_setpviv(sv,iv); + SvSETMAGIC(sv); +} + +void +sv_setpvf(SV *sv, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); +} + + +void +sv_setpvf_mg(SV *sv, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); + SvSETMAGIC(sv); +} + +void +sv_catpvf(SV *sv, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); +} + +void +sv_catpvf_mg(SV *sv, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + va_end(args); + SvSETMAGIC(sv); +} + +void +sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale) +{ + sv_setpvn(sv, "", 0); + sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale); +} + +void +sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale) +{ + dTHR; + char *p; + char *q; + char *patend; + STRLEN origlen; + I32 svix = 0; + static char nullstr[] = "(null)"; + + /* no matter what, this is a string now */ + (void)SvPV_force(sv, origlen); + + /* special-case "", "%s", and "%_" */ + if (patlen == 0) + return; + if (patlen == 2 && pat[0] == '%') { + switch (pat[1]) { + case 's': + if (args) { + char *s = va_arg(*args, char*); + sv_catpv(sv, s ? s : nullstr); + } + else if (svix < svmax) + sv_catsv(sv, *svargs); + return; + case '_': + if (args) { + sv_catsv(sv, va_arg(*args, SV*)); + return; + } + /* See comment on '_' below */ + break; + } + } + + patend = (char*)pat + patlen; + for (p = (char*)pat; p < patend; p = q) { + bool alt = FALSE; + bool left = FALSE; + char fill = ' '; + char plus = 0; + char intsize = 0; + STRLEN width = 0; + STRLEN zeros = 0; + bool has_precis = FALSE; + STRLEN precis = 0; + + char esignbuf[4]; + STRLEN esignlen = 0; + + char *eptr = Nullch; + STRLEN elen = 0; + char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */ + + static char *efloatbuf = Nullch; + static STRLEN efloatsize = 0; + + char c; + int i; + unsigned base; + IV iv; + UV uv; + double nv; + STRLEN have; + STRLEN need; + STRLEN gap; + + for (q = p; q < patend && *q != '%'; ++q) ; + if (q > p) { + sv_catpvn(sv, p, q - p); + p = q; + } + if (q++ >= patend) + break; + + /* FLAGS */ + + while (*q) { + switch (*q) { + case ' ': + case '+': + plus = *q++; + continue; + + case '-': + left = TRUE; + q++; + continue; + + case '0': + fill = *q++; + continue; + + case '#': + alt = TRUE; + q++; + continue; + + default: + break; + } + break; + } + + /* WIDTH */ + + switch (*q) { + case '1': case '2': case '3': + case '4': case '5': case '6': + case '7': case '8': case '9': + width = 0; + while (isDIGIT(*q)) + width = width * 10 + (*q++ - '0'); + break; + + case '*': + if (args) + i = va_arg(*args, int); + else + i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + left |= (i < 0); + width = (i < 0) ? -i : i; + q++; + break; + } + + /* PRECISION */ + + if (*q == '.') { + q++; + if (*q == '*') { + if (args) + i = va_arg(*args, int); + else + i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + precis = (i < 0) ? 0 : i; + q++; + } + else { + precis = 0; + while (isDIGIT(*q)) + precis = precis * 10 + (*q++ - '0'); + } + has_precis = TRUE; + } + + /* SIZE */ + + switch (*q) { + case 'l': +#if 0 /* when quads have better support within Perl */ + if (*(q + 1) == 'l') { + intsize = 'q'; + q += 2; + break; + } +#endif + /* FALL THROUGH */ + case 'h': + case 'V': + intsize = *q++; + break; + } + + /* CONVERSION */ + + switch (c = *q++) { + + /* STRINGS */ + + case '%': + eptr = q - 1; + elen = 1; + goto string; + + case 'c': + if (args) + c = va_arg(*args, int); + else + c = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + eptr = &c; + elen = 1; + goto string; + + case 's': + if (args) { + eptr = va_arg(*args, char*); + if (eptr) + elen = strlen(eptr); + else { + eptr = nullstr; + elen = sizeof nullstr - 1; + } + } + else if (svix < svmax) + eptr = SvPVx(svargs[svix++], elen); + goto string; + + case '_': + /* + * The "%_" hack might have to be changed someday, + * if ISO or ANSI decide to use '_' for something. + * So we keep it hidden from users' code. + */ + if (!args) + goto unknown; + eptr = SvPVx(va_arg(*args, SV*), elen); + + string: + if (has_precis && elen > precis) + elen = precis; + break; + + /* INTEGERS */ + + case 'p': + if (args) + uv = (UV)va_arg(*args, void*); + else + uv = (svix < svmax) ? (UV)svargs[svix++] : 0; + base = 16; + goto integer; + + case 'D': + intsize = 'l'; + /* FALL THROUGH */ + case 'd': + case 'i': + if (args) { + switch (intsize) { + case 'h': iv = (short)va_arg(*args, int); break; + default: iv = va_arg(*args, int); break; + case 'l': iv = va_arg(*args, long); break; + case 'V': iv = va_arg(*args, IV); break; + } + } + else { + iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0; + switch (intsize) { + case 'h': iv = (short)iv; break; + default: iv = (int)iv; break; + case 'l': iv = (long)iv; break; + case 'V': break; + } + } + if (iv >= 0) { + uv = iv; + if (plus) + esignbuf[esignlen++] = plus; + } + else { + uv = -iv; + esignbuf[esignlen++] = '-'; + } + base = 10; + goto integer; + + case 'U': + intsize = 'l'; + /* FALL THROUGH */ + case 'u': + base = 10; + goto uns_integer; + + case 'O': + intsize = 'l'; + /* FALL THROUGH */ + case 'o': + base = 8; + goto uns_integer; + + case 'X': + case 'x': + base = 16; + + uns_integer: + if (args) { + switch (intsize) { + case 'h': uv = (unsigned short)va_arg(*args, unsigned); break; + default: uv = va_arg(*args, unsigned); break; + case 'l': uv = va_arg(*args, unsigned long); break; + case 'V': uv = va_arg(*args, UV); break; + } + } + else { + uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0; + switch (intsize) { + case 'h': uv = (unsigned short)uv; break; + default: uv = (unsigned)uv; break; + case 'l': uv = (unsigned long)uv; break; + case 'V': break; + } + } + + integer: + eptr = ebuf + sizeof ebuf; + switch (base) { + unsigned dig; + case 16: + if (!uv) + alt = FALSE; + p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef"; + do { + dig = uv & 15; + *--eptr = p[dig]; + } while (uv >>= 4); + if (alt) { + esignbuf[esignlen++] = '0'; + esignbuf[esignlen++] = c; /* 'x' or 'X' */ + } + break; + case 8: + do { + dig = uv & 7; + *--eptr = '0' + dig; + } while (uv >>= 3); + if (alt && *eptr != '0') + *--eptr = '0'; + break; + default: /* it had better be ten or less */ + do { + dig = uv % base; + *--eptr = '0' + dig; + } while (uv /= base); + break; + } + elen = (ebuf + sizeof ebuf) - eptr; + if (has_precis) { + if (precis > elen) + zeros = precis - elen; + else if (precis == 0 && elen == 1 && *eptr == '0') + elen = 0; + } + break; + + /* FLOATING POINT */ + + case 'F': + c = 'f'; /* maybe %F isn't supported here */ + /* FALL THROUGH */ + case 'e': case 'E': + case 'f': + case 'g': case 'G': + + /* This is evil, but floating point is even more evil */ + + if (args) + nv = va_arg(*args, double); + else + nv = (svix < svmax) ? SvNVx(svargs[svix++]) : 0.0; + + need = 0; + if (c != 'e' && c != 'E') { + i = PERL_INT_MIN; + (void)frexp(nv, &i); + if (i == PERL_INT_MIN) + die("panic: frexp"); + if (i > 0) + need = BIT_DIGITS(i); + } + need += has_precis ? precis : 6; /* known default */ + if (need < width) + need = width; + + need += 20; /* fudge factor */ + if (efloatsize < need) { + Safefree(efloatbuf); + efloatsize = need + 20; /* more fudge */ + New(906, efloatbuf, efloatsize, char); + } + + eptr = ebuf + sizeof ebuf; + *--eptr = '\0'; + *--eptr = c; + if (has_precis) { + base = precis; + do { *--eptr = '0' + (base % 10); } while (base /= 10); + *--eptr = '.'; + } + if (width) { + base = width; + do { *--eptr = '0' + (base % 10); } while (base /= 10); + } + if (fill == '0') + *--eptr = fill; + if (left) + *--eptr = '-'; + if (plus) + *--eptr = plus; + if (alt) + *--eptr = '#'; + *--eptr = '%'; + + (void)sprintf(efloatbuf, eptr, nv); + + eptr = efloatbuf; + elen = strlen(efloatbuf); + +#ifdef LC_NUMERIC + /* + * User-defined locales may include arbitrary characters. + * And, unfortunately, some system may alloc the "C" locale + * to be overridden by a malicious user. + */ + if (used_locale) + *used_locale = TRUE; +#endif /* LC_NUMERIC */ + + break; + + /* SPECIAL */ + + case 'n': + i = SvCUR(sv) - origlen; + if (args) { + switch (intsize) { + case 'h': *(va_arg(*args, short*)) = i; break; + default: *(va_arg(*args, int*)) = i; break; + case 'l': *(va_arg(*args, long*)) = i; break; + case 'V': *(va_arg(*args, IV*)) = i; break; + } + } + else if (svix < svmax) + sv_setuv(svargs[svix++], (UV)i); + continue; /* not "break" */ + + /* UNKNOWN */ + + default: + unknown: + if (!args && PL_dowarn && + (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) { + SV *msg = sv_newmortal(); + sv_setpvf(msg, "Invalid conversion in %s: ", + (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf"); + if (c) + sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"", + c & 0xFF); + else + sv_catpv(msg, "end of string"); + warn("%_", msg); /* yes, this is reentrant */ + } + + /* output mangled stuff ... */ + if (c == '\0') + --q; + eptr = p; + elen = q - p; + + /* ... right here, because formatting flags should not apply */ + SvGROW(sv, SvCUR(sv) + elen + 1); + p = SvEND(sv); + memcpy(p, eptr, elen); + p += elen; + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); + continue; /* not "break" */ + } + + have = esignlen + zeros + elen; + need = (have > width ? have : width); + gap = need - have; + + SvGROW(sv, SvCUR(sv) + need + 1); + p = SvEND(sv); + if (esignlen && fill == '0') { + for (i = 0; i < esignlen; i++) + *p++ = esignbuf[i]; + } + if (gap && !left) { + memset(p, fill, gap); + p += gap; + } + if (esignlen && fill != '0') { + for (i = 0; i < esignlen; i++) + *p++ = esignbuf[i]; + } + if (zeros) { + for (i = zeros; i; i--) + *p++ = '0'; + } + if (elen) { + memcpy(p, eptr, elen); + p += elen; + } + if (gap && left) { + memset(p, ' ', gap); + p += gap; + } + *p = '\0'; + SvCUR(sv) = p - SvPVX(sv); + } +} + +void +sv_dump(SV *sv) +{ +#ifdef DEBUGGING + SV *d = sv_newmortal(); + char *s; + U32 flags; + U32 type; + + if (!sv) { + PerlIO_printf(Perl_debug_log, "SV = 0\n"); + return; + } + + flags = SvFLAGS(sv); + type = SvTYPE(sv); + + sv_setpvf(d, "(0x%lx)\n REFCNT = %ld\n FLAGS = (", + (unsigned long)SvANY(sv), (long)SvREFCNT(sv)); + if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); + if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); + if (flags & SVs_PADMY) sv_catpv(d, "PADMY,"); + if (flags & SVs_TEMP) sv_catpv(d, "TEMP,"); + if (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,"); + if (flags & SVs_GMG) sv_catpv(d, "GMG,"); + if (flags & SVs_SMG) sv_catpv(d, "SMG,"); + if (flags & SVs_RMG) sv_catpv(d, "RMG,"); + + if (flags & SVf_IOK) sv_catpv(d, "IOK,"); + if (flags & SVf_NOK) sv_catpv(d, "NOK,"); + if (flags & SVf_POK) sv_catpv(d, "POK,"); + if (flags & SVf_ROK) sv_catpv(d, "ROK,"); + if (flags & SVf_OOK) sv_catpv(d, "OOK,"); + if (flags & SVf_FAKE) sv_catpv(d, "FAKE,"); + if (flags & SVf_READONLY) sv_catpv(d, "READONLY,"); + +#ifdef OVERLOAD + if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,"); +#endif /* OVERLOAD */ + if (flags & SVp_IOK) sv_catpv(d, "pIOK,"); + if (flags & SVp_NOK) sv_catpv(d, "pNOK,"); + if (flags & SVp_POK) sv_catpv(d, "pPOK,"); + if (flags & SVp_SCREAM) sv_catpv(d, "SCREAM,"); + + switch (type) { + case SVt_PVCV: + case SVt_PVFM: + if (CvANON(sv)) sv_catpv(d, "ANON,"); + if (CvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); + if (CvCLONE(sv)) sv_catpv(d, "CLONE,"); + if (CvCLONED(sv)) sv_catpv(d, "CLONED,"); + if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); + break; + case SVt_PVHV: + if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); + if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,"); + break; + case SVt_PVGV: + if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); + if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); + if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); + if (GvIMPORTED(sv)) { + sv_catpv(d, "IMPORT"); + if (GvIMPORTED(sv) == GVf_IMPORTED) + sv_catpv(d, "ALL,"); + else { + sv_catpv(d, "("); + if (GvIMPORTED_SV(sv)) sv_catpv(d, " SV"); + if (GvIMPORTED_AV(sv)) sv_catpv(d, " AV"); + if (GvIMPORTED_HV(sv)) sv_catpv(d, " HV"); + if (GvIMPORTED_CV(sv)) sv_catpv(d, " CV"); + sv_catpv(d, " ),"); + } + } + case SVt_PVBM: + if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); + if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); + break; + } + + if (*(SvEND(d) - 1) == ',') + SvPVX(d)[--SvCUR(d)] = '\0'; + sv_catpv(d, ")"); + s = SvPVX(d); + + PerlIO_printf(Perl_debug_log, "SV = "); + switch (type) { + case SVt_NULL: + PerlIO_printf(Perl_debug_log, "NULL%s\n", s); + return; + case SVt_IV: + PerlIO_printf(Perl_debug_log, "IV%s\n", s); + break; + case SVt_NV: + PerlIO_printf(Perl_debug_log, "NV%s\n", s); + break; + case SVt_RV: + PerlIO_printf(Perl_debug_log, "RV%s\n", s); + break; + case SVt_PV: + PerlIO_printf(Perl_debug_log, "PV%s\n", s); + break; + case SVt_PVIV: + PerlIO_printf(Perl_debug_log, "PVIV%s\n", s); + break; + case SVt_PVNV: + PerlIO_printf(Perl_debug_log, "PVNV%s\n", s); + break; + case SVt_PVBM: + PerlIO_printf(Perl_debug_log, "PVBM%s\n", s); + break; + case SVt_PVMG: + PerlIO_printf(Perl_debug_log, "PVMG%s\n", s); + break; + case SVt_PVLV: + PerlIO_printf(Perl_debug_log, "PVLV%s\n", s); + break; + case SVt_PVAV: + PerlIO_printf(Perl_debug_log, "PVAV%s\n", s); + break; + case SVt_PVHV: + PerlIO_printf(Perl_debug_log, "PVHV%s\n", s); + break; + case SVt_PVCV: + PerlIO_printf(Perl_debug_log, "PVCV%s\n", s); + break; + case SVt_PVGV: + PerlIO_printf(Perl_debug_log, "PVGV%s\n", s); + break; + case SVt_PVFM: + PerlIO_printf(Perl_debug_log, "PVFM%s\n", s); + break; + case SVt_PVIO: + PerlIO_printf(Perl_debug_log, "PVIO%s\n", s); + break; + default: + PerlIO_printf(Perl_debug_log, "UNKNOWN%s\n", s); + return; + } + if (type >= SVt_PVIV || type == SVt_IV) + PerlIO_printf(Perl_debug_log, " IV = %ld\n", (long)SvIVX(sv)); + if (type >= SVt_PVNV || type == SVt_NV) { + SET_NUMERIC_STANDARD(); + PerlIO_printf(Perl_debug_log, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); + } + if (SvROK(sv)) { + PerlIO_printf(Perl_debug_log, " RV = 0x%lx\n", (long)SvRV(sv)); + sv_dump(SvRV(sv)); + return; + } + if (type < SVt_PV) + return; + if (type <= SVt_PVLV) { + if (SvPVX(sv)) + PerlIO_printf(Perl_debug_log, " PV = 0x%lx \"%s\"\n CUR = %ld\n LEN = %ld\n", + (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv)); + else + PerlIO_printf(Perl_debug_log, " PV = 0\n"); + } + if (type >= SVt_PVMG) { + if (SvMAGIC(sv)) { + PerlIO_printf(Perl_debug_log, " MAGIC = 0x%lx\n", (long)SvMAGIC(sv)); + } + if (SvSTASH(sv)) + PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", HvNAME(SvSTASH(sv))); + } + switch (type) { + case SVt_PVLV: + PerlIO_printf(Perl_debug_log, " TYPE = %c\n", LvTYPE(sv)); + PerlIO_printf(Perl_debug_log, " TARGOFF = %ld\n", (long)LvTARGOFF(sv)); + PerlIO_printf(Perl_debug_log, " TARGLEN = %ld\n", (long)LvTARGLEN(sv)); + PerlIO_printf(Perl_debug_log, " TARG = 0x%lx\n", (long)LvTARG(sv)); + sv_dump(LvTARG(sv)); + break; + case SVt_PVAV: + PerlIO_printf(Perl_debug_log, " ARRAY = 0x%lx\n", (long)AvARRAY(sv)); + PerlIO_printf(Perl_debug_log, " ALLOC = 0x%lx\n", (long)AvALLOC(sv)); + PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILLp(sv)); + PerlIO_printf(Perl_debug_log, " MAX = %ld\n", (long)AvMAX(sv)); + PerlIO_printf(Perl_debug_log, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv)); + flags = AvFLAGS(sv); + sv_setpv(d, ""); + if (flags & AVf_REAL) sv_catpv(d, ",REAL"); + if (flags & AVf_REIFY) sv_catpv(d, ",REIFY"); + if (flags & AVf_REUSED) sv_catpv(d, ",REUSED"); + PerlIO_printf(Perl_debug_log, " FLAGS = (%s)\n", + SvCUR(d) ? SvPVX(d) + 1 : ""); + break; + case SVt_PVHV: + PerlIO_printf(Perl_debug_log, " ARRAY = 0x%lx\n",(long)HvARRAY(sv)); + PerlIO_printf(Perl_debug_log, " KEYS = %ld\n", (long)HvKEYS(sv)); + PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)HvFILL(sv)); + PerlIO_printf(Perl_debug_log, " MAX = %ld\n", (long)HvMAX(sv)); + PerlIO_printf(Perl_debug_log, " RITER = %ld\n", (long)HvRITER(sv)); + PerlIO_printf(Perl_debug_log, " EITER = 0x%lx\n",(long) HvEITER(sv)); + if (HvPMROOT(sv)) + PerlIO_printf(Perl_debug_log, " PMROOT = 0x%lx\n",(long)HvPMROOT(sv)); + if (HvNAME(sv)) + PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", HvNAME(sv)); + break; + case SVt_PVCV: + if (SvPOK(sv)) + PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na)); + /* FALL THROUGH */ + case SVt_PVFM: + PerlIO_printf(Perl_debug_log, " STASH = 0x%lx\n", (long)CvSTASH(sv)); + PerlIO_printf(Perl_debug_log, " START = 0x%lx\n", (long)CvSTART(sv)); + PerlIO_printf(Perl_debug_log, " ROOT = 0x%lx\n", (long)CvROOT(sv)); + PerlIO_printf(Perl_debug_log, " XSUB = 0x%lx\n", (long)CvXSUB(sv)); + PerlIO_printf(Perl_debug_log, " XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32); + PerlIO_printf(Perl_debug_log, " GV = 0x%lx", (long)CvGV(sv)); + if (CvGV(sv) && GvNAME(CvGV(sv))) { + PerlIO_printf(Perl_debug_log, " \"%s\"\n", GvNAME(CvGV(sv))); + } else { + PerlIO_printf(Perl_debug_log, "\n"); + } + PerlIO_printf(Perl_debug_log, " FILEGV = 0x%lx\n", (long)CvFILEGV(sv)); + PerlIO_printf(Perl_debug_log, " DEPTH = %ld\n", (long)CvDEPTH(sv)); + PerlIO_printf(Perl_debug_log, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv)); + PerlIO_printf(Perl_debug_log, " OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv)); +#ifdef USE_THREADS + PerlIO_printf(Perl_debug_log, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv)); + PerlIO_printf(Perl_debug_log, " OWNER = 0x%lx\n", (long)CvOWNER(sv)); +#endif /* USE_THREADS */ + PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", + (unsigned long)CvFLAGS(sv)); + if (type == SVt_PVFM) + PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)FmLINES(sv)); + break; + case SVt_PVGV: + PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", GvNAME(sv)); + PerlIO_printf(Perl_debug_log, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); + PerlIO_printf(Perl_debug_log, " STASH = \"%s\"\n", + SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)"); + PerlIO_printf(Perl_debug_log, " GP = 0x%lx\n", (long)GvGP(sv)); + PerlIO_printf(Perl_debug_log, " SV = 0x%lx\n", (long)GvSV(sv)); + PerlIO_printf(Perl_debug_log, " REFCNT = %ld\n", (long)GvREFCNT(sv)); + PerlIO_printf(Perl_debug_log, " IO = 0x%lx\n", (long)GvIOp(sv)); + PerlIO_printf(Perl_debug_log, " FORM = 0x%lx\n", (long)GvFORM(sv)); + PerlIO_printf(Perl_debug_log, " AV = 0x%lx\n", (long)GvAV(sv)); + PerlIO_printf(Perl_debug_log, " HV = 0x%lx\n", (long)GvHV(sv)); + PerlIO_printf(Perl_debug_log, " CV = 0x%lx\n", (long)GvCV(sv)); + PerlIO_printf(Perl_debug_log, " CVGEN = 0x%lx\n", (long)GvCVGEN(sv)); + PerlIO_printf(Perl_debug_log, " LASTEXPR = %ld\n", (long)GvLASTEXPR(sv)); + PerlIO_printf(Perl_debug_log, " LINE = %ld\n", (long)GvLINE(sv)); + PerlIO_printf(Perl_debug_log, " FILEGV = 0x%lx\n", (long)GvFILEGV(sv)); + PerlIO_printf(Perl_debug_log, " EGV = 0x%lx\n", (long)GvEGV(sv)); + break; + case SVt_PVIO: + PerlIO_printf(Perl_debug_log, " IFP = 0x%lx\n", (long)IoIFP(sv)); + PerlIO_printf(Perl_debug_log, " OFP = 0x%lx\n", (long)IoOFP(sv)); + PerlIO_printf(Perl_debug_log, " DIRP = 0x%lx\n", (long)IoDIRP(sv)); + PerlIO_printf(Perl_debug_log, " LINES = %ld\n", (long)IoLINES(sv)); + PerlIO_printf(Perl_debug_log, " PAGE = %ld\n", (long)IoPAGE(sv)); + PerlIO_printf(Perl_debug_log, " PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv)); + PerlIO_printf(Perl_debug_log, " LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv)); + PerlIO_printf(Perl_debug_log, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); + PerlIO_printf(Perl_debug_log, " TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv)); + PerlIO_printf(Perl_debug_log, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv)); + PerlIO_printf(Perl_debug_log, " FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv)); + PerlIO_printf(Perl_debug_log, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); + PerlIO_printf(Perl_debug_log, " BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv)); + PerlIO_printf(Perl_debug_log, " SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv)); + PerlIO_printf(Perl_debug_log, " TYPE = %c\n", IoTYPE(sv)); + PerlIO_printf(Perl_debug_log, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv)); + break; + } +#endif /* DEBUGGING */ +} diff --git a/contrib/perl5/sv.h b/contrib/perl5/sv.h new file mode 100644 index 00000000000..3dac5482916 --- /dev/null +++ b/contrib/perl5/sv.h @@ -0,0 +1,669 @@ +/* sv.h + * + * Copyright (c) 1991-1997, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +#ifdef sv_flags +#undef sv_flags /* Convex has this in for sigvec() */ +#endif + +typedef enum { + SVt_NULL, /* 0 */ + SVt_IV, /* 1 */ + SVt_NV, /* 2 */ + SVt_RV, /* 3 */ + SVt_PV, /* 4 */ + SVt_PVIV, /* 5 */ + SVt_PVNV, /* 6 */ + SVt_PVMG, /* 7 */ + SVt_PVBM, /* 8 */ + SVt_PVLV, /* 9 */ + SVt_PVAV, /* 10 */ + SVt_PVHV, /* 11 */ + SVt_PVCV, /* 12 */ + SVt_PVGV, /* 13 */ + SVt_PVFM, /* 14 */ + SVt_PVIO /* 15 */ +} svtype; + +/* Using C's structural equivalence to help emulate C++ inheritance here... */ + +struct sv { + void* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +struct gv { + XPVGV* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +struct cv { + XPVCV* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +struct av { + XPVAV* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +struct hv { + XPVHV* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +struct io { + XPVIO* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ +}; + +#define SvANY(sv) (sv)->sv_any +#define SvFLAGS(sv) (sv)->sv_flags +#define SvREFCNT(sv) (sv)->sv_refcnt + +#ifdef USE_THREADS + +# ifdef EMULATE_ATOMIC_REFCOUNTS +# define ATOMIC_INC(count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + ++count; \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + res = (--count == 0); \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# else +# define ATOMIC_INC(count) atomic_inc(&count) +# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count)) +# endif /* EMULATE_ATOMIC_REFCOUNTS */ +#else +# define ATOMIC_INC(count) (++count) +# define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0)) +#endif /* USE_THREADS */ + +#ifdef __GNUC__ +# define SvREFCNT_inc(sv) \ + ({ \ + SV *nsv = (SV*)(sv); \ + if (nsv) \ + ATOMIC_INC(SvREFCNT(nsv)); \ + nsv; \ + }) +#else +# if defined(CRIPPLED_CC) || defined(USE_THREADS) +# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# else +# define SvREFCNT_inc(sv) \ + ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv) +# endif +#endif + +#define SvREFCNT_dec(sv) sv_free((SV*)sv) + +#define SVTYPEMASK 0xff +#define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK) + +#define SvUPGRADE(sv, mt) (SvTYPE(sv) >= mt || sv_upgrade(sv, mt)) + +#define SVs_PADBUSY 0x00000100 /* reserved for tmp or my already */ +#define SVs_PADTMP 0x00000200 /* in use as tmp */ +#define SVs_PADMY 0x00000400 /* in use a "my" variable */ +#define SVs_TEMP 0x00000800 /* string is stealable? */ +#define SVs_OBJECT 0x00001000 /* is "blessed" */ +#define SVs_GMG 0x00002000 /* has magical get method */ +#define SVs_SMG 0x00004000 /* has magical set method */ +#define SVs_RMG 0x00008000 /* has random magical methods */ + +#define SVf_IOK 0x00010000 /* has valid public integer value */ +#define SVf_NOK 0x00020000 /* has valid public numeric value */ +#define SVf_POK 0x00040000 /* has valid public pointer value */ +#define SVf_ROK 0x00080000 /* has a valid reference pointer */ + +#define SVf_FAKE 0x00100000 /* glob or lexical is just a copy */ +#define SVf_OOK 0x00200000 /* has valid offset value */ +#define SVf_BREAK 0x00400000 /* refcnt is artificially low */ +#define SVf_READONLY 0x00800000 /* may not be modified */ + +#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK) + +#define SVp_IOK 0x01000000 /* has valid non-public integer value */ +#define SVp_NOK 0x02000000 /* has valid non-public numeric value */ +#define SVp_POK 0x04000000 /* has valid non-public pointer value */ +#define SVp_SCREAM 0x08000000 /* has been studied? */ + +#define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ + SVp_IOK|SVp_NOK|SVp_POK) + +#ifdef OVERLOAD +#define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */ +#else +#define SVf_AMAGIC 0 /* can be or-ed without effect */ +#endif /* OVERLOAD */ + +#define PRIVSHIFT 8 + +/* Some private flags. */ + +#define SVpfm_COMPILED 0x80000000 + +#define SVpbm_VALID 0x80000000 +#define SVpbm_TAIL 0x40000000 + +#define SVphv_SHAREKEYS 0x20000000 /* keys live on shared string table */ +#define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ + +struct xrv { + SV * xrv_rv; /* pointer to another SV */ +}; + +struct xpv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ +}; + +struct xpviv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ +}; + +struct xpvuv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + UV xuv_uv; /* unsigned value or pv offset */ +}; + +struct xpvnv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ +}; + +/* These structure must match the beginning of struct xpvhv in hv.h. */ +struct xpvmg { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ +}; + +struct xpvlv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + STRLEN xlv_targoff; + STRLEN xlv_targlen; + SV* xlv_targ; + char xlv_type; +}; + +struct xpvgv { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + GP* xgv_gp; + char* xgv_name; + STRLEN xgv_namelen; + HV* xgv_stash; + U8 xgv_flags; +}; + +struct xpvbm { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + I32 xbm_useful; /* is this constant pattern being useful? */ + U16 xbm_previous; /* how many characters in string before rare? */ + U8 xbm_rare; /* rarest character in string */ +}; + +/* This structure much match XPVCV */ + +typedef U16 cv_flags_t; + +struct xpvfm { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + HV * xcv_stash; + OP * xcv_start; + OP * xcv_root; + void (*xcv_xsub)_((CV* _CPERLproto)); + ANY xcv_xsubany; + GV * xcv_gv; + GV * xcv_filegv; + long xcv_depth; /* >= 2 indicates recursive call */ + AV * xcv_padlist; + CV * xcv_outside; +#ifdef USE_THREADS + perl_mutex *xcv_mutexp; /* protects xcv_owner */ + struct perl_thread *xcv_owner; /* current owner thread */ +#endif /* USE_THREADS */ + cv_flags_t xcv_flags; + + I32 xfm_lines; +}; + +struct xpvio { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + IV xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + PerlIO * xio_ifp; /* ifp and ofp are normally the same */ + PerlIO * xio_ofp; /* but sockets need separate streams */ + DIR * xio_dirp; /* for opendir, readdir, etc */ + long xio_lines; /* $. */ + long xio_page; /* $% */ + long xio_page_len; /* $= */ + long xio_lines_left; /* $- */ + char * xio_top_name; /* $^ */ + GV * xio_top_gv; /* $^ */ + char * xio_fmt_name; /* $~ */ + GV * xio_fmt_gv; /* $~ */ + char * xio_bottom_name;/* $^B */ + GV * xio_bottom_gv; /* $^B */ + short xio_subprocess; /* -| or |- */ + char xio_type; + char xio_flags; +}; + +#define IOf_ARGV 1 /* this fp iterates over ARGV */ +#define IOf_START 2 /* check for null ARGV and substitute '-' */ +#define IOf_FLUSH 4 /* this fp wants a flush after write op */ +#define IOf_DIDTOP 8 /* just did top of form */ +#define IOf_UNTAINT 16 /* consider this fp (and it's data) "safe" */ + +/* The following macros define implementation-independent predicates on SVs. */ + +#define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) +#define SvNIOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK)) +#define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \ + SVp_IOK|SVp_NOK)) + +#define SvOK(sv) (SvFLAGS(sv) & SVf_OK) +#define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \ + SvOOK_off(sv)) + +#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) +#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK) +#define SvIOKp_on(sv) (SvOOK_off(sv), SvFLAGS(sv) |= SVp_IOK) +#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) +#define SvNOKp_on(sv) (SvFLAGS(sv) |= SVp_NOK) +#define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) +#define SvPOKp_on(sv) (SvFLAGS(sv) |= SVp_POK) + +#define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) +#define SvIOK_on(sv) (SvOOK_off(sv), \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) +#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK)) +#define SvIOK_only(sv) (SvOK_off(sv), \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) + +#define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) +#define SvNOK_on(sv) (SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) +#define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) +#define SvNOK_only(sv) (SvOK_off(sv), \ + SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) + +#define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) +#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) +#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC), \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) + +#define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) +#define SvOOK_on(sv) (SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK) +#define SvOOK_off(sv) (SvOOK(sv) && sv_backoff(sv)) + +#define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE) +#define SvFAKE_on(sv) (SvFLAGS(sv) |= SVf_FAKE) +#define SvFAKE_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE) + +#define SvROK(sv) (SvFLAGS(sv) & SVf_ROK) +#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK) +#define SvROK_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVf_AMAGIC)) + +#define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG)) + +#define SvGMAGICAL(sv) (SvFLAGS(sv) & SVs_GMG) +#define SvGMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_GMG) +#define SvGMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_GMG) + +#define SvSMAGICAL(sv) (SvFLAGS(sv) & SVs_SMG) +#define SvSMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_SMG) +#define SvSMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_SMG) + +#define SvRMAGICAL(sv) (SvFLAGS(sv) & SVs_RMG) +#define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) +#define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) + +#ifdef OVERLOAD +#define SvAMAGIC(sv) (SvFLAGS(sv) & SVf_AMAGIC) +#define SvAMAGIC_on(sv) (SvFLAGS(sv) |= SVf_AMAGIC) +#define SvAMAGIC_off(sv) (SvFLAGS(sv) &= ~SVf_AMAGIC) + +/* +#define Gv_AMG(stash) \ + (HV_AMAGICmb(stash) && \ + ((!HV_AMAGICbad(stash) && HV_AMAGIC(stash)) || Gv_AMupdate(stash))) +*/ +#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash)) +#endif /* OVERLOAD */ + +#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) + +#define SvPADBUSY(sv) (SvFLAGS(sv) & SVs_PADBUSY) + +#define SvPADTMP(sv) (SvFLAGS(sv) & SVs_PADTMP) +#define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP|SVs_PADBUSY) +#define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) + +#define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY) +#define SvPADMY_on(sv) (SvFLAGS(sv) |= SVs_PADMY|SVs_PADBUSY) + +#define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) +#define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) +#define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) + +#define SvOBJECT(sv) (SvFLAGS(sv) & SVs_OBJECT) +#define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) +#define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) + +#define SvREADONLY(sv) (SvFLAGS(sv) & SVf_READONLY) +#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) +#define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) + +#define SvSCREAM(sv) (SvFLAGS(sv) & SVp_SCREAM) +#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) +#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM) + +#define SvCOMPILED(sv) (SvFLAGS(sv) & SVpfm_COMPILED) +#define SvCOMPILED_on(sv) (SvFLAGS(sv) |= SVpfm_COMPILED) +#define SvCOMPILED_off(sv) (SvFLAGS(sv) &= ~SVpfm_COMPILED) + +#define SvTAIL(sv) (SvFLAGS(sv) & SVpbm_TAIL) +#define SvTAIL_on(sv) (SvFLAGS(sv) |= SVpbm_TAIL) +#define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL) + +#define SvVALID(sv) (SvFLAGS(sv) & SVpbm_VALID) +#define SvVALID_on(sv) (SvFLAGS(sv) |= SVpbm_VALID) +#define SvVALID_off(sv) (SvFLAGS(sv) &= ~SVpbm_VALID) + +#define SvRV(sv) ((XRV*) SvANY(sv))->xrv_rv +#define SvRVx(sv) SvRV(sv) + +#define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv +#define SvIVXx(sv) SvIVX(sv) +#define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv +#define SvUVXx(sv) SvUVX(sv) +#define SvNVX(sv) ((XPVNV*)SvANY(sv))->xnv_nv +#define SvNVXx(sv) SvNVX(sv) +#define SvPVX(sv) ((XPV*) SvANY(sv))->xpv_pv +#define SvPVXx(sv) SvPVX(sv) +#define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur +#define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len +#define SvLENx(sv) SvLEN(sv) +#define SvEND(sv)(((XPV*) SvANY(sv))->xpv_pv + ((XPV*)SvANY(sv))->xpv_cur) +#define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv)) +#define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_magic +#define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash + +#define SvIV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ + (((XPVIV*) SvANY(sv))->xiv_iv = val); } STMT_END +#define SvNV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_NV || SvTYPE(sv) >= SVt_PVNV); \ + (((XPVNV*) SvANY(sv))->xnv_nv = val); } STMT_END +#define SvPV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ + (((XPV*) SvANY(sv))->xpv_pv = val); } STMT_END +#define SvCUR_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ + (((XPV*) SvANY(sv))->xpv_cur = val); } STMT_END +#define SvLEN_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ + (((XPV*) SvANY(sv))->xpv_len = val); } STMT_END +#define SvEND_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ + (((XPV*) SvANY(sv))->xpv_cur = val - SvPVX(sv)); } STMT_END + +#define BmRARE(sv) ((XPVBM*) SvANY(sv))->xbm_rare +#define BmUSEFUL(sv) ((XPVBM*) SvANY(sv))->xbm_useful +#define BmPREVIOUS(sv) ((XPVBM*) SvANY(sv))->xbm_previous + +#define FmLINES(sv) ((XPVFM*) SvANY(sv))->xfm_lines + +#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type +#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ +#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff +#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen + +#define IoIFP(sv) ((XPVIO*) SvANY(sv))->xio_ifp +#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp +#define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp +#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xio_lines +#define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page +#define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len +#define IoLINES_LEFT(sv)((XPVIO*) SvANY(sv))->xio_lines_left +#define IoTOP_NAME(sv) ((XPVIO*) SvANY(sv))->xio_top_name +#define IoTOP_GV(sv) ((XPVIO*) SvANY(sv))->xio_top_gv +#define IoFMT_NAME(sv) ((XPVIO*) SvANY(sv))->xio_fmt_name +#define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv +#define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name +#define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv +#define IoSUBPROCESS(sv)((XPVIO*) SvANY(sv))->xio_subprocess +#define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type +#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags + +#define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv)) +#define SvTAINTED_on(sv) STMT_START{ if(PL_tainting){sv_taint(sv);} }STMT_END +#define SvTAINTED_off(sv) STMT_START{ if(PL_tainting){sv_untaint(sv);} }STMT_END + +#define SvTAINT(sv) \ + STMT_START { \ + if (PL_tainting) { \ + dTHR; \ + if (PL_tainted) \ + SvTAINTED_on(sv); \ + } \ + } STMT_END + +#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp) +#define SvPV(sv, lp) sv_pvn(sv, &lp) +#define SvIVx(sv) sv_iv(sv) +#define SvUVx(sv) sv_uv(sv) +#define SvNVx(sv) sv_nv(sv) +#define SvPVx(sv, lp) sv_pvn(sv, &lp) +#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) +#define SvTRUEx(sv) sv_true(sv) + +#define SvIV(sv) SvIVx(sv) +#define SvNV(sv) SvNVx(sv) +#define SvUV(sv) SvIVx(sv) +#define SvTRUE(sv) SvTRUEx(sv) + +#ifndef CRIPPLED_CC +/* redefine some things to more efficient inlined versions */ + +#undef SvIV +#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) + +#undef SvUV +#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) + +#undef SvNV +#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)) + +#undef SvPV +#define SvPV(sv, lp) \ + (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp)) + +#undef SvPV_force +#define SvPV_force(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force(sv, &lp)) + +#ifdef __GNUC__ +# undef SvIVx +# undef SvUVx +# undef SvNVx +# undef SvPVx +# undef SvTRUE +# undef SvTRUEx +# define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); }) +# define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); }) +# define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); }) +# define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); }) +# define SvTRUE(sv) ( \ + !sv \ + ? 0 \ + : SvPOK(sv) \ + ? (({XPV *nxpv = (XPV*)SvANY(sv); \ + nxpv && \ + (*nxpv->xpv_pv > '0' || \ + nxpv->xpv_cur > 1 || \ + (nxpv->xpv_cur && *nxpv->xpv_pv != '0')); }) \ + ? 1 \ + : 0) \ + : \ + SvIOK(sv) \ + ? SvIVX(sv) != 0 \ + : SvNOK(sv) \ + ? SvNVX(sv) != 0.0 \ + : sv_2bool(sv) ) +# define SvTRUEx(sv) ({SV *nsv = (sv); SvTRUE(nsv); }) +#else /* __GNUC__ */ +#ifndef USE_THREADS +/* These inlined macros use globals, which will require a thread + * declaration in user code, so we avoid them under threads */ + +# undef SvIVx +# undef SvUVx +# undef SvNVx +# undef SvPVx +# undef SvTRUE +# undef SvTRUEx +# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv)) +# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) +# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv)) +# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp)) +# define SvTRUE(sv) ( \ + !sv \ + ? 0 \ + : SvPOK(sv) \ + ? ((PL_Xpv = (XPV*)SvANY(sv)) && \ + (*PL_Xpv->xpv_pv > '0' || \ + PL_Xpv->xpv_cur > 1 || \ + (PL_Xpv->xpv_cur && *PL_Xpv->xpv_pv != '0')) \ + ? 1 \ + : 0) \ + : \ + SvIOK(sv) \ + ? SvIVX(sv) != 0 \ + : SvNOK(sv) \ + ? SvNVX(sv) != 0.0 \ + : sv_2bool(sv) ) +# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) +#endif /* !USE_THREADS */ +#endif /* !__GNU__ */ +#endif /* !CRIPPLED_CC */ + +#define newRV_inc(sv) newRV(sv) + +/* the following macros update any magic values this sv is associated with */ + +#define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END +#define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END + +#define SvSetSV_and(dst,src,finally) \ + STMT_START { \ + if ((dst) != (src)) { \ + sv_setsv(dst, src); \ + finally; \ + } \ + } STMT_END +#define SvSetSV_nosteal_and(dst,src,finally) \ + STMT_START { \ + if ((dst) != (src)) { \ + U32 tMpF = SvFLAGS(src) & SVs_TEMP; \ + SvTEMP_off(src); \ + sv_setsv(dst, src); \ + SvFLAGS(src) |= tMpF; \ + finally; \ + } \ + } STMT_END + +#define SvSetSV(dst,src) \ + SvSetSV_and(dst,src,/*nothing*/;) +#define SvSetSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,/*nothing*/;) + +#define SvSetMagicSV(dst,src) \ + SvSetSV_and(dst,src,SvSETMAGIC(dst)) +#define SvSetMagicSV_nosteal(dst,src) \ + SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) + +#define SvPEEK(sv) sv_peek(sv) + +#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no) + +#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) + +#define isGV(sv) (SvTYPE(sv) == SVt_PVGV) + +#ifndef DOSISH +# define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) +# define Sv_Grow sv_grow +#else + /* extra parentheses intentionally NOT placed around "len"! */ +# define SvGROW(sv,len) ((SvLEN(sv) < (unsigned long)len) \ + ? sv_grow(sv,(unsigned long)len) : SvPVX(sv)) +# define Sv_Grow(sv,len) sv_grow(sv,(unsigned long)(len)) +#endif /* DOSISH */ diff --git a/contrib/perl5/t/README b/contrib/perl5/t/README new file mode 100644 index 00000000000..83843491791 --- /dev/null +++ b/contrib/perl5/t/README @@ -0,0 +1,16 @@ +This is the perl test library. To run all the tests, just type 'TEST'. + +To add new tests, just look at the current tests and do likewise. + +If a test fails, run it by itself to see if it prints any informative +diagnostics. If not, modify the test to print informative diagnostics. +If you put out extra lines with a '#' character on the front, you don't +have to worry about removing the extra print statements later since TEST +ignores lines beginning with '#'. + +If you know that Perl is basically working but expect that some tests +will fail, you may want to use Test::Harness thusly: + ./perl -I../lib harness +This method pinpoints failed tests automatically. + +If you come up with new tests, please send them to larry@wall.org. diff --git a/contrib/perl5/t/TEST b/contrib/perl5/t/TEST new file mode 100755 index 00000000000..3685c2a45f0 --- /dev/null +++ b/contrib/perl5/t/TEST @@ -0,0 +1,181 @@ +#!./perl + +# Last change: Fri Jan 10 09:57:03 WET 1997 + +# This is written in a peculiar style, since we're trying to avoid +# most of the constructs we'll be testing for. + +$| = 1; + +if ($#ARGV >= 0 && $ARGV[0] eq '-v') { + $verbose = 1; + shift; +} + +chdir 't' if -f 't/TEST'; + +die "You need to run \"make test\" first to set things up.\n" + unless -e 'perl' or -e 'perl.exe'; + +# check leakage for embedders +$ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL}; + +$ENV{EMXSHELL} = 'sh'; # For OS/2 + +if ($#ARGV == -1) { + @ARGV = split(/[ \n]/, + `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); +} + +%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); + +_testprogs('perl', @ARGV); +_testprogs('compile', @ARGV) if (-e "../testcompile"); + +sub _testprogs { + $type = shift @_; + @tests = @_; + + + print <<'EOT' if ($type eq 'compile'); +-------------------------------------------------------------------------------- +TESTING COMPILER +-------------------------------------------------------------------------------- +EOT + + $bad = 0; + $good = 0; + $total = @tests; + $files = 0; + $totmax = 0; + $maxlen = 0; + foreach (@tests) { + $len = length; + $maxlen = $len if $len > $maxlen; + } + # +3 : we want three dots between the test name and the "ok" + # -2 : the .t suffix + $dotdotdot = $maxlen + 3 - 2; + while ($test = shift @tests) { + + if ( $infinite{$test} && $type eq 'compile' ) { + print STDERR "$test creates infinite loop! Skipping.\n"; + next; + } + if ($test =~ /^$/) { + next; + } + $te = $test; + chop($te); + print "$te" . '.' x ($dotdotdot - length($te)); + + open(SCRIPT,"<$test") or die "Can't run $test.\n"; + $_ =